From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- libgfortran/ChangeLog | 710 + libgfortran/ChangeLog-2002 | 67 + libgfortran/ChangeLog-2003 | 549 + libgfortran/ChangeLog-2004 | 1111 + libgfortran/ChangeLog-2005 | 2922 +++ libgfortran/ChangeLog-2006 | 1641 ++ libgfortran/ChangeLog-2007 | 2487 ++ libgfortran/ChangeLog-2008 | 2532 ++ libgfortran/ChangeLog-2009 | 2502 ++ libgfortran/ChangeLog-2010 | 1013 + libgfortran/Makefile.am | 992 + libgfortran/Makefile.in | 5987 +++++ libgfortran/acinclude.m4 | 372 + libgfortran/aclocal.m4 | 981 + libgfortran/c99_protos.h | 633 + libgfortran/config.h.in | 952 + libgfortran/config/fpu-387.h | 136 + libgfortran/config/fpu-aix.h | 83 + libgfortran/config/fpu-generic.h | 52 + libgfortran/config/fpu-glibc.h | 87 + libgfortran/config/fpu-sysv.h | 82 + libgfortran/configure | 28964 +++++++++++++++++++++++ libgfortran/configure.ac | 577 + libgfortran/configure.host | 47 + libgfortran/fmain.c | 24 + libgfortran/generated/_abs_c10.F90 | 46 + libgfortran/generated/_abs_c16.F90 | 46 + libgfortran/generated/_abs_c4.F90 | 46 + libgfortran/generated/_abs_c8.F90 | 46 + libgfortran/generated/_abs_i16.F90 | 46 + libgfortran/generated/_abs_i4.F90 | 46 + libgfortran/generated/_abs_i8.F90 | 46 + libgfortran/generated/_abs_r10.F90 | 46 + libgfortran/generated/_abs_r16.F90 | 46 + libgfortran/generated/_abs_r4.F90 | 46 + libgfortran/generated/_abs_r8.F90 | 46 + libgfortran/generated/_acos_r10.F90 | 46 + libgfortran/generated/_acos_r16.F90 | 46 + libgfortran/generated/_acos_r4.F90 | 46 + libgfortran/generated/_acos_r8.F90 | 46 + libgfortran/generated/_acosh_r10.F90 | 46 + libgfortran/generated/_acosh_r16.F90 | 46 + libgfortran/generated/_acosh_r4.F90 | 46 + libgfortran/generated/_acosh_r8.F90 | 46 + libgfortran/generated/_aimag_c10.F90 | 46 + libgfortran/generated/_aimag_c16.F90 | 46 + libgfortran/generated/_aimag_c4.F90 | 46 + libgfortran/generated/_aimag_c8.F90 | 46 + libgfortran/generated/_aint_r10.F90 | 46 + libgfortran/generated/_aint_r16.F90 | 46 + libgfortran/generated/_aint_r4.F90 | 46 + libgfortran/generated/_aint_r8.F90 | 46 + libgfortran/generated/_anint_r10.F90 | 46 + libgfortran/generated/_anint_r16.F90 | 46 + libgfortran/generated/_anint_r4.F90 | 46 + libgfortran/generated/_anint_r8.F90 | 46 + libgfortran/generated/_asin_r10.F90 | 46 + libgfortran/generated/_asin_r16.F90 | 46 + libgfortran/generated/_asin_r4.F90 | 46 + libgfortran/generated/_asin_r8.F90 | 46 + libgfortran/generated/_asinh_r10.F90 | 46 + libgfortran/generated/_asinh_r16.F90 | 46 + libgfortran/generated/_asinh_r4.F90 | 46 + libgfortran/generated/_asinh_r8.F90 | 46 + libgfortran/generated/_atan2_r10.F90 | 46 + libgfortran/generated/_atan2_r16.F90 | 46 + libgfortran/generated/_atan2_r4.F90 | 46 + libgfortran/generated/_atan2_r8.F90 | 46 + libgfortran/generated/_atan_r10.F90 | 46 + libgfortran/generated/_atan_r16.F90 | 46 + libgfortran/generated/_atan_r4.F90 | 46 + libgfortran/generated/_atan_r8.F90 | 46 + libgfortran/generated/_atanh_r10.F90 | 46 + libgfortran/generated/_atanh_r16.F90 | 46 + libgfortran/generated/_atanh_r4.F90 | 46 + libgfortran/generated/_atanh_r8.F90 | 46 + libgfortran/generated/_conjg_c10.F90 | 46 + libgfortran/generated/_conjg_c16.F90 | 46 + libgfortran/generated/_conjg_c4.F90 | 46 + libgfortran/generated/_conjg_c8.F90 | 46 + libgfortran/generated/_cos_c10.F90 | 46 + libgfortran/generated/_cos_c16.F90 | 46 + libgfortran/generated/_cos_c4.F90 | 46 + libgfortran/generated/_cos_c8.F90 | 46 + libgfortran/generated/_cos_r10.F90 | 46 + libgfortran/generated/_cos_r16.F90 | 46 + libgfortran/generated/_cos_r4.F90 | 46 + libgfortran/generated/_cos_r8.F90 | 46 + libgfortran/generated/_cosh_r10.F90 | 46 + libgfortran/generated/_cosh_r16.F90 | 46 + libgfortran/generated/_cosh_r4.F90 | 46 + libgfortran/generated/_cosh_r8.F90 | 46 + libgfortran/generated/_dim_i16.F90 | 46 + libgfortran/generated/_dim_i4.F90 | 46 + libgfortran/generated/_dim_i8.F90 | 46 + libgfortran/generated/_dim_r10.F90 | 46 + libgfortran/generated/_dim_r16.F90 | 46 + libgfortran/generated/_dim_r4.F90 | 46 + libgfortran/generated/_dim_r8.F90 | 46 + libgfortran/generated/_exp_c10.F90 | 46 + libgfortran/generated/_exp_c16.F90 | 46 + libgfortran/generated/_exp_c4.F90 | 46 + libgfortran/generated/_exp_c8.F90 | 46 + libgfortran/generated/_exp_r10.F90 | 46 + libgfortran/generated/_exp_r16.F90 | 46 + libgfortran/generated/_exp_r4.F90 | 46 + libgfortran/generated/_exp_r8.F90 | 46 + libgfortran/generated/_log10_r10.F90 | 46 + libgfortran/generated/_log10_r16.F90 | 46 + libgfortran/generated/_log10_r4.F90 | 46 + libgfortran/generated/_log10_r8.F90 | 46 + libgfortran/generated/_log_c10.F90 | 46 + libgfortran/generated/_log_c16.F90 | 46 + libgfortran/generated/_log_c4.F90 | 46 + libgfortran/generated/_log_c8.F90 | 46 + libgfortran/generated/_log_r10.F90 | 46 + libgfortran/generated/_log_r16.F90 | 46 + libgfortran/generated/_log_r4.F90 | 46 + libgfortran/generated/_log_r8.F90 | 46 + libgfortran/generated/_mod_i16.F90 | 46 + libgfortran/generated/_mod_i4.F90 | 46 + libgfortran/generated/_mod_i8.F90 | 46 + libgfortran/generated/_mod_r10.F90 | 46 + libgfortran/generated/_mod_r16.F90 | 46 + libgfortran/generated/_mod_r4.F90 | 46 + libgfortran/generated/_mod_r8.F90 | 46 + libgfortran/generated/_sign_i16.F90 | 46 + libgfortran/generated/_sign_i4.F90 | 46 + libgfortran/generated/_sign_i8.F90 | 46 + libgfortran/generated/_sign_r10.F90 | 46 + libgfortran/generated/_sign_r16.F90 | 46 + libgfortran/generated/_sign_r4.F90 | 46 + libgfortran/generated/_sign_r8.F90 | 46 + libgfortran/generated/_sin_c10.F90 | 46 + libgfortran/generated/_sin_c16.F90 | 46 + libgfortran/generated/_sin_c4.F90 | 46 + libgfortran/generated/_sin_c8.F90 | 46 + libgfortran/generated/_sin_r10.F90 | 46 + libgfortran/generated/_sin_r16.F90 | 46 + libgfortran/generated/_sin_r4.F90 | 46 + libgfortran/generated/_sin_r8.F90 | 46 + libgfortran/generated/_sinh_r10.F90 | 46 + libgfortran/generated/_sinh_r16.F90 | 46 + libgfortran/generated/_sinh_r4.F90 | 46 + libgfortran/generated/_sinh_r8.F90 | 46 + libgfortran/generated/_sqrt_c10.F90 | 46 + libgfortran/generated/_sqrt_c16.F90 | 46 + libgfortran/generated/_sqrt_c4.F90 | 46 + libgfortran/generated/_sqrt_c8.F90 | 46 + libgfortran/generated/_sqrt_r10.F90 | 46 + libgfortran/generated/_sqrt_r16.F90 | 46 + libgfortran/generated/_sqrt_r4.F90 | 46 + libgfortran/generated/_sqrt_r8.F90 | 46 + libgfortran/generated/_tan_r10.F90 | 46 + libgfortran/generated/_tan_r16.F90 | 46 + libgfortran/generated/_tan_r4.F90 | 46 + libgfortran/generated/_tan_r8.F90 | 46 + libgfortran/generated/_tanh_r10.F90 | 46 + libgfortran/generated/_tanh_r16.F90 | 46 + libgfortran/generated/_tanh_r4.F90 | 46 + libgfortran/generated/_tanh_r8.F90 | 46 + libgfortran/generated/all_l1.c | 221 + libgfortran/generated/all_l16.c | 221 + libgfortran/generated/all_l2.c | 221 + libgfortran/generated/all_l4.c | 221 + libgfortran/generated/all_l8.c | 221 + libgfortran/generated/any_l1.c | 221 + libgfortran/generated/any_l16.c | 221 + libgfortran/generated/any_l2.c | 221 + libgfortran/generated/any_l4.c | 221 + libgfortran/generated/any_l8.c | 221 + libgfortran/generated/bessel_r10.c | 187 + libgfortran/generated/bessel_r16.c | 195 + libgfortran/generated/bessel_r4.c | 187 + libgfortran/generated/bessel_r8.c | 187 + libgfortran/generated/count_16_l.c | 217 + libgfortran/generated/count_1_l.c | 217 + libgfortran/generated/count_2_l.c | 217 + libgfortran/generated/count_4_l.c | 217 + libgfortran/generated/count_8_l.c | 217 + libgfortran/generated/cshift0_c10.c | 171 + libgfortran/generated/cshift0_c16.c | 171 + libgfortran/generated/cshift0_c4.c | 171 + libgfortran/generated/cshift0_c8.c | 171 + libgfortran/generated/cshift0_i1.c | 171 + libgfortran/generated/cshift0_i16.c | 171 + libgfortran/generated/cshift0_i2.c | 171 + libgfortran/generated/cshift0_i4.c | 171 + libgfortran/generated/cshift0_i8.c | 171 + libgfortran/generated/cshift0_r10.c | 171 + libgfortran/generated/cshift0_r16.c | 171 + libgfortran/generated/cshift0_r4.c | 171 + libgfortran/generated/cshift0_r8.c | 171 + libgfortran/generated/cshift1_16.c | 273 + libgfortran/generated/cshift1_4.c | 273 + libgfortran/generated/cshift1_8.c | 273 + libgfortran/generated/eoshift1_16.c | 318 + libgfortran/generated/eoshift1_4.c | 318 + libgfortran/generated/eoshift1_8.c | 318 + libgfortran/generated/eoshift3_16.c | 336 + libgfortran/generated/eoshift3_4.c | 336 + libgfortran/generated/eoshift3_8.c | 336 + libgfortran/generated/exponent_r10.c | 45 + libgfortran/generated/exponent_r16.c | 49 + libgfortran/generated/exponent_r4.c | 45 + libgfortran/generated/exponent_r8.c | 45 + libgfortran/generated/fraction_r10.c | 44 + libgfortran/generated/fraction_r16.c | 48 + libgfortran/generated/fraction_r4.c | 44 + libgfortran/generated/fraction_r8.c | 44 + libgfortran/generated/iall_i1.c | 509 + libgfortran/generated/iall_i16.c | 509 + libgfortran/generated/iall_i2.c | 509 + libgfortran/generated/iall_i4.c | 509 + libgfortran/generated/iall_i8.c | 509 + libgfortran/generated/iany_i1.c | 509 + libgfortran/generated/iany_i16.c | 509 + libgfortran/generated/iany_i2.c | 509 + libgfortran/generated/iany_i4.c | 509 + libgfortran/generated/iany_i8.c | 509 + libgfortran/generated/in_pack_c10.c | 119 + libgfortran/generated/in_pack_c16.c | 119 + libgfortran/generated/in_pack_c4.c | 119 + libgfortran/generated/in_pack_c8.c | 119 + libgfortran/generated/in_pack_i1.c | 119 + libgfortran/generated/in_pack_i16.c | 119 + libgfortran/generated/in_pack_i2.c | 119 + libgfortran/generated/in_pack_i4.c | 119 + libgfortran/generated/in_pack_i8.c | 119 + libgfortran/generated/in_pack_r10.c | 119 + libgfortran/generated/in_pack_r16.c | 119 + libgfortran/generated/in_pack_r4.c | 119 + libgfortran/generated/in_pack_r8.c | 119 + libgfortran/generated/in_unpack_c10.c | 107 + libgfortran/generated/in_unpack_c16.c | 107 + libgfortran/generated/in_unpack_c4.c | 107 + libgfortran/generated/in_unpack_c8.c | 107 + libgfortran/generated/in_unpack_i1.c | 107 + libgfortran/generated/in_unpack_i16.c | 107 + libgfortran/generated/in_unpack_i2.c | 107 + libgfortran/generated/in_unpack_i4.c | 107 + libgfortran/generated/in_unpack_i8.c | 107 + libgfortran/generated/in_unpack_r10.c | 107 + libgfortran/generated/in_unpack_r16.c | 107 + libgfortran/generated/in_unpack_r4.c | 107 + libgfortran/generated/in_unpack_r8.c | 107 + libgfortran/generated/iparity_i1.c | 509 + libgfortran/generated/iparity_i16.c | 509 + libgfortran/generated/iparity_i2.c | 509 + libgfortran/generated/iparity_i4.c | 509 + libgfortran/generated/iparity_i8.c | 509 + libgfortran/generated/matmul_c10.c | 376 + libgfortran/generated/matmul_c16.c | 376 + libgfortran/generated/matmul_c4.c | 376 + libgfortran/generated/matmul_c8.c | 376 + libgfortran/generated/matmul_i1.c | 376 + libgfortran/generated/matmul_i16.c | 376 + libgfortran/generated/matmul_i2.c | 376 + libgfortran/generated/matmul_i4.c | 376 + libgfortran/generated/matmul_i8.c | 376 + libgfortran/generated/matmul_l16.c | 239 + libgfortran/generated/matmul_l4.c | 239 + libgfortran/generated/matmul_l8.c | 239 + libgfortran/generated/matmul_r10.c | 376 + libgfortran/generated/matmul_r16.c | 376 + libgfortran/generated/matmul_r4.c | 376 + libgfortran/generated/matmul_r8.c | 376 + libgfortran/generated/maxloc0_16_i1.c | 383 + libgfortran/generated/maxloc0_16_i16.c | 383 + libgfortran/generated/maxloc0_16_i2.c | 383 + libgfortran/generated/maxloc0_16_i4.c | 383 + libgfortran/generated/maxloc0_16_i8.c | 383 + libgfortran/generated/maxloc0_16_r10.c | 383 + libgfortran/generated/maxloc0_16_r16.c | 383 + libgfortran/generated/maxloc0_16_r4.c | 383 + libgfortran/generated/maxloc0_16_r8.c | 383 + libgfortran/generated/maxloc0_4_i1.c | 383 + libgfortran/generated/maxloc0_4_i16.c | 383 + libgfortran/generated/maxloc0_4_i2.c | 383 + libgfortran/generated/maxloc0_4_i4.c | 383 + libgfortran/generated/maxloc0_4_i8.c | 383 + libgfortran/generated/maxloc0_4_r10.c | 383 + libgfortran/generated/maxloc0_4_r16.c | 383 + libgfortran/generated/maxloc0_4_r4.c | 383 + libgfortran/generated/maxloc0_4_r8.c | 383 + libgfortran/generated/maxloc0_8_i1.c | 383 + libgfortran/generated/maxloc0_8_i16.c | 383 + libgfortran/generated/maxloc0_8_i2.c | 383 + libgfortran/generated/maxloc0_8_i4.c | 383 + libgfortran/generated/maxloc0_8_i8.c | 383 + libgfortran/generated/maxloc0_8_r10.c | 383 + libgfortran/generated/maxloc0_8_r16.c | 383 + libgfortran/generated/maxloc0_8_r4.c | 383 + libgfortran/generated/maxloc0_8_r8.c | 383 + libgfortran/generated/maxloc1_16_i1.c | 563 + libgfortran/generated/maxloc1_16_i16.c | 563 + libgfortran/generated/maxloc1_16_i2.c | 563 + libgfortran/generated/maxloc1_16_i4.c | 563 + libgfortran/generated/maxloc1_16_i8.c | 563 + libgfortran/generated/maxloc1_16_r10.c | 563 + libgfortran/generated/maxloc1_16_r16.c | 563 + libgfortran/generated/maxloc1_16_r4.c | 563 + libgfortran/generated/maxloc1_16_r8.c | 563 + libgfortran/generated/maxloc1_4_i1.c | 563 + libgfortran/generated/maxloc1_4_i16.c | 563 + libgfortran/generated/maxloc1_4_i2.c | 563 + libgfortran/generated/maxloc1_4_i4.c | 563 + libgfortran/generated/maxloc1_4_i8.c | 563 + libgfortran/generated/maxloc1_4_r10.c | 563 + libgfortran/generated/maxloc1_4_r16.c | 563 + libgfortran/generated/maxloc1_4_r4.c | 563 + libgfortran/generated/maxloc1_4_r8.c | 563 + libgfortran/generated/maxloc1_8_i1.c | 563 + libgfortran/generated/maxloc1_8_i16.c | 563 + libgfortran/generated/maxloc1_8_i2.c | 563 + libgfortran/generated/maxloc1_8_i4.c | 563 + libgfortran/generated/maxloc1_8_i8.c | 563 + libgfortran/generated/maxloc1_8_r10.c | 563 + libgfortran/generated/maxloc1_8_r16.c | 563 + libgfortran/generated/maxloc1_8_r4.c | 563 + libgfortran/generated/maxloc1_8_r8.c | 563 + libgfortran/generated/maxval_i1.c | 550 + libgfortran/generated/maxval_i16.c | 550 + libgfortran/generated/maxval_i2.c | 550 + libgfortran/generated/maxval_i4.c | 550 + libgfortran/generated/maxval_i8.c | 550 + libgfortran/generated/maxval_r10.c | 550 + libgfortran/generated/maxval_r16.c | 550 + libgfortran/generated/maxval_r4.c | 550 + libgfortran/generated/maxval_r8.c | 550 + libgfortran/generated/minloc0_16_i1.c | 383 + libgfortran/generated/minloc0_16_i16.c | 383 + libgfortran/generated/minloc0_16_i2.c | 383 + libgfortran/generated/minloc0_16_i4.c | 383 + libgfortran/generated/minloc0_16_i8.c | 383 + libgfortran/generated/minloc0_16_r10.c | 383 + libgfortran/generated/minloc0_16_r16.c | 383 + libgfortran/generated/minloc0_16_r4.c | 383 + libgfortran/generated/minloc0_16_r8.c | 383 + libgfortran/generated/minloc0_4_i1.c | 383 + libgfortran/generated/minloc0_4_i16.c | 383 + libgfortran/generated/minloc0_4_i2.c | 383 + libgfortran/generated/minloc0_4_i4.c | 383 + libgfortran/generated/minloc0_4_i8.c | 383 + libgfortran/generated/minloc0_4_r10.c | 383 + libgfortran/generated/minloc0_4_r16.c | 383 + libgfortran/generated/minloc0_4_r4.c | 383 + libgfortran/generated/minloc0_4_r8.c | 383 + libgfortran/generated/minloc0_8_i1.c | 383 + libgfortran/generated/minloc0_8_i16.c | 383 + libgfortran/generated/minloc0_8_i2.c | 383 + libgfortran/generated/minloc0_8_i4.c | 383 + libgfortran/generated/minloc0_8_i8.c | 383 + libgfortran/generated/minloc0_8_r10.c | 383 + libgfortran/generated/minloc0_8_r16.c | 383 + libgfortran/generated/minloc0_8_r4.c | 383 + libgfortran/generated/minloc0_8_r8.c | 383 + libgfortran/generated/minloc1_16_i1.c | 563 + libgfortran/generated/minloc1_16_i16.c | 563 + libgfortran/generated/minloc1_16_i2.c | 563 + libgfortran/generated/minloc1_16_i4.c | 563 + libgfortran/generated/minloc1_16_i8.c | 563 + libgfortran/generated/minloc1_16_r10.c | 563 + libgfortran/generated/minloc1_16_r16.c | 563 + libgfortran/generated/minloc1_16_r4.c | 563 + libgfortran/generated/minloc1_16_r8.c | 563 + libgfortran/generated/minloc1_4_i1.c | 563 + libgfortran/generated/minloc1_4_i16.c | 563 + libgfortran/generated/minloc1_4_i2.c | 563 + libgfortran/generated/minloc1_4_i4.c | 563 + libgfortran/generated/minloc1_4_i8.c | 563 + libgfortran/generated/minloc1_4_r10.c | 563 + libgfortran/generated/minloc1_4_r16.c | 563 + libgfortran/generated/minloc1_4_r4.c | 563 + libgfortran/generated/minloc1_4_r8.c | 563 + libgfortran/generated/minloc1_8_i1.c | 563 + libgfortran/generated/minloc1_8_i16.c | 563 + libgfortran/generated/minloc1_8_i2.c | 563 + libgfortran/generated/minloc1_8_i4.c | 563 + libgfortran/generated/minloc1_8_i8.c | 563 + libgfortran/generated/minloc1_8_r10.c | 563 + libgfortran/generated/minloc1_8_r16.c | 563 + libgfortran/generated/minloc1_8_r4.c | 563 + libgfortran/generated/minloc1_8_r8.c | 563 + libgfortran/generated/minval_i1.c | 550 + libgfortran/generated/minval_i16.c | 550 + libgfortran/generated/minval_i2.c | 550 + libgfortran/generated/minval_i4.c | 550 + libgfortran/generated/minval_i8.c | 550 + libgfortran/generated/minval_r10.c | 550 + libgfortran/generated/minval_r16.c | 550 + libgfortran/generated/minval_r4.c | 550 + libgfortran/generated/minval_r8.c | 550 + libgfortran/generated/misc_specifics.F90 | 206 + libgfortran/generated/nearest_r10.c | 51 + libgfortran/generated/nearest_r16.c | 55 + libgfortran/generated/nearest_r4.c | 51 + libgfortran/generated/nearest_r8.c | 51 + libgfortran/generated/norm2_r10.c | 212 + libgfortran/generated/norm2_r16.c | 220 + libgfortran/generated/norm2_r4.c | 212 + libgfortran/generated/norm2_r8.c | 212 + libgfortran/generated/pack_c10.c | 261 + libgfortran/generated/pack_c16.c | 261 + libgfortran/generated/pack_c4.c | 261 + libgfortran/generated/pack_c8.c | 261 + libgfortran/generated/pack_i1.c | 261 + libgfortran/generated/pack_i16.c | 261 + libgfortran/generated/pack_i2.c | 261 + libgfortran/generated/pack_i4.c | 261 + libgfortran/generated/pack_i8.c | 261 + libgfortran/generated/pack_r10.c | 261 + libgfortran/generated/pack_r16.c | 261 + libgfortran/generated/pack_r4.c | 261 + libgfortran/generated/pack_r8.c | 261 + libgfortran/generated/parity_l1.c | 191 + libgfortran/generated/parity_l16.c | 191 + libgfortran/generated/parity_l2.c | 191 + libgfortran/generated/parity_l4.c | 191 + libgfortran/generated/parity_l8.c | 191 + libgfortran/generated/pow_c10_i16.c | 75 + libgfortran/generated/pow_c10_i4.c | 75 + libgfortran/generated/pow_c10_i8.c | 75 + libgfortran/generated/pow_c16_i16.c | 75 + libgfortran/generated/pow_c16_i4.c | 75 + libgfortran/generated/pow_c16_i8.c | 75 + libgfortran/generated/pow_c4_i16.c | 75 + libgfortran/generated/pow_c4_i4.c | 75 + libgfortran/generated/pow_c4_i8.c | 75 + libgfortran/generated/pow_c8_i16.c | 75 + libgfortran/generated/pow_c8_i4.c | 75 + libgfortran/generated/pow_c8_i8.c | 75 + libgfortran/generated/pow_i16_i16.c | 77 + libgfortran/generated/pow_i16_i4.c | 77 + libgfortran/generated/pow_i16_i8.c | 77 + libgfortran/generated/pow_i4_i16.c | 77 + libgfortran/generated/pow_i4_i4.c | 77 + libgfortran/generated/pow_i4_i8.c | 77 + libgfortran/generated/pow_i8_i16.c | 77 + libgfortran/generated/pow_i8_i4.c | 77 + libgfortran/generated/pow_i8_i8.c | 77 + libgfortran/generated/pow_r10_i16.c | 75 + libgfortran/generated/pow_r10_i8.c | 75 + libgfortran/generated/pow_r16_i16.c | 75 + libgfortran/generated/pow_r16_i4.c | 75 + libgfortran/generated/pow_r16_i8.c | 75 + libgfortran/generated/pow_r4_i16.c | 75 + libgfortran/generated/pow_r4_i8.c | 75 + libgfortran/generated/pow_r8_i16.c | 75 + libgfortran/generated/pow_r8_i8.c | 75 + libgfortran/generated/product_c10.c | 508 + libgfortran/generated/product_c16.c | 508 + libgfortran/generated/product_c4.c | 508 + libgfortran/generated/product_c8.c | 508 + libgfortran/generated/product_i1.c | 508 + libgfortran/generated/product_i16.c | 508 + libgfortran/generated/product_i2.c | 508 + libgfortran/generated/product_i4.c | 508 + libgfortran/generated/product_i8.c | 508 + libgfortran/generated/product_r10.c | 508 + libgfortran/generated/product_r16.c | 508 + libgfortran/generated/product_r4.c | 508 + libgfortran/generated/product_r8.c | 508 + libgfortran/generated/reshape_c10.c | 352 + libgfortran/generated/reshape_c16.c | 352 + libgfortran/generated/reshape_c4.c | 352 + libgfortran/generated/reshape_c8.c | 352 + libgfortran/generated/reshape_i16.c | 352 + libgfortran/generated/reshape_i4.c | 352 + libgfortran/generated/reshape_i8.c | 352 + libgfortran/generated/reshape_r10.c | 352 + libgfortran/generated/reshape_r16.c | 352 + libgfortran/generated/reshape_r4.c | 352 + libgfortran/generated/reshape_r8.c | 352 + libgfortran/generated/rrspacing_r10.c | 54 + libgfortran/generated/rrspacing_r16.c | 58 + libgfortran/generated/rrspacing_r4.c | 54 + libgfortran/generated/rrspacing_r8.c | 54 + libgfortran/generated/set_exponent_r10.c | 44 + libgfortran/generated/set_exponent_r16.c | 48 + libgfortran/generated/set_exponent_r4.c | 44 + libgfortran/generated/set_exponent_r8.c | 44 + libgfortran/generated/shape_i16.c | 67 + libgfortran/generated/shape_i4.c | 67 + libgfortran/generated/shape_i8.c | 67 + libgfortran/generated/spacing_r10.c | 53 + libgfortran/generated/spacing_r16.c | 57 + libgfortran/generated/spacing_r4.c | 53 + libgfortran/generated/spacing_r8.c | 53 + libgfortran/generated/spread_c10.c | 271 + libgfortran/generated/spread_c16.c | 271 + libgfortran/generated/spread_c4.c | 271 + libgfortran/generated/spread_c8.c | 271 + libgfortran/generated/spread_i1.c | 271 + libgfortran/generated/spread_i16.c | 271 + libgfortran/generated/spread_i2.c | 271 + libgfortran/generated/spread_i4.c | 271 + libgfortran/generated/spread_i8.c | 271 + libgfortran/generated/spread_r10.c | 271 + libgfortran/generated/spread_r16.c | 271 + libgfortran/generated/spread_r4.c | 271 + libgfortran/generated/spread_r8.c | 271 + libgfortran/generated/sum_c10.c | 508 + libgfortran/generated/sum_c16.c | 508 + libgfortran/generated/sum_c4.c | 508 + libgfortran/generated/sum_c8.c | 508 + libgfortran/generated/sum_i1.c | 508 + libgfortran/generated/sum_i16.c | 508 + libgfortran/generated/sum_i2.c | 508 + libgfortran/generated/sum_i4.c | 508 + libgfortran/generated/sum_i8.c | 508 + libgfortran/generated/sum_r10.c | 508 + libgfortran/generated/sum_r16.c | 508 + libgfortran/generated/sum_r4.c | 508 + libgfortran/generated/sum_r8.c | 508 + libgfortran/generated/transpose_c10.c | 114 + libgfortran/generated/transpose_c16.c | 114 + libgfortran/generated/transpose_c4.c | 114 + libgfortran/generated/transpose_c8.c | 114 + libgfortran/generated/transpose_i16.c | 114 + libgfortran/generated/transpose_i4.c | 114 + libgfortran/generated/transpose_i8.c | 114 + libgfortran/generated/transpose_r10.c | 114 + libgfortran/generated/transpose_r16.c | 114 + libgfortran/generated/transpose_r4.c | 114 + libgfortran/generated/transpose_r8.c | 114 + libgfortran/generated/unpack_c10.c | 331 + libgfortran/generated/unpack_c16.c | 331 + libgfortran/generated/unpack_c4.c | 331 + libgfortran/generated/unpack_c8.c | 331 + libgfortran/generated/unpack_i1.c | 331 + libgfortran/generated/unpack_i16.c | 331 + libgfortran/generated/unpack_i2.c | 331 + libgfortran/generated/unpack_i4.c | 331 + libgfortran/generated/unpack_i8.c | 331 + libgfortran/generated/unpack_r10.c | 331 + libgfortran/generated/unpack_r16.c | 331 + libgfortran/generated/unpack_r4.c | 331 + libgfortran/generated/unpack_r8.c | 331 + libgfortran/gfortran.map | 1351 ++ libgfortran/intrinsics/abort.c | 35 + libgfortran/intrinsics/access.c | 90 + libgfortran/intrinsics/args.c | 270 + libgfortran/intrinsics/associated.c | 58 + libgfortran/intrinsics/bit_intrinsics.c | 138 + libgfortran/intrinsics/c99_functions.c | 2135 ++ libgfortran/intrinsics/chdir.c | 111 + libgfortran/intrinsics/chmod.c | 120 + libgfortran/intrinsics/clock.c | 72 + libgfortran/intrinsics/cpu_time.c | 111 + libgfortran/intrinsics/cshift0.c | 454 + libgfortran/intrinsics/ctime.c | 129 + libgfortran/intrinsics/date_and_time.c | 672 + libgfortran/intrinsics/dprod_r8.f90 | 32 + libgfortran/intrinsics/dtime.c | 87 + libgfortran/intrinsics/env.c | 195 + libgfortran/intrinsics/eoshift0.c | 302 + libgfortran/intrinsics/eoshift2.c | 326 + libgfortran/intrinsics/erfc_scaled.c | 52 + libgfortran/intrinsics/erfc_scaled_inc.c | 193 + libgfortran/intrinsics/etime.c | 73 + libgfortran/intrinsics/execute_command_line.c | 177 + libgfortran/intrinsics/exit.c | 52 + libgfortran/intrinsics/extends_type_of.c | 61 + libgfortran/intrinsics/f2c_specifics.F90 | 197 + libgfortran/intrinsics/fnum.c | 48 + libgfortran/intrinsics/gerror.c | 59 + libgfortran/intrinsics/getXid.c | 67 + libgfortran/intrinsics/getcwd.c | 83 + libgfortran/intrinsics/getlog.c | 121 + libgfortran/intrinsics/hostnm.c | 144 + libgfortran/intrinsics/ierrno.c | 49 + libgfortran/intrinsics/ishftc.c | 100 + libgfortran/intrinsics/iso_c_binding.c | 189 + libgfortran/intrinsics/iso_c_binding.h | 55 + libgfortran/intrinsics/iso_c_generated_procs.c | 466 + libgfortran/intrinsics/kill.c | 94 + libgfortran/intrinsics/link.c | 131 + libgfortran/intrinsics/malloc.c | 49 + libgfortran/intrinsics/move_alloc.c | 69 + libgfortran/intrinsics/mvbits.c | 86 + libgfortran/intrinsics/pack_generic.c | 649 + libgfortran/intrinsics/perror.c | 55 + libgfortran/intrinsics/rand.c | 136 + libgfortran/intrinsics/random.c | 798 + libgfortran/intrinsics/rename.c | 125 + libgfortran/intrinsics/reshape_generic.c | 379 + libgfortran/intrinsics/reshape_packed.c | 49 + libgfortran/intrinsics/selected_char_kind.c | 46 + libgfortran/intrinsics/selected_int_kind.f90 | 46 + libgfortran/intrinsics/selected_real_kind.f90 | 95 + libgfortran/intrinsics/signal.c | 243 + libgfortran/intrinsics/size.c | 61 + libgfortran/intrinsics/sleep.c | 67 + libgfortran/intrinsics/spread_generic.c | 655 + libgfortran/intrinsics/stat.c | 557 + libgfortran/intrinsics/string_intrinsics.c | 102 + libgfortran/intrinsics/string_intrinsics_inc.c | 453 + libgfortran/intrinsics/symlnk.c | 131 + libgfortran/intrinsics/system.c | 64 + libgfortran/intrinsics/system_clock.c | 207 + libgfortran/intrinsics/time.c | 64 + libgfortran/intrinsics/time_1.h | 238 + libgfortran/intrinsics/transpose_generic.c | 151 + libgfortran/intrinsics/umask.c | 93 + libgfortran/intrinsics/unlink.c | 91 + libgfortran/intrinsics/unpack_generic.c | 630 + libgfortran/io/close.c | 102 + libgfortran/io/fbuf.c | 270 + libgfortran/io/fbuf.h | 87 + libgfortran/io/file_pos.c | 463 + libgfortran/io/format.c | 1402 ++ libgfortran/io/format.h | 145 + libgfortran/io/inquire.c | 708 + libgfortran/io/intrinsics.c | 400 + libgfortran/io/io.h | 809 + libgfortran/io/list_read.c | 3077 +++ libgfortran/io/lock.c | 67 + libgfortran/io/open.c | 866 + libgfortran/io/read.c | 1179 + libgfortran/io/size_from_kind.c | 83 + libgfortran/io/transfer.c | 3745 +++ libgfortran/io/transfer128.c | 98 + libgfortran/io/unit.c | 860 + libgfortran/io/unix.c | 1891 ++ libgfortran/io/unix.h | 192 + libgfortran/io/write.c | 1997 ++ libgfortran/io/write_float.def | 1087 + libgfortran/kinds-override.h | 46 + libgfortran/libgfortran.h | 1379 ++ libgfortran/libgfortran.spec.in | 8 + libgfortran/libtool-version | 6 + libgfortran/m4/all.m4 | 44 + libgfortran/m4/any.m4 | 44 + libgfortran/m4/bessel.m4 | 187 + libgfortran/m4/count.m4 | 40 + libgfortran/m4/cshift0.m4 | 172 + libgfortran/m4/cshift1.m4 | 274 + libgfortran/m4/eoshift1.m4 | 319 + libgfortran/m4/eoshift3.m4 | 337 + libgfortran/m4/exponent.m4 | 45 + libgfortran/m4/fraction.m4 | 44 + libgfortran/m4/head.m4 | 25 + libgfortran/m4/iall.m4 | 46 + libgfortran/m4/iany.m4 | 46 + libgfortran/m4/iforeach.m4 | 279 + libgfortran/m4/ifunction.m4 | 505 + libgfortran/m4/ifunction_logical.m4 | 208 + libgfortran/m4/in_pack.m4 | 122 + libgfortran/m4/in_unpack.m4 | 110 + libgfortran/m4/iparity.m4 | 46 + libgfortran/m4/iparm.m4 | 37 + libgfortran/m4/matmul.m4 | 378 + libgfortran/m4/matmull.m4 | 241 + libgfortran/m4/maxloc0.m4 | 126 + libgfortran/m4/maxloc1.m4 | 101 + libgfortran/m4/maxval.m4 | 88 + libgfortran/m4/minloc0.m4 | 126 + libgfortran/m4/minloc1.m4 | 101 + libgfortran/m4/minval.m4 | 88 + libgfortran/m4/misc_specifics.m4 | 64 + libgfortran/m4/mtype.m4 | 13 + libgfortran/m4/nearest.m4 | 51 + libgfortran/m4/norm2.m4 | 61 + libgfortran/m4/pack.m4 | 262 + libgfortran/m4/parity.m4 | 40 + libgfortran/m4/pow.m4 | 83 + libgfortran/m4/product.m4 | 46 + libgfortran/m4/reshape.m4 | 356 + libgfortran/m4/rrspacing.m4 | 54 + libgfortran/m4/set_exponent.m4 | 44 + libgfortran/m4/shape.m4 | 68 + libgfortran/m4/spacing.m4 | 53 + libgfortran/m4/specific.m4 | 43 + libgfortran/m4/specific2.m4 | 30 + libgfortran/m4/spread.m4 | 272 + libgfortran/m4/sum.m4 | 46 + libgfortran/m4/transpose.m4 | 115 + libgfortran/m4/types.m4 | 4 + libgfortran/m4/unpack.m4 | 332 + libgfortran/mk-kinds-h.sh | 119 + libgfortran/mk-sik-inc.sh | 34 + libgfortran/mk-srk-inc.sh | 34 + libgfortran/runtime/backtrace.c | 326 + libgfortran/runtime/bounds.c | 272 + libgfortran/runtime/compile_options.c | 197 + libgfortran/runtime/convert_char.c | 69 + libgfortran/runtime/environ.c | 851 + libgfortran/runtime/error.c | 544 + libgfortran/runtime/fpu.c | 41 + libgfortran/runtime/in_pack_generic.c | 218 + libgfortran/runtime/in_unpack_generic.c | 242 + libgfortran/runtime/main.c | 184 + libgfortran/runtime/memory.c | 61 + libgfortran/runtime/pause.c | 68 + libgfortran/runtime/select.c | 46 + libgfortran/runtime/select_inc.c | 133 + libgfortran/runtime/stop.c | 109 + libgfortran/runtime/string.c | 112 + 699 files changed, 229534 insertions(+) create mode 100644 libgfortran/ChangeLog create mode 100644 libgfortran/ChangeLog-2002 create mode 100644 libgfortran/ChangeLog-2003 create mode 100644 libgfortran/ChangeLog-2004 create mode 100644 libgfortran/ChangeLog-2005 create mode 100644 libgfortran/ChangeLog-2006 create mode 100644 libgfortran/ChangeLog-2007 create mode 100644 libgfortran/ChangeLog-2008 create mode 100644 libgfortran/ChangeLog-2009 create mode 100644 libgfortran/ChangeLog-2010 create mode 100644 libgfortran/Makefile.am create mode 100644 libgfortran/Makefile.in create mode 100644 libgfortran/acinclude.m4 create mode 100644 libgfortran/aclocal.m4 create mode 100644 libgfortran/c99_protos.h create mode 100644 libgfortran/config.h.in create mode 100644 libgfortran/config/fpu-387.h create mode 100644 libgfortran/config/fpu-aix.h create mode 100644 libgfortran/config/fpu-generic.h create mode 100644 libgfortran/config/fpu-glibc.h create mode 100644 libgfortran/config/fpu-sysv.h create mode 100755 libgfortran/configure create mode 100644 libgfortran/configure.ac create mode 100644 libgfortran/configure.host create mode 100644 libgfortran/fmain.c create mode 100644 libgfortran/generated/_abs_c10.F90 create mode 100644 libgfortran/generated/_abs_c16.F90 create mode 100644 libgfortran/generated/_abs_c4.F90 create mode 100644 libgfortran/generated/_abs_c8.F90 create mode 100644 libgfortran/generated/_abs_i16.F90 create mode 100644 libgfortran/generated/_abs_i4.F90 create mode 100644 libgfortran/generated/_abs_i8.F90 create mode 100644 libgfortran/generated/_abs_r10.F90 create mode 100644 libgfortran/generated/_abs_r16.F90 create mode 100644 libgfortran/generated/_abs_r4.F90 create mode 100644 libgfortran/generated/_abs_r8.F90 create mode 100644 libgfortran/generated/_acos_r10.F90 create mode 100644 libgfortran/generated/_acos_r16.F90 create mode 100644 libgfortran/generated/_acos_r4.F90 create mode 100644 libgfortran/generated/_acos_r8.F90 create mode 100644 libgfortran/generated/_acosh_r10.F90 create mode 100644 libgfortran/generated/_acosh_r16.F90 create mode 100644 libgfortran/generated/_acosh_r4.F90 create mode 100644 libgfortran/generated/_acosh_r8.F90 create mode 100644 libgfortran/generated/_aimag_c10.F90 create mode 100644 libgfortran/generated/_aimag_c16.F90 create mode 100644 libgfortran/generated/_aimag_c4.F90 create mode 100644 libgfortran/generated/_aimag_c8.F90 create mode 100644 libgfortran/generated/_aint_r10.F90 create mode 100644 libgfortran/generated/_aint_r16.F90 create mode 100644 libgfortran/generated/_aint_r4.F90 create mode 100644 libgfortran/generated/_aint_r8.F90 create mode 100644 libgfortran/generated/_anint_r10.F90 create mode 100644 libgfortran/generated/_anint_r16.F90 create mode 100644 libgfortran/generated/_anint_r4.F90 create mode 100644 libgfortran/generated/_anint_r8.F90 create mode 100644 libgfortran/generated/_asin_r10.F90 create mode 100644 libgfortran/generated/_asin_r16.F90 create mode 100644 libgfortran/generated/_asin_r4.F90 create mode 100644 libgfortran/generated/_asin_r8.F90 create mode 100644 libgfortran/generated/_asinh_r10.F90 create mode 100644 libgfortran/generated/_asinh_r16.F90 create mode 100644 libgfortran/generated/_asinh_r4.F90 create mode 100644 libgfortran/generated/_asinh_r8.F90 create mode 100644 libgfortran/generated/_atan2_r10.F90 create mode 100644 libgfortran/generated/_atan2_r16.F90 create mode 100644 libgfortran/generated/_atan2_r4.F90 create mode 100644 libgfortran/generated/_atan2_r8.F90 create mode 100644 libgfortran/generated/_atan_r10.F90 create mode 100644 libgfortran/generated/_atan_r16.F90 create mode 100644 libgfortran/generated/_atan_r4.F90 create mode 100644 libgfortran/generated/_atan_r8.F90 create mode 100644 libgfortran/generated/_atanh_r10.F90 create mode 100644 libgfortran/generated/_atanh_r16.F90 create mode 100644 libgfortran/generated/_atanh_r4.F90 create mode 100644 libgfortran/generated/_atanh_r8.F90 create mode 100644 libgfortran/generated/_conjg_c10.F90 create mode 100644 libgfortran/generated/_conjg_c16.F90 create mode 100644 libgfortran/generated/_conjg_c4.F90 create mode 100644 libgfortran/generated/_conjg_c8.F90 create mode 100644 libgfortran/generated/_cos_c10.F90 create mode 100644 libgfortran/generated/_cos_c16.F90 create mode 100644 libgfortran/generated/_cos_c4.F90 create mode 100644 libgfortran/generated/_cos_c8.F90 create mode 100644 libgfortran/generated/_cos_r10.F90 create mode 100644 libgfortran/generated/_cos_r16.F90 create mode 100644 libgfortran/generated/_cos_r4.F90 create mode 100644 libgfortran/generated/_cos_r8.F90 create mode 100644 libgfortran/generated/_cosh_r10.F90 create mode 100644 libgfortran/generated/_cosh_r16.F90 create mode 100644 libgfortran/generated/_cosh_r4.F90 create mode 100644 libgfortran/generated/_cosh_r8.F90 create mode 100644 libgfortran/generated/_dim_i16.F90 create mode 100644 libgfortran/generated/_dim_i4.F90 create mode 100644 libgfortran/generated/_dim_i8.F90 create mode 100644 libgfortran/generated/_dim_r10.F90 create mode 100644 libgfortran/generated/_dim_r16.F90 create mode 100644 libgfortran/generated/_dim_r4.F90 create mode 100644 libgfortran/generated/_dim_r8.F90 create mode 100644 libgfortran/generated/_exp_c10.F90 create mode 100644 libgfortran/generated/_exp_c16.F90 create mode 100644 libgfortran/generated/_exp_c4.F90 create mode 100644 libgfortran/generated/_exp_c8.F90 create mode 100644 libgfortran/generated/_exp_r10.F90 create mode 100644 libgfortran/generated/_exp_r16.F90 create mode 100644 libgfortran/generated/_exp_r4.F90 create mode 100644 libgfortran/generated/_exp_r8.F90 create mode 100644 libgfortran/generated/_log10_r10.F90 create mode 100644 libgfortran/generated/_log10_r16.F90 create mode 100644 libgfortran/generated/_log10_r4.F90 create mode 100644 libgfortran/generated/_log10_r8.F90 create mode 100644 libgfortran/generated/_log_c10.F90 create mode 100644 libgfortran/generated/_log_c16.F90 create mode 100644 libgfortran/generated/_log_c4.F90 create mode 100644 libgfortran/generated/_log_c8.F90 create mode 100644 libgfortran/generated/_log_r10.F90 create mode 100644 libgfortran/generated/_log_r16.F90 create mode 100644 libgfortran/generated/_log_r4.F90 create mode 100644 libgfortran/generated/_log_r8.F90 create mode 100644 libgfortran/generated/_mod_i16.F90 create mode 100644 libgfortran/generated/_mod_i4.F90 create mode 100644 libgfortran/generated/_mod_i8.F90 create mode 100644 libgfortran/generated/_mod_r10.F90 create mode 100644 libgfortran/generated/_mod_r16.F90 create mode 100644 libgfortran/generated/_mod_r4.F90 create mode 100644 libgfortran/generated/_mod_r8.F90 create mode 100644 libgfortran/generated/_sign_i16.F90 create mode 100644 libgfortran/generated/_sign_i4.F90 create mode 100644 libgfortran/generated/_sign_i8.F90 create mode 100644 libgfortran/generated/_sign_r10.F90 create mode 100644 libgfortran/generated/_sign_r16.F90 create mode 100644 libgfortran/generated/_sign_r4.F90 create mode 100644 libgfortran/generated/_sign_r8.F90 create mode 100644 libgfortran/generated/_sin_c10.F90 create mode 100644 libgfortran/generated/_sin_c16.F90 create mode 100644 libgfortran/generated/_sin_c4.F90 create mode 100644 libgfortran/generated/_sin_c8.F90 create mode 100644 libgfortran/generated/_sin_r10.F90 create mode 100644 libgfortran/generated/_sin_r16.F90 create mode 100644 libgfortran/generated/_sin_r4.F90 create mode 100644 libgfortran/generated/_sin_r8.F90 create mode 100644 libgfortran/generated/_sinh_r10.F90 create mode 100644 libgfortran/generated/_sinh_r16.F90 create mode 100644 libgfortran/generated/_sinh_r4.F90 create mode 100644 libgfortran/generated/_sinh_r8.F90 create mode 100644 libgfortran/generated/_sqrt_c10.F90 create mode 100644 libgfortran/generated/_sqrt_c16.F90 create mode 100644 libgfortran/generated/_sqrt_c4.F90 create mode 100644 libgfortran/generated/_sqrt_c8.F90 create mode 100644 libgfortran/generated/_sqrt_r10.F90 create mode 100644 libgfortran/generated/_sqrt_r16.F90 create mode 100644 libgfortran/generated/_sqrt_r4.F90 create mode 100644 libgfortran/generated/_sqrt_r8.F90 create mode 100644 libgfortran/generated/_tan_r10.F90 create mode 100644 libgfortran/generated/_tan_r16.F90 create mode 100644 libgfortran/generated/_tan_r4.F90 create mode 100644 libgfortran/generated/_tan_r8.F90 create mode 100644 libgfortran/generated/_tanh_r10.F90 create mode 100644 libgfortran/generated/_tanh_r16.F90 create mode 100644 libgfortran/generated/_tanh_r4.F90 create mode 100644 libgfortran/generated/_tanh_r8.F90 create mode 100644 libgfortran/generated/all_l1.c create mode 100644 libgfortran/generated/all_l16.c create mode 100644 libgfortran/generated/all_l2.c create mode 100644 libgfortran/generated/all_l4.c create mode 100644 libgfortran/generated/all_l8.c create mode 100644 libgfortran/generated/any_l1.c create mode 100644 libgfortran/generated/any_l16.c create mode 100644 libgfortran/generated/any_l2.c create mode 100644 libgfortran/generated/any_l4.c create mode 100644 libgfortran/generated/any_l8.c create mode 100644 libgfortran/generated/bessel_r10.c create mode 100644 libgfortran/generated/bessel_r16.c create mode 100644 libgfortran/generated/bessel_r4.c create mode 100644 libgfortran/generated/bessel_r8.c create mode 100644 libgfortran/generated/count_16_l.c create mode 100644 libgfortran/generated/count_1_l.c create mode 100644 libgfortran/generated/count_2_l.c create mode 100644 libgfortran/generated/count_4_l.c create mode 100644 libgfortran/generated/count_8_l.c create mode 100644 libgfortran/generated/cshift0_c10.c create mode 100644 libgfortran/generated/cshift0_c16.c create mode 100644 libgfortran/generated/cshift0_c4.c create mode 100644 libgfortran/generated/cshift0_c8.c create mode 100644 libgfortran/generated/cshift0_i1.c create mode 100644 libgfortran/generated/cshift0_i16.c create mode 100644 libgfortran/generated/cshift0_i2.c create mode 100644 libgfortran/generated/cshift0_i4.c create mode 100644 libgfortran/generated/cshift0_i8.c create mode 100644 libgfortran/generated/cshift0_r10.c create mode 100644 libgfortran/generated/cshift0_r16.c create mode 100644 libgfortran/generated/cshift0_r4.c create mode 100644 libgfortran/generated/cshift0_r8.c create mode 100644 libgfortran/generated/cshift1_16.c create mode 100644 libgfortran/generated/cshift1_4.c create mode 100644 libgfortran/generated/cshift1_8.c create mode 100644 libgfortran/generated/eoshift1_16.c create mode 100644 libgfortran/generated/eoshift1_4.c create mode 100644 libgfortran/generated/eoshift1_8.c create mode 100644 libgfortran/generated/eoshift3_16.c create mode 100644 libgfortran/generated/eoshift3_4.c create mode 100644 libgfortran/generated/eoshift3_8.c create mode 100644 libgfortran/generated/exponent_r10.c create mode 100644 libgfortran/generated/exponent_r16.c create mode 100644 libgfortran/generated/exponent_r4.c create mode 100644 libgfortran/generated/exponent_r8.c create mode 100644 libgfortran/generated/fraction_r10.c create mode 100644 libgfortran/generated/fraction_r16.c create mode 100644 libgfortran/generated/fraction_r4.c create mode 100644 libgfortran/generated/fraction_r8.c create mode 100644 libgfortran/generated/iall_i1.c create mode 100644 libgfortran/generated/iall_i16.c create mode 100644 libgfortran/generated/iall_i2.c create mode 100644 libgfortran/generated/iall_i4.c create mode 100644 libgfortran/generated/iall_i8.c create mode 100644 libgfortran/generated/iany_i1.c create mode 100644 libgfortran/generated/iany_i16.c create mode 100644 libgfortran/generated/iany_i2.c create mode 100644 libgfortran/generated/iany_i4.c create mode 100644 libgfortran/generated/iany_i8.c create mode 100644 libgfortran/generated/in_pack_c10.c create mode 100644 libgfortran/generated/in_pack_c16.c create mode 100644 libgfortran/generated/in_pack_c4.c create mode 100644 libgfortran/generated/in_pack_c8.c create mode 100644 libgfortran/generated/in_pack_i1.c create mode 100644 libgfortran/generated/in_pack_i16.c create mode 100644 libgfortran/generated/in_pack_i2.c create mode 100644 libgfortran/generated/in_pack_i4.c create mode 100644 libgfortran/generated/in_pack_i8.c create mode 100644 libgfortran/generated/in_pack_r10.c create mode 100644 libgfortran/generated/in_pack_r16.c create mode 100644 libgfortran/generated/in_pack_r4.c create mode 100644 libgfortran/generated/in_pack_r8.c create mode 100644 libgfortran/generated/in_unpack_c10.c create mode 100644 libgfortran/generated/in_unpack_c16.c create mode 100644 libgfortran/generated/in_unpack_c4.c create mode 100644 libgfortran/generated/in_unpack_c8.c create mode 100644 libgfortran/generated/in_unpack_i1.c create mode 100644 libgfortran/generated/in_unpack_i16.c create mode 100644 libgfortran/generated/in_unpack_i2.c create mode 100644 libgfortran/generated/in_unpack_i4.c create mode 100644 libgfortran/generated/in_unpack_i8.c create mode 100644 libgfortran/generated/in_unpack_r10.c create mode 100644 libgfortran/generated/in_unpack_r16.c create mode 100644 libgfortran/generated/in_unpack_r4.c create mode 100644 libgfortran/generated/in_unpack_r8.c create mode 100644 libgfortran/generated/iparity_i1.c create mode 100644 libgfortran/generated/iparity_i16.c create mode 100644 libgfortran/generated/iparity_i2.c create mode 100644 libgfortran/generated/iparity_i4.c create mode 100644 libgfortran/generated/iparity_i8.c create mode 100644 libgfortran/generated/matmul_c10.c create mode 100644 libgfortran/generated/matmul_c16.c create mode 100644 libgfortran/generated/matmul_c4.c create mode 100644 libgfortran/generated/matmul_c8.c create mode 100644 libgfortran/generated/matmul_i1.c create mode 100644 libgfortran/generated/matmul_i16.c create mode 100644 libgfortran/generated/matmul_i2.c create mode 100644 libgfortran/generated/matmul_i4.c create mode 100644 libgfortran/generated/matmul_i8.c create mode 100644 libgfortran/generated/matmul_l16.c create mode 100644 libgfortran/generated/matmul_l4.c create mode 100644 libgfortran/generated/matmul_l8.c create mode 100644 libgfortran/generated/matmul_r10.c create mode 100644 libgfortran/generated/matmul_r16.c create mode 100644 libgfortran/generated/matmul_r4.c create mode 100644 libgfortran/generated/matmul_r8.c create mode 100644 libgfortran/generated/maxloc0_16_i1.c create mode 100644 libgfortran/generated/maxloc0_16_i16.c create mode 100644 libgfortran/generated/maxloc0_16_i2.c create mode 100644 libgfortran/generated/maxloc0_16_i4.c create mode 100644 libgfortran/generated/maxloc0_16_i8.c create mode 100644 libgfortran/generated/maxloc0_16_r10.c create mode 100644 libgfortran/generated/maxloc0_16_r16.c create mode 100644 libgfortran/generated/maxloc0_16_r4.c create mode 100644 libgfortran/generated/maxloc0_16_r8.c create mode 100644 libgfortran/generated/maxloc0_4_i1.c create mode 100644 libgfortran/generated/maxloc0_4_i16.c create mode 100644 libgfortran/generated/maxloc0_4_i2.c create mode 100644 libgfortran/generated/maxloc0_4_i4.c create mode 100644 libgfortran/generated/maxloc0_4_i8.c create mode 100644 libgfortran/generated/maxloc0_4_r10.c create mode 100644 libgfortran/generated/maxloc0_4_r16.c create mode 100644 libgfortran/generated/maxloc0_4_r4.c create mode 100644 libgfortran/generated/maxloc0_4_r8.c create mode 100644 libgfortran/generated/maxloc0_8_i1.c create mode 100644 libgfortran/generated/maxloc0_8_i16.c create mode 100644 libgfortran/generated/maxloc0_8_i2.c create mode 100644 libgfortran/generated/maxloc0_8_i4.c create mode 100644 libgfortran/generated/maxloc0_8_i8.c create mode 100644 libgfortran/generated/maxloc0_8_r10.c create mode 100644 libgfortran/generated/maxloc0_8_r16.c create mode 100644 libgfortran/generated/maxloc0_8_r4.c create mode 100644 libgfortran/generated/maxloc0_8_r8.c create mode 100644 libgfortran/generated/maxloc1_16_i1.c create mode 100644 libgfortran/generated/maxloc1_16_i16.c create mode 100644 libgfortran/generated/maxloc1_16_i2.c create mode 100644 libgfortran/generated/maxloc1_16_i4.c create mode 100644 libgfortran/generated/maxloc1_16_i8.c create mode 100644 libgfortran/generated/maxloc1_16_r10.c create mode 100644 libgfortran/generated/maxloc1_16_r16.c create mode 100644 libgfortran/generated/maxloc1_16_r4.c create mode 100644 libgfortran/generated/maxloc1_16_r8.c create mode 100644 libgfortran/generated/maxloc1_4_i1.c create mode 100644 libgfortran/generated/maxloc1_4_i16.c create mode 100644 libgfortran/generated/maxloc1_4_i2.c create mode 100644 libgfortran/generated/maxloc1_4_i4.c create mode 100644 libgfortran/generated/maxloc1_4_i8.c create mode 100644 libgfortran/generated/maxloc1_4_r10.c create mode 100644 libgfortran/generated/maxloc1_4_r16.c create mode 100644 libgfortran/generated/maxloc1_4_r4.c create mode 100644 libgfortran/generated/maxloc1_4_r8.c create mode 100644 libgfortran/generated/maxloc1_8_i1.c create mode 100644 libgfortran/generated/maxloc1_8_i16.c create mode 100644 libgfortran/generated/maxloc1_8_i2.c create mode 100644 libgfortran/generated/maxloc1_8_i4.c create mode 100644 libgfortran/generated/maxloc1_8_i8.c create mode 100644 libgfortran/generated/maxloc1_8_r10.c create mode 100644 libgfortran/generated/maxloc1_8_r16.c create mode 100644 libgfortran/generated/maxloc1_8_r4.c create mode 100644 libgfortran/generated/maxloc1_8_r8.c create mode 100644 libgfortran/generated/maxval_i1.c create mode 100644 libgfortran/generated/maxval_i16.c create mode 100644 libgfortran/generated/maxval_i2.c create mode 100644 libgfortran/generated/maxval_i4.c create mode 100644 libgfortran/generated/maxval_i8.c create mode 100644 libgfortran/generated/maxval_r10.c create mode 100644 libgfortran/generated/maxval_r16.c create mode 100644 libgfortran/generated/maxval_r4.c create mode 100644 libgfortran/generated/maxval_r8.c create mode 100644 libgfortran/generated/minloc0_16_i1.c create mode 100644 libgfortran/generated/minloc0_16_i16.c create mode 100644 libgfortran/generated/minloc0_16_i2.c create mode 100644 libgfortran/generated/minloc0_16_i4.c create mode 100644 libgfortran/generated/minloc0_16_i8.c create mode 100644 libgfortran/generated/minloc0_16_r10.c create mode 100644 libgfortran/generated/minloc0_16_r16.c create mode 100644 libgfortran/generated/minloc0_16_r4.c create mode 100644 libgfortran/generated/minloc0_16_r8.c create mode 100644 libgfortran/generated/minloc0_4_i1.c create mode 100644 libgfortran/generated/minloc0_4_i16.c create mode 100644 libgfortran/generated/minloc0_4_i2.c create mode 100644 libgfortran/generated/minloc0_4_i4.c create mode 100644 libgfortran/generated/minloc0_4_i8.c create mode 100644 libgfortran/generated/minloc0_4_r10.c create mode 100644 libgfortran/generated/minloc0_4_r16.c create mode 100644 libgfortran/generated/minloc0_4_r4.c create mode 100644 libgfortran/generated/minloc0_4_r8.c create mode 100644 libgfortran/generated/minloc0_8_i1.c create mode 100644 libgfortran/generated/minloc0_8_i16.c create mode 100644 libgfortran/generated/minloc0_8_i2.c create mode 100644 libgfortran/generated/minloc0_8_i4.c create mode 100644 libgfortran/generated/minloc0_8_i8.c create mode 100644 libgfortran/generated/minloc0_8_r10.c create mode 100644 libgfortran/generated/minloc0_8_r16.c create mode 100644 libgfortran/generated/minloc0_8_r4.c create mode 100644 libgfortran/generated/minloc0_8_r8.c create mode 100644 libgfortran/generated/minloc1_16_i1.c create mode 100644 libgfortran/generated/minloc1_16_i16.c create mode 100644 libgfortran/generated/minloc1_16_i2.c create mode 100644 libgfortran/generated/minloc1_16_i4.c create mode 100644 libgfortran/generated/minloc1_16_i8.c create mode 100644 libgfortran/generated/minloc1_16_r10.c create mode 100644 libgfortran/generated/minloc1_16_r16.c create mode 100644 libgfortran/generated/minloc1_16_r4.c create mode 100644 libgfortran/generated/minloc1_16_r8.c create mode 100644 libgfortran/generated/minloc1_4_i1.c create mode 100644 libgfortran/generated/minloc1_4_i16.c create mode 100644 libgfortran/generated/minloc1_4_i2.c create mode 100644 libgfortran/generated/minloc1_4_i4.c create mode 100644 libgfortran/generated/minloc1_4_i8.c create mode 100644 libgfortran/generated/minloc1_4_r10.c create mode 100644 libgfortran/generated/minloc1_4_r16.c create mode 100644 libgfortran/generated/minloc1_4_r4.c create mode 100644 libgfortran/generated/minloc1_4_r8.c create mode 100644 libgfortran/generated/minloc1_8_i1.c create mode 100644 libgfortran/generated/minloc1_8_i16.c create mode 100644 libgfortran/generated/minloc1_8_i2.c create mode 100644 libgfortran/generated/minloc1_8_i4.c create mode 100644 libgfortran/generated/minloc1_8_i8.c create mode 100644 libgfortran/generated/minloc1_8_r10.c create mode 100644 libgfortran/generated/minloc1_8_r16.c create mode 100644 libgfortran/generated/minloc1_8_r4.c create mode 100644 libgfortran/generated/minloc1_8_r8.c create mode 100644 libgfortran/generated/minval_i1.c create mode 100644 libgfortran/generated/minval_i16.c create mode 100644 libgfortran/generated/minval_i2.c create mode 100644 libgfortran/generated/minval_i4.c create mode 100644 libgfortran/generated/minval_i8.c create mode 100644 libgfortran/generated/minval_r10.c create mode 100644 libgfortran/generated/minval_r16.c create mode 100644 libgfortran/generated/minval_r4.c create mode 100644 libgfortran/generated/minval_r8.c create mode 100644 libgfortran/generated/misc_specifics.F90 create mode 100644 libgfortran/generated/nearest_r10.c create mode 100644 libgfortran/generated/nearest_r16.c create mode 100644 libgfortran/generated/nearest_r4.c create mode 100644 libgfortran/generated/nearest_r8.c create mode 100644 libgfortran/generated/norm2_r10.c create mode 100644 libgfortran/generated/norm2_r16.c create mode 100644 libgfortran/generated/norm2_r4.c create mode 100644 libgfortran/generated/norm2_r8.c create mode 100644 libgfortran/generated/pack_c10.c create mode 100644 libgfortran/generated/pack_c16.c create mode 100644 libgfortran/generated/pack_c4.c create mode 100644 libgfortran/generated/pack_c8.c create mode 100644 libgfortran/generated/pack_i1.c create mode 100644 libgfortran/generated/pack_i16.c create mode 100644 libgfortran/generated/pack_i2.c create mode 100644 libgfortran/generated/pack_i4.c create mode 100644 libgfortran/generated/pack_i8.c create mode 100644 libgfortran/generated/pack_r10.c create mode 100644 libgfortran/generated/pack_r16.c create mode 100644 libgfortran/generated/pack_r4.c create mode 100644 libgfortran/generated/pack_r8.c create mode 100644 libgfortran/generated/parity_l1.c create mode 100644 libgfortran/generated/parity_l16.c create mode 100644 libgfortran/generated/parity_l2.c create mode 100644 libgfortran/generated/parity_l4.c create mode 100644 libgfortran/generated/parity_l8.c create mode 100644 libgfortran/generated/pow_c10_i16.c create mode 100644 libgfortran/generated/pow_c10_i4.c create mode 100644 libgfortran/generated/pow_c10_i8.c create mode 100644 libgfortran/generated/pow_c16_i16.c create mode 100644 libgfortran/generated/pow_c16_i4.c create mode 100644 libgfortran/generated/pow_c16_i8.c create mode 100644 libgfortran/generated/pow_c4_i16.c create mode 100644 libgfortran/generated/pow_c4_i4.c create mode 100644 libgfortran/generated/pow_c4_i8.c create mode 100644 libgfortran/generated/pow_c8_i16.c create mode 100644 libgfortran/generated/pow_c8_i4.c create mode 100644 libgfortran/generated/pow_c8_i8.c create mode 100644 libgfortran/generated/pow_i16_i16.c create mode 100644 libgfortran/generated/pow_i16_i4.c create mode 100644 libgfortran/generated/pow_i16_i8.c create mode 100644 libgfortran/generated/pow_i4_i16.c create mode 100644 libgfortran/generated/pow_i4_i4.c create mode 100644 libgfortran/generated/pow_i4_i8.c create mode 100644 libgfortran/generated/pow_i8_i16.c create mode 100644 libgfortran/generated/pow_i8_i4.c create mode 100644 libgfortran/generated/pow_i8_i8.c create mode 100644 libgfortran/generated/pow_r10_i16.c create mode 100644 libgfortran/generated/pow_r10_i8.c create mode 100644 libgfortran/generated/pow_r16_i16.c create mode 100644 libgfortran/generated/pow_r16_i4.c create mode 100644 libgfortran/generated/pow_r16_i8.c create mode 100644 libgfortran/generated/pow_r4_i16.c create mode 100644 libgfortran/generated/pow_r4_i8.c create mode 100644 libgfortran/generated/pow_r8_i16.c create mode 100644 libgfortran/generated/pow_r8_i8.c create mode 100644 libgfortran/generated/product_c10.c create mode 100644 libgfortran/generated/product_c16.c create mode 100644 libgfortran/generated/product_c4.c create mode 100644 libgfortran/generated/product_c8.c create mode 100644 libgfortran/generated/product_i1.c create mode 100644 libgfortran/generated/product_i16.c create mode 100644 libgfortran/generated/product_i2.c create mode 100644 libgfortran/generated/product_i4.c create mode 100644 libgfortran/generated/product_i8.c create mode 100644 libgfortran/generated/product_r10.c create mode 100644 libgfortran/generated/product_r16.c create mode 100644 libgfortran/generated/product_r4.c create mode 100644 libgfortran/generated/product_r8.c create mode 100644 libgfortran/generated/reshape_c10.c create mode 100644 libgfortran/generated/reshape_c16.c create mode 100644 libgfortran/generated/reshape_c4.c create mode 100644 libgfortran/generated/reshape_c8.c create mode 100644 libgfortran/generated/reshape_i16.c create mode 100644 libgfortran/generated/reshape_i4.c create mode 100644 libgfortran/generated/reshape_i8.c create mode 100644 libgfortran/generated/reshape_r10.c create mode 100644 libgfortran/generated/reshape_r16.c create mode 100644 libgfortran/generated/reshape_r4.c create mode 100644 libgfortran/generated/reshape_r8.c create mode 100644 libgfortran/generated/rrspacing_r10.c create mode 100644 libgfortran/generated/rrspacing_r16.c create mode 100644 libgfortran/generated/rrspacing_r4.c create mode 100644 libgfortran/generated/rrspacing_r8.c create mode 100644 libgfortran/generated/set_exponent_r10.c create mode 100644 libgfortran/generated/set_exponent_r16.c create mode 100644 libgfortran/generated/set_exponent_r4.c create mode 100644 libgfortran/generated/set_exponent_r8.c create mode 100644 libgfortran/generated/shape_i16.c create mode 100644 libgfortran/generated/shape_i4.c create mode 100644 libgfortran/generated/shape_i8.c create mode 100644 libgfortran/generated/spacing_r10.c create mode 100644 libgfortran/generated/spacing_r16.c create mode 100644 libgfortran/generated/spacing_r4.c create mode 100644 libgfortran/generated/spacing_r8.c create mode 100644 libgfortran/generated/spread_c10.c create mode 100644 libgfortran/generated/spread_c16.c create mode 100644 libgfortran/generated/spread_c4.c create mode 100644 libgfortran/generated/spread_c8.c create mode 100644 libgfortran/generated/spread_i1.c create mode 100644 libgfortran/generated/spread_i16.c create mode 100644 libgfortran/generated/spread_i2.c create mode 100644 libgfortran/generated/spread_i4.c create mode 100644 libgfortran/generated/spread_i8.c create mode 100644 libgfortran/generated/spread_r10.c create mode 100644 libgfortran/generated/spread_r16.c create mode 100644 libgfortran/generated/spread_r4.c create mode 100644 libgfortran/generated/spread_r8.c create mode 100644 libgfortran/generated/sum_c10.c create mode 100644 libgfortran/generated/sum_c16.c create mode 100644 libgfortran/generated/sum_c4.c create mode 100644 libgfortran/generated/sum_c8.c create mode 100644 libgfortran/generated/sum_i1.c create mode 100644 libgfortran/generated/sum_i16.c create mode 100644 libgfortran/generated/sum_i2.c create mode 100644 libgfortran/generated/sum_i4.c create mode 100644 libgfortran/generated/sum_i8.c create mode 100644 libgfortran/generated/sum_r10.c create mode 100644 libgfortran/generated/sum_r16.c create mode 100644 libgfortran/generated/sum_r4.c create mode 100644 libgfortran/generated/sum_r8.c create mode 100644 libgfortran/generated/transpose_c10.c create mode 100644 libgfortran/generated/transpose_c16.c create mode 100644 libgfortran/generated/transpose_c4.c create mode 100644 libgfortran/generated/transpose_c8.c create mode 100644 libgfortran/generated/transpose_i16.c create mode 100644 libgfortran/generated/transpose_i4.c create mode 100644 libgfortran/generated/transpose_i8.c create mode 100644 libgfortran/generated/transpose_r10.c create mode 100644 libgfortran/generated/transpose_r16.c create mode 100644 libgfortran/generated/transpose_r4.c create mode 100644 libgfortran/generated/transpose_r8.c create mode 100644 libgfortran/generated/unpack_c10.c create mode 100644 libgfortran/generated/unpack_c16.c create mode 100644 libgfortran/generated/unpack_c4.c create mode 100644 libgfortran/generated/unpack_c8.c create mode 100644 libgfortran/generated/unpack_i1.c create mode 100644 libgfortran/generated/unpack_i16.c create mode 100644 libgfortran/generated/unpack_i2.c create mode 100644 libgfortran/generated/unpack_i4.c create mode 100644 libgfortran/generated/unpack_i8.c create mode 100644 libgfortran/generated/unpack_r10.c create mode 100644 libgfortran/generated/unpack_r16.c create mode 100644 libgfortran/generated/unpack_r4.c create mode 100644 libgfortran/generated/unpack_r8.c create mode 100644 libgfortran/gfortran.map create mode 100644 libgfortran/intrinsics/abort.c create mode 100644 libgfortran/intrinsics/access.c create mode 100644 libgfortran/intrinsics/args.c create mode 100644 libgfortran/intrinsics/associated.c create mode 100644 libgfortran/intrinsics/bit_intrinsics.c create mode 100644 libgfortran/intrinsics/c99_functions.c create mode 100644 libgfortran/intrinsics/chdir.c create mode 100644 libgfortran/intrinsics/chmod.c create mode 100644 libgfortran/intrinsics/clock.c create mode 100644 libgfortran/intrinsics/cpu_time.c create mode 100644 libgfortran/intrinsics/cshift0.c create mode 100644 libgfortran/intrinsics/ctime.c create mode 100644 libgfortran/intrinsics/date_and_time.c create mode 100644 libgfortran/intrinsics/dprod_r8.f90 create mode 100644 libgfortran/intrinsics/dtime.c create mode 100644 libgfortran/intrinsics/env.c create mode 100644 libgfortran/intrinsics/eoshift0.c create mode 100644 libgfortran/intrinsics/eoshift2.c create mode 100644 libgfortran/intrinsics/erfc_scaled.c create mode 100644 libgfortran/intrinsics/erfc_scaled_inc.c create mode 100644 libgfortran/intrinsics/etime.c create mode 100644 libgfortran/intrinsics/execute_command_line.c create mode 100644 libgfortran/intrinsics/exit.c create mode 100644 libgfortran/intrinsics/extends_type_of.c create mode 100644 libgfortran/intrinsics/f2c_specifics.F90 create mode 100644 libgfortran/intrinsics/fnum.c create mode 100644 libgfortran/intrinsics/gerror.c create mode 100644 libgfortran/intrinsics/getXid.c create mode 100644 libgfortran/intrinsics/getcwd.c create mode 100644 libgfortran/intrinsics/getlog.c create mode 100644 libgfortran/intrinsics/hostnm.c create mode 100644 libgfortran/intrinsics/ierrno.c create mode 100644 libgfortran/intrinsics/ishftc.c create mode 100644 libgfortran/intrinsics/iso_c_binding.c create mode 100644 libgfortran/intrinsics/iso_c_binding.h create mode 100644 libgfortran/intrinsics/iso_c_generated_procs.c create mode 100644 libgfortran/intrinsics/kill.c create mode 100644 libgfortran/intrinsics/link.c create mode 100644 libgfortran/intrinsics/malloc.c create mode 100644 libgfortran/intrinsics/move_alloc.c create mode 100644 libgfortran/intrinsics/mvbits.c create mode 100644 libgfortran/intrinsics/pack_generic.c create mode 100644 libgfortran/intrinsics/perror.c create mode 100644 libgfortran/intrinsics/rand.c create mode 100644 libgfortran/intrinsics/random.c create mode 100644 libgfortran/intrinsics/rename.c create mode 100644 libgfortran/intrinsics/reshape_generic.c create mode 100644 libgfortran/intrinsics/reshape_packed.c create mode 100644 libgfortran/intrinsics/selected_char_kind.c create mode 100644 libgfortran/intrinsics/selected_int_kind.f90 create mode 100644 libgfortran/intrinsics/selected_real_kind.f90 create mode 100644 libgfortran/intrinsics/signal.c create mode 100644 libgfortran/intrinsics/size.c create mode 100644 libgfortran/intrinsics/sleep.c create mode 100644 libgfortran/intrinsics/spread_generic.c create mode 100644 libgfortran/intrinsics/stat.c create mode 100644 libgfortran/intrinsics/string_intrinsics.c create mode 100644 libgfortran/intrinsics/string_intrinsics_inc.c create mode 100644 libgfortran/intrinsics/symlnk.c create mode 100644 libgfortran/intrinsics/system.c create mode 100644 libgfortran/intrinsics/system_clock.c create mode 100644 libgfortran/intrinsics/time.c create mode 100644 libgfortran/intrinsics/time_1.h create mode 100644 libgfortran/intrinsics/transpose_generic.c create mode 100644 libgfortran/intrinsics/umask.c create mode 100644 libgfortran/intrinsics/unlink.c create mode 100644 libgfortran/intrinsics/unpack_generic.c create mode 100644 libgfortran/io/close.c create mode 100644 libgfortran/io/fbuf.c create mode 100644 libgfortran/io/fbuf.h create mode 100644 libgfortran/io/file_pos.c create mode 100644 libgfortran/io/format.c create mode 100644 libgfortran/io/format.h create mode 100644 libgfortran/io/inquire.c create mode 100644 libgfortran/io/intrinsics.c create mode 100644 libgfortran/io/io.h create mode 100644 libgfortran/io/list_read.c create mode 100644 libgfortran/io/lock.c create mode 100644 libgfortran/io/open.c create mode 100644 libgfortran/io/read.c create mode 100644 libgfortran/io/size_from_kind.c create mode 100644 libgfortran/io/transfer.c create mode 100644 libgfortran/io/transfer128.c create mode 100644 libgfortran/io/unit.c create mode 100644 libgfortran/io/unix.c create mode 100644 libgfortran/io/unix.h create mode 100644 libgfortran/io/write.c create mode 100644 libgfortran/io/write_float.def create mode 100644 libgfortran/kinds-override.h create mode 100644 libgfortran/libgfortran.h create mode 100644 libgfortran/libgfortran.spec.in create mode 100644 libgfortran/libtool-version create mode 100644 libgfortran/m4/all.m4 create mode 100644 libgfortran/m4/any.m4 create mode 100644 libgfortran/m4/bessel.m4 create mode 100644 libgfortran/m4/count.m4 create mode 100644 libgfortran/m4/cshift0.m4 create mode 100644 libgfortran/m4/cshift1.m4 create mode 100644 libgfortran/m4/eoshift1.m4 create mode 100644 libgfortran/m4/eoshift3.m4 create mode 100644 libgfortran/m4/exponent.m4 create mode 100644 libgfortran/m4/fraction.m4 create mode 100644 libgfortran/m4/head.m4 create mode 100644 libgfortran/m4/iall.m4 create mode 100644 libgfortran/m4/iany.m4 create mode 100644 libgfortran/m4/iforeach.m4 create mode 100644 libgfortran/m4/ifunction.m4 create mode 100644 libgfortran/m4/ifunction_logical.m4 create mode 100644 libgfortran/m4/in_pack.m4 create mode 100644 libgfortran/m4/in_unpack.m4 create mode 100644 libgfortran/m4/iparity.m4 create mode 100644 libgfortran/m4/iparm.m4 create mode 100644 libgfortran/m4/matmul.m4 create mode 100644 libgfortran/m4/matmull.m4 create mode 100644 libgfortran/m4/maxloc0.m4 create mode 100644 libgfortran/m4/maxloc1.m4 create mode 100644 libgfortran/m4/maxval.m4 create mode 100644 libgfortran/m4/minloc0.m4 create mode 100644 libgfortran/m4/minloc1.m4 create mode 100644 libgfortran/m4/minval.m4 create mode 100644 libgfortran/m4/misc_specifics.m4 create mode 100644 libgfortran/m4/mtype.m4 create mode 100644 libgfortran/m4/nearest.m4 create mode 100644 libgfortran/m4/norm2.m4 create mode 100644 libgfortran/m4/pack.m4 create mode 100644 libgfortran/m4/parity.m4 create mode 100644 libgfortran/m4/pow.m4 create mode 100644 libgfortran/m4/product.m4 create mode 100644 libgfortran/m4/reshape.m4 create mode 100644 libgfortran/m4/rrspacing.m4 create mode 100644 libgfortran/m4/set_exponent.m4 create mode 100644 libgfortran/m4/shape.m4 create mode 100644 libgfortran/m4/spacing.m4 create mode 100644 libgfortran/m4/specific.m4 create mode 100644 libgfortran/m4/specific2.m4 create mode 100644 libgfortran/m4/spread.m4 create mode 100644 libgfortran/m4/sum.m4 create mode 100644 libgfortran/m4/transpose.m4 create mode 100644 libgfortran/m4/types.m4 create mode 100644 libgfortran/m4/unpack.m4 create mode 100755 libgfortran/mk-kinds-h.sh create mode 100755 libgfortran/mk-sik-inc.sh create mode 100755 libgfortran/mk-srk-inc.sh create mode 100644 libgfortran/runtime/backtrace.c create mode 100644 libgfortran/runtime/bounds.c create mode 100644 libgfortran/runtime/compile_options.c create mode 100644 libgfortran/runtime/convert_char.c create mode 100644 libgfortran/runtime/environ.c create mode 100644 libgfortran/runtime/error.c create mode 100644 libgfortran/runtime/fpu.c create mode 100644 libgfortran/runtime/in_pack_generic.c create mode 100644 libgfortran/runtime/in_unpack_generic.c create mode 100644 libgfortran/runtime/main.c create mode 100644 libgfortran/runtime/memory.c create mode 100644 libgfortran/runtime/pause.c create mode 100644 libgfortran/runtime/select.c create mode 100644 libgfortran/runtime/select_inc.c create mode 100644 libgfortran/runtime/stop.c create mode 100644 libgfortran/runtime/string.c (limited to 'libgfortran') diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog new file mode 100644 index 000000000..81fef505b --- /dev/null +++ b/libgfortran/ChangeLog @@ -0,0 +1,710 @@ +2013-04-12 Release Manager + + * GCC 4.6.4 released. + +2013-04-04 Tobias Burnus + + Backport from mainline: + 2013-03-29 Tobias Burnus + + PR fortran/56737 + * io/format.c (parse_format): With caching, copy + dtp->format string. + (save_parsed_format): Use dtp->format directly without + copying. + + 2012-03-29 Tobias Burnus + + PR fortran/56737 + * io/format.c (parse_format_list): Also cache FMT_STRING. + (parse_format): Update call. + +2013-04-04 Tobias Burnus + + Backport from mainline: + 2013-03-28 Tobias Burnus + + PR fortran/56735 + * io/list_read.c (nml_query): Only abort when + an error occured. + (namelist_read): Add goto instead of falling through. + +2012-10-21 Thomas König + + PR libfortran/54736 + Backport from trunk + * runtime/environ.c (search_unit): Correct logic + for binary search. + (mark_single): Fix index errors. + +2012-05-12 Tobias Burnus + + PR fortran/53310 + * intrinsics/eoshift2.c (eoshift2): Do not leak + memory by allocating it in the loop. + +2012-03-01 Release Manager + + * GCC 4.6.3 released. + +2011-11-20 Andreas Tobler + + * configure: Regenerate. + +2011-10-26 Release Manager + + * GCC 4.6.2 released. + +2011-10-19 Janne Blomqvist + Kai Tietz + Tobias Burnus + + PR fortran/50016 + * io/unix.h (flush_sync): Add new libgfortran-internal prototype. + * io/unix.c (flush_sync): New function, which calls sflush and + on MinGW(-w64) also _commit. + (flush_all_units, flush_all_units_1): Replace sflush/_commit by + flush_sync. + * io/file_pos.c (st_flush): Replace sflush/_commit by flush_sync. + * io/intrinsics.c (flush_i4, flush_i8): Ditto. + +2011-10-18 Tobias Burnus + Janne Blomqvist + + PR fortran/50016 + * io/file_pos.c (st_flush): Call _commit on MinGW(-w64). + * io/intrinsics.c (flush_i4, flush_i8): Ditto. + * io/unix.c (flush_all_units_1, flush_all_units): Ditto. + (buf_flush): Remove _commit call. + * io/inquire.c (inquire_via_unit): Flush internal buffer + and call file_length instead of invoking stat via file_size. + +2011-09-11 Thomas Koenig + + Backport fron trunk + PR fortran/49479 + * generated/m4/ifunction.m4: Always call internal_malloc_size + even when there is a zero-sized return array. + * generated/generated/maxloc1_16_i16.c: Regenerated. + * generated/generated/maxloc1_16_i1.c: Regenerated. + * generated/generated/maxloc1_16_i2.c: Regenerated. + * generated/generated/maxloc1_16_i4.c: Regenerated. + * generated/generated/maxloc1_16_i8.c: Regenerated. + * generated/generated/maxloc1_16_r10.c: Regenerated. + * generated/generated/maxloc1_16_r16.c: Regenerated. + * generated/generated/maxloc1_16_r4.c: Regenerated. + * generated/generated/maxloc1_16_r8.c: Regenerated. + * generated/generated/maxloc1_4_i16.c: Regenerated. + * generated/generated/maxloc1_4_i1.c: Regenerated. + * generated/generated/maxloc1_4_i2.c: Regenerated. + * generated/generated/maxloc1_4_i4.c: Regenerated. + * generated/generated/maxloc1_4_i8.c: Regenerated. + * generated/generated/maxloc1_4_r10.c: Regenerated. + * generated/generated/maxloc1_4_r16.c: Regenerated. + * generated/generated/maxloc1_4_r4.c: Regenerated. + * generated/generated/maxloc1_4_r8.c: Regenerated. + * generated/generated/maxloc1_8_i16.c: Regenerated. + * generated/generated/maxloc1_8_i1.c: Regenerated. + * generated/generated/maxloc1_8_i2.c: Regenerated. + * generated/generated/maxloc1_8_i4.c: Regenerated. + * generated/generated/maxloc1_8_i8.c: Regenerated. + * generated/generated/maxloc1_8_r10.c: Regenerated. + * generated/generated/maxloc1_8_r16.c: Regenerated. + * generated/generated/maxloc1_8_r4.c: Regenerated. + * generated/generated/maxloc1_8_r8.c: Regenerated. + * generated/generated/maxval_i16.c: Regenerated. + * generated/generated/maxval_i1.c: Regenerated. + * generated/generated/maxval_i2.c: Regenerated. + * generated/generated/maxval_i4.c: Regenerated. + * generated/generated/maxval_i8.c: Regenerated. + * generated/generated/maxval_r10.c: Regenerated. + * generated/generated/maxval_r16.c: Regenerated. + * generated/generated/maxval_r4.c: Regenerated. + * generated/generated/maxval_r8.c: Regenerated. + * generated/generated/minloc1_16_i16.c: Regenerated. + * generated/generated/minloc1_16_i1.c: Regenerated. + * generated/generated/minloc1_16_i2.c: Regenerated. + * generated/generated/minloc1_16_i4.c: Regenerated. + * generated/generated/minloc1_16_i8.c: Regenerated. + * generated/generated/minloc1_16_r10.c: Regenerated. + * generated/generated/minloc1_16_r16.c: Regenerated. + * generated/generated/minloc1_16_r4.c: Regenerated. + * generated/generated/minloc1_16_r8.c: Regenerated. + * generated/generated/minloc1_4_i16.c: Regenerated. + * generated/generated/minloc1_4_i1.c: Regenerated. + * generated/generated/minloc1_4_i2.c: Regenerated. + * generated/generated/minloc1_4_i4.c: Regenerated. + * generated/generated/minloc1_4_i8.c: Regenerated. + * generated/generated/minloc1_4_r10.c: Regenerated. + * generated/generated/minloc1_4_r16.c: Regenerated. + * generated/generated/minloc1_4_r4.c: Regenerated. + * generated/generated/minloc1_4_r8.c: Regenerated. + * generated/generated/minloc1_8_i16.c: Regenerated. + * generated/generated/minloc1_8_i1.c: Regenerated. + * generated/generated/minloc1_8_i2.c: Regenerated. + * generated/generated/minloc1_8_i4.c: Regenerated. + * generated/generated/minloc1_8_i8.c: Regenerated. + * generated/generated/minloc1_8_r10.c: Regenerated. + * generated/generated/minloc1_8_r16.c: Regenerated. + * generated/generated/minloc1_8_r4.c: Regenerated. + * generated/generated/minloc1_8_r8.c: Regenerated. + * generated/generated/minval_i16.c: Regenerated. + * generated/generated/minval_i1.c: Regenerated. + * generated/generated/minval_i2.c: Regenerated. + * generated/generated/minval_i4.c: Regenerated. + * generated/generated/minval_i8.c: Regenerated. + * generated/generated/minval_r10.c: Regenerated. + * generated/generated/minval_r16.c: Regenerated. + * generated/generated/minval_r4.c: Regenerated. + * generated/generated/minval_r8.c: Regenerated. + * generated/generated/product_c10.c: Regenerated. + * generated/generated/product_c16.c: Regenerated. + * generated/generated/product_c4.c: Regenerated. + * generated/generated/product_c8.c: Regenerated. + * generated/generated/product_i16.c: Regenerated. + * generated/generated/product_i1.c: Regenerated. + * generated/generated/product_i2.c: Regenerated. + * generated/generated/product_i4.c: Regenerated. + * generated/generated/product_i8.c: Regenerated. + * generated/generated/product_r10.c: Regenerated. + * generated/generated/product_r16.c: Regenerated. + * generated/generated/product_r4.c: Regenerated. + * generated/generated/product_r8.c: Regenerated. + * generated/generated/sum_c10.c: Regenerated. + * generated/generated/sum_c16.c: Regenerated. + * generated/generated/sum_c4.c: Regenerated. + * generated/generated/sum_c8.c: Regenerated. + * generated/generated/sum_i16.c: Regenerated. + * generated/generated/sum_i1.c: Regenerated. + * generated/generated/sum_i2.c: Regenerated. + * generated/generated/sum_i4.c: Regenerated. + * generated/generated/sum_i8.c: Regenerated. + * generated/generated/sum_r10.c: Regenerated. + * generated/generated/sum_r16.c: Regenerated. + * generated/generated/sum_r4.c: Regenerated. + * generated/generated/sum_r8.c: Regenerated. + +2011-08-29 Thomas Koenig + + Backport from trunk + PR libfortran/50192 + * intrinsics/string_intrinsics.c (memcmp_char4): New function. + * intrinsics/string_intrinsics_inc.c: New macro MEMCMP, either + set to memcmp or memcmp_char4. + (compare_string): Use MEMCMP, with correct size for it. + * libgfortran.h: Add prototype for memcmp_char4. + +2011-08-19 Tobias Burnus + + PR fortran/50109 + * io/list_read.c (eat_separator): Fix skipping over "!" lines. + +2011-07-27 Tobias Burnus + + Backport from mainline + 2011-07-23 Tobias Burnus + + PR fortran/49791 + * io/list_read.c (nml_parse_qualifier): Remove check to + enabled extended read for another case. + +2011-07-13 Janne Blomqvist + + Backport from trunk: + PR libfortran/49296 + * io/list_read.c (read_logical): Don't error out if a valid value + is followed by EOF instead of a normal separator. + (read_integer): Likewise. + +2011-07-06 Thomas Koenig + + Partial backport from trunk: + PR fortran/49479 + * runtime/memory.c: If size is zero, allocate a single byte. + * m4/eoshift1.m4: Remove double allocation. + * m4/eoshift3.m4: Likewise. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift1_16.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + +2011-07-03 Janne Blomqvist + + Backport from mainline: + PR libfortran/49296 + * io/list_read.c (read_character): Accept EOF as a separator when + reading string. + +2011-06-27 Release Manager + + * GCC 4.6.1 released. + +2011-04-30 Jerry DeLisle + + Backport from mainline: + PR libgfortran/48030 + * io/read.c (read_x): Re-implement using fbuf_getc. + +2011-04-18 Janne Blomqvist + + PR libfortran/47571 + * configure: Regenerated. + * config.h.in: Regenerated. + * acinclude.m4: Add alpha*-dec-osf* to gthread blacklist. + * configure.ac: Use separate symbol for clock_gettime in librt. + * intrinsics/system_clock.c: Use weakrefs only when needed and + supported. + +2011-03-28 Rainer Orth + + Backport from mainline: + 2011-03-21 Rainer Orth + + PR bootstrap/48135 + * configure.ac (gfortran_use_symver): Handle --disable-symvers. + * configure: Regenerate. + +2011-03-25 Release Manager + + * GCC 4.6.0 released. + +2011-03-17 Rainer Orth + + PR fortran/47571 + * intrinsics/system_clock.c [__alpha__ && __osf__] + (HAVE_CLOCK_GETTIME): Undef. + +2011-03-12 Thomas Koenig + + PR libfortran/48066 + * m4/ifunction.m4: If return array is empty, return. + * m4/ifunction_logical.m4: Likewise. + * generated/all_l16.c: Regenerated. + * generated/all_l1.c: Regenerated. + * generated/all_l2.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/any_l1.c: Regenerated. + * generated/any_l2.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_16_l.c: Regenerated. + * generated/count_1_l.c: Regenerated. + * generated/count_2_l.c: Regenerated. + * generated/count_4_l.c: Regenerated. + * generated/count_8_l.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2011-03-11 Jerry DeLisle + + PR libgfortran/48047 + * io/write_float.def (write_float): Change MIN_FIELD_WIDTH to 48. + +2011-03-04 Janne Blomqvist + + PR libfortran/47802 + * intrinsics/ctime.c (strctime): Use builtins to check localtime_r + return type. + +2011-03-04 Janne Blomqvist + + PR libfortran/47802 + * intrinsics/ctime.c (strctime): Don't use return value of + localtime_r. + +2011-02-28 Jerry DeLisle + + PR libgfortran/47567 + * io/write_float.def (output_float): Move handling of w = 0 to after + output rounding. Check for zero and set zero_flag accordingly. Set + width according to zero_flag. Add better comments. + +2011-02-27 Jerry DeLisle + + PR libgfortran/47778 + * io/list_read.c (namelist_read): Intialize the error string buffere. + If pprev_nl was used during the previous namelist read and the rank + was zero, reset the pointer to NULL for the next namelist read. + +2011-02-26 Francois-Xavier Coudert + + PR libfortran/45165 + * unix.c (fallback_access): Fix file descriptor leaks. + +2011-02-25 Francois-Xavier Coudert + + * acinclude.m4 (LIBGFOR_CHECK_FPSETMASK): Set shell variable + tested in configure.host. + * configure: Regenerate. + +2011-02-24 Janne Blomqvist + + PR libfortran/47802 + * config.h.in: Regenerated. + * configure: Regenerated. + * configure.ac: Remove checks for ctime and ctime_r, add check for + strftime. + * intrinsics/date_and_time.c (localtime_r): Move fallback + implementation to time_1.h. + * intrinsics/time_1.h (localtime_r): Fallback implementation. + * intrinsics/ctime.c: Include time_1.h. + (ctime_r): Remove fallback implementation. + (strctime): New function. + (fdate): Use strctime instead of ctime_r. + (fdate_sub): Likewise. + (ctime): Likewise. + (ctime_sub): Likewise. + +2011-02-24 Jakub Jelinek + + PR fortran/47878 + * io/transfer.c (read_sf): Call fbuf_getptr only at the end, + and subtract n, dtp->u.p.sf_seen_eor and seen_comma from it. + +2011-02-24 Janne Blomqvist + + PR libfortran/47802 + * configure.ac: Add test for POSIX getpwuid_r. + * intrinsics/getlog.c (getlog): CPP test for + HAVE_POSIX_GETPWUID_R. + * config.h.in: Regenerated. + * configure: Regenerated. + +2011-02-23 Jerry DeLisle + + PR libgfortran/47567 + * io/write_float.def (output_float): Remove special case handling of + zero with width 1. + +2011-02-23 Janne Blomqvist + Jerry DeLisle + + PR libfortran/47694 + * io/fbuf.h (fbuf_getptr): New inline function. + * io/transfer.c (read_sf): Use fbuf_getptr and fbuf_getc to scan + through the string instead of fbuf_read. + +2011-02-22 Tobias Burnus + Kai-Uwe Eckhardt + + PR libfortran/47830 + * intrinsics/c99_functions.c (roundl): Make C valid for + HAVE_NEXTAFTERL. + +2011-02-19 Jerry DeLisle + + PR libgfortran/47567 + * io/write_float.def (output_float): Adjust width for F0.d to + allow space for negative signs on zero. + +2011-02-16 Jerry DeLisle + + PR libgfortran/47667 + * io/list_read.c (read_logical): Check for end of line before calling + eat_line. (read_integer): Likewise. (parse_real): Don't unget the + separator. Check for end of line before calling eat_line. + (read_complex): Allow line-end before and after parenthesis and comma. + Check for end of line before calling eat_line. (read_real): Check for + end of line before calling eat_line. + +2011-02-16 Jakub Jelinek + + PR libfortran/47757 + * gfortran.map (GFORTRAN_1.4): Export + _gfortran_{m,s}i{all,any,parity}_i{1,2,4,8,16} and + _gfortran_{cshift0,eoshift{0,2}}_16_char4. + +2011-02-15 Tobias Burnus + + PR fortran/47716 + PR fortran/47648 + * acinclude.m4 (LIBGFOR_CHECK_FLOAT128): Use check from + libquadmath, which uses more features. + * configure: Regenerate. + +2011-02-14 Jakub Jelinek + + PR fortran/47642 + * io/write_float.def (DTOAQ): Use quadmath_snprintf instead of + quadmath_flt128tostr. + * io/transfer128.c (tmp2): Initialize to quadmath_snprintf instead + of quadmath_flt128tostr. + +2011-02-13 Ralf Wildenhues + + * Makefile.in: Regenerate. + * aclocal.m4: Likewise. + * configure: Likewise. + +2011-02-05 Jerry DeLisle + + PR libgfortran/47567 + * io/write_float.def (output_float): Eliminate some redundant code. + Adjust width for case of F0.X for values of zero and all other values. + Expand cases where '*' is set to give cleaner results. + +2011-02-05 Janne Blomqvist + + PR libfortran/47571 + * intrinsics/time_1.h (GF_CLOCK_MONOTONIC): Move to system_clock.c. + (weak_gettime): Likewise. + (gf_gettime): Change API, move weak_gettime() usage to + system_clock.c + * intrinsics/system_clock.c (GTHREAD_USE_WEAK): Define. + (gf_gettime_mono): New function. + (system_clock_4): Use gf_gettime_mono(). + (system_clock_8): Likewise. + * intrinsics/date_and_time.c (date_and_time): Update gf_gettime() + usage. + +2011-02-02 Janne Blomqvist + + PR libfortran/47571 + * configure: Regenerated. + * configure.ac: Don't add librt to LIBS. + * intrinsics/time_1.h (weak_gettime): Weakref trickery for + clock_gettime(). + (gf_gettime): Use weak_gettime() instead of clock_gettime(). + +2011-02-01 Janne Blomqvist + + * intrinsics/time_1.h: Include errno.h needed by fallbacks. + +2011-01-31 Janne Blomqvist + + * intrinsics/time_1.h: Fix definition of GF_CLOCK_MONOTONIC macro. + +2011-01-31 Janne Blomqvist + + * configure.ac: Check for clock_gettime(). + * configure: Regenerated. + * config.h.in: Regenerated. + * intrinsics/time_1.h (__time_1): Rename to gf_cputime, add + times() fallback. + (gf_gettime): New function. + * intrinsics/cpu_time.c (__cpu_time_1): Update to call gf_cputime. + * intrinsics/date_and_time.c (date_and_time): Use gf_gettime. + * intrinsics/dtime.c (dtime_sub): Use gf_cputime. + * intrinsics/etime.c (etime_sub): Use gf_cputime. + * intrinsics/system_clock.c (system_clock_4): Use gf_gettime. + (system_clock_8): Use gf_gettime, increase count rate to allow + nanosecond precision, remove overflow prone branch. + +2011-01-29 Jerry DeLisle + + PR libgfortran/47434 + * io/write_float.def (write_infnan): Use calculate_sign to determine + if the sign should be given and check field widths accordingly. + +2011-01-29 Kai Tietz + + * intrinsics/ctime.c (ctime_r): Improve implementation. + +2011-01-27 Janne Blomqvist + + PR libfortran/47431 + * config.h.in: Regenerated. + * configure: Regenerated. + * configure.ac: Add check for ctime_r(). + * intrinsics/ctime.c (ctime_r): Fallback implementation. + (fdate): Use ctime_r() instead of ctime(). + (fdate_sub): Likewise. + (ctime): Likewise. + (ctime_sub): Likewise. + +2011-01-27 Janne Blomqvist + + PR libfortran/47432 + * config.h.in: Regenerated. + * configure: Regenerated. + * configure.ac: Add check for ttyname_r. + * io/unix.h: Add TTY_NAME_MAX, change stream_ttyname prototype. + * io/unix.c (stream_ttyname): Use ttyname_r if available, conform + to new prototype. + * io/inquire.c (inquire_via_unit): Use changed stream_ttyname. + * io/intrinsics.c (ttynam_sub): Likewise. + (ttynam): Likewise. + +2011-01-27 Janne Blomqvist + + PR libfortran/47491 + * configure.ac: Call AC_USE_SYSTEM_EXTENSIONS to enable common + extensions. + * config.h.in: Regenerate. + * configure: Regenerate. + +2011-01-26 Jerry DeLisle + + PR libgfortran/47285 + * io/write_float.def (write_infnan): Adjust processor selected width + to 3 if NaN. + +2011-01-26 Jerry DeLisle + + PR libgfortran/47285 + * io/write_float.def (output_float): Return SUCCESS or FAILURE and use + the result to set the padding. + +2011-01-26 Kai Tietz + + * intrinsics/getlog.c (getlog): Fix label/statement issue. + +2011-01-25 Janne Blomqvist + + PR libfortran/47375 + * config.h.in: Regenerated. + * configure: Regenerated. + * configure.ac: Add check for getpwuid_r. + * intrinsics/getlog.c (getlog): Use getpwuid_r() if available. + +2011-01-22 Janne Blomqvist + + PR libfortran/46267 + * config.h.in: Regenerated. + * configure: Regenerated. + * configure.ac: Check presence of strerror_r. + * intrinsics/gerror.c (gerror): Use gf_strerror, modify logic. + * io/unix.c (get_oserror): Remove. + * libgfortran.h (gf_strerror): Add prototype. + (get_oserror): Remove prototype. + * runtime/error.c (gf_strerror): New function. + (os_error): Use gf_strerror instead of get_oserror. + (generate_errror): Likewise. + +2011-01-17 Janne Blomqvist + + PR libfortran/47296 + * io/unix.c (tempfile): Set opp->file and opp->file_len also if an + error occurs. + +2011-01-16 Jakub Jelinek + + PR fortran/46625 + * io/write_float.def (DTOAQ): Use quadmath_flt128tostr + instead of quadmath_dtoa. + * io/transfer128.c (tmp1, tmp2): New variables, bring in + strtoflt128 and quadmath_flt128tostr. + (transfer_real128, transfer_real128_write, transfer_complex128, + transfer_complex128_write): Remove tmp1/tmp2 variables. + * io/read.c (convert_real): Use strtoflt128 instead of + quadmath_strtopQ, adjust for the changed arguments and return + value. + +2011-01-14 Jerry DeLisle + + PR libgfortran/47296 + * io/unix.c (unpack_filename): Return non-zero if the filename passed + in is NULL. + +2011-01-04 Jerry DeLisle + + PR libgfortran/47154 + * io/list_read.c (namelist_read): Remove calls to hit_eof to avoid the + duplicate calls via next_record. + + +Copyright (C) 2011 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/libgfortran/ChangeLog-2002 b/libgfortran/ChangeLog-2002 new file mode 100644 index 000000000..a7043dd90 --- /dev/null +++ b/libgfortran/ChangeLog-2002 @@ -0,0 +1,67 @@ +2002-12-29 Paul Brook + + * intrinsics/reshape.*: New files. + * gcc_config.patch: Update to new GCC configure system. + +2002-10-10 Paul Brook + + * intrinsics/size.c: New file. + * intrinsics/shape.m4: New file. + * Makefile.am: Add above files. + +2002-10-02 Paul Brook + + * fmain.c (main): Move here. + * libgfor.c: From here. + * libgfor.h (gfor_init, gfor_runtime_cleanup): Declare. + * Makefile.am: Build libgforbegin. + * gcc_config.patch: Remove stray -march=athlon. + * dotprodl.m4: Fix use of L8_TO_L4 macro. + * ifunction.m4: Move variable declarations to allow compilation with + gcc < 3.0 + * specific.m4, specific4.m4: Fix typo typecode->type_code. + * README: Document use of patch -p1. + +2002-09-12 Paul Brook + + * math/*: Add complex math library functions. + * intrinsics/specific(2).m4: Generate Specific intrinsic functions. + * Makefile.am: Add details for above. + * configure.in: Use AC_PROG_F95. Test for the presence of csin. + +2002-09-09 Paul Brook + + * libgfor.c (determine_endianness): Use an array rather than a struct. + * intrinsics/dotprod*, matmul*: Implement DOT_PRODUCT and MATMUL. + +2002-09-09 Steven Bosscher + + * libgfor.c: Add fatal signal handler. + Romove superfluous abort() calls. + +2002-09-07 Paul Brook + + * Makefile.am, intrinsics: Major rewrite. + +2002-09-02 Paul Brook + + * Makefile.am: Added -I$(srcdir) to m4 rule. + +2002-08-30 Paul Brook + + * io/*: Integrated libgforio. + * Makefile.am, configure.in: Make compatable with GCC. Build code for + intrinsics in the intrisics directory. + * intrinsics/intrinsics.m4: Move here. Strip directories from the + filename. Add 'and' and 'all' intrinsics. + +2002-08-17 Paul Brook + + * ALL: First release as more than just a single file + + +Copyright (C) 2002 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/libgfortran/ChangeLog-2003 b/libgfortran/ChangeLog-2003 new file mode 100644 index 000000000..98b3508f7 --- /dev/null +++ b/libgfortran/ChangeLog-2003 @@ -0,0 +1,549 @@ +2003-12-12 Huang Chun + + * intrinsics/string_intrinsics.c (string_index): Fix logics thinko. + +2003-12-05 Melvin Hadasht + + * io/transfer.c (data_transfer_init): Give a runtime error for list + formatted reads and writes from/to files opened for unformatted IO. + +2003-11-30 Paul Brook + + * runtime/memory.c (push_context): Remove. + (pop_context): Remove. + * libgfortran.h: Remove prototypes. + +2003-11-27 Paul Brook + + * runtime/memory.c (deallocate): Nullify pointer after freeing. + +2003-11-27 Paul Brook + + * intrinsics/string_intrinsics.c: Use new memory allocation interface. + * libgfortran.h: Ditto. + * m4/in_pack.m4: Ditto. + * runtime/in_pack_generic.c: Ditto. + * runtime/memory.c: Ditto. + +2003-11-26 Richard Henderson + + * m4/exponent.m4, m4/fraction.m4: New. + * m4/nearest.m4, m4/set_exponent.m4: New. + * generated/*: Update. + * Makefile.am: Add them. + (AM_CFLAGS): New. Use -std=gnu99. + * Makefile.in: Regenerate. + +2003-11-08 Paul Brook + + PR fortran/12704 + * m4/maxloc0.m4: Use default value of 1. Handle zero sized arrays. + * m4/maxloc1.m4: Ditto. + * m4/minloc0.m4: Ditto. + * m4/minloc1.m4: Ditto. + * m4/ifunction.m4: Set return value for zero sized arrays. + * m4/iforeach.m4: Ditto. + * m4/all.m4, m4/any.m4, m4/count.m4, m4/maxloc1.m4, m4/minloc1.m4, + m4/mxaval.m4, m4/minval.m4, m4/product.m4, m4/sum.m4: Ditto. + * generated/*: Update. + +2003-10-30 Toon Moene + + PR fortran/12702 + * io/list_read.c (eat_spaces): Treat tab as space. + +2003-10-30 Lars Segerlund + + * intrinsics/random.c: Add reference to paper containing algorithm. + (random_seed): Extra error checking and proper handling of arrays. + (arandom_r4, arandom_r8): Implement. + +2003-10-29 Toon Moene + + PR fortran/12703 + * runtime/memory.c (allocate_size): Allow allocation + of zero-sized objects. + +2003-10-29 Toon Moene + + PR fortran/12701 + * open.c (new_unit): Open without a file name opens + a file with name fort.. + +2003-10-12 Feng Wang + + * intrinsics/cshift0.c: New file. + * m4/cshift1.m4: New file + * generated/cshift*.c: New files. + * Makefile.am: Add them. + * Makefile.in: Regenerate. + +2003-10-12 XiaoQiang Zhang + + * io/list_read.c (read_character): Remove unwanted call to free_saved. + +2003-10-11 Huang Chun + + * intrinsics/string_intrinsics.c (string_trim): New function. + (string_repeat): New function. + +2003-10-11 Paul Brook + + * intrinsics/dprod_r8.f90: New file. + * Makefile.am (gfor_specific_src): Add it. + (gfor_built_specific_src): Rename from gfor_build_specific_c. + Add new intrinsics. + (gfor_specific2_src): Rename from gfor_built_specific2_c. + Add new intrinsics. + * Makefile.in: Regenerate. + * generated/_aint_*.f90: New files. + * generated/_anint*.f90: New files. + * generated/_atan2*.f90: New files. + * generated/_mod*.f90: New files. + +2003-09-20 Kejia Zhao + + * intrinsics/selected_kind.f90: New file. + * Makefile.am: Add it. + * Makefile.in: regenerate. + +2003-09-19 Lars Segerlund + Paul Brook + + * intrinsics/random.c: New file. + * Makefile.am (gfor_hemper_src): Add it. + (gfor_specific_c): Fix typo. + +2003-09-19 Paul Brook + + * All: rename g95->gfc. + +2003-09-18 XiaoQiang Zhang + + * io/write.c (output_float): Fix bug of FMT_E, Add comments. + +2003-09-09 XiaoQiang Zhang + + * io/write.c (write_float): Dectection of positive infinite number, + Not a Number(NaN) and negative infinite number. + (ioutput_float): Bug fix for FMT_E and FMT_D processing to + output a very_very small number ( < 0.1e-100 ). + +2003-09-07 XiaoQiang Zhang + + * libgfortran.h (xtoa, itoa): Parameter modified. + * io/io.h (namelist_info): Declaration to support namelist I/O + (st_parameter): Add namelist related component + (ionml, empty_internal_buffer, st_set_nml_var_int, + st_set_nml_var_float, st_set_nml_var_char, st_set_nml_var_complex, + st_set_nml_var_log): Declaration + (set_integer, set_integer): Parameter changed + * io/format.c (free_nodes): Fix annoying bug of lefting "deallocated" + fnodes + (parse_format_list): Fix bug about FMT_SLASH + * io/list_read.c (push_char): Totally clear old saved_string, zeroize + newly allocated saved_string + (next_char): Add detection of End_Of_Line support + (convert_integer): Now can process 64 bits interger + (read_real): Bug fixed + (init_at_eol, find_nml_node, match_namelist_name): Add new functions + (match_namelist_name): New implemention + * io/lock.c (ionml): New global variable + (library_end): Free memory in ionml + * io/open.c (st_open): Variable initializtion + * io/read.c (max_value): 64 bits interger support + (convert_precsion_real): New procedure to replace "strtod" with more + features + (read_f, read_radix): Input bug fix + * io/transfer.c: (sf_seen_eor): New static variable + (read_sf): Zeroize base buffer; fix bugs: single read statement can + not get input in mutli line when read from stdin + (formatted_transfer): Fix bug of FMT_O, FMT_B, FMT_Z for INTEGER type + request + (data_transfer_init): Clear internal buffer for Internel File I/O. + Internal File now worked. Detect some error condition for namelist. + Some minor bug fix + (next_record_w): Internal file and Namelist I/O support. + (st_set_nml_var, st_set_nml_var_float, st_set_nml_var_char, + st_set_nml_var_complex, st_set_nml_var_log): Implemention. + * io/unit.c (implicit_unit): Deletion + (get_unit): Now cannot open a unit implicitly. + * io/unix.c (mmap_alloc): Fix fatal error in calculating the length of + mapped buffer. + (mem_alloc_r_at): Internal file I/O support added + (empty_internal_buffer): New function + * io/write.c (extract_int): Support 64 bits interger processing + (output_float): Varibale initialization + (write_float): Infinite real number detection. + (write_int): 64 bits integer I/O support + (write_decimal): New function to output decimal number + (otoa, btoa): Better implemention and 64 bits interger support + (namelist_write): New function + * runtime/error.c (itoa, xtoa): Better implemention and 64 bits + interger support + +2003-08-15 Arnaud Desitter + + * libgfortran.h (os_error, runtime_error,internal_error, sys_exit, + get_mem ): Add attribute. + * intrinsics/spread_generic.c (__spread): Fix spelling. + * io/inquire.c (inquire_via_filename): Add const. + * io/io.h (sys_exit): Add attribute. + * io/io.h (move_pos_offset): Add move_pos_offset. + * io/io.h (compare_file_filename, inquire_sequential, inquire_direct, + inquire_formatted, inquire_unformatted, inquire_read, inquire_write, + inquire_readwrite, convert_real, write_a, write_b, write_d, write_e, + write_en, write_es, write_f, write_i, write_l, write_o, write_x, + write_z): Add const. + * io/read.c (convert_real): Add const. + * io/transfer.c (type_name): Add const. + * io/unix.c (unpack_filename, compare_file_filename,inquire_sequential, + inquire_direct, inquire_formatted, inquire_unformatted, inquire_access, + inquire_read, inquire_write, inquire_readwrite): Add const. + * io/write.c (output_float): Remove unused variable. + * io/write.c (write_a, extract_int, extract_real, output_float, + write_float, write_int, write_i, write_b, write_o, write_z, write_d, + write_e, write_f, write_en, write_es, write_logical, write_integer, + write_character, write_real, write_complex): Add const. + * runtime/error.c (rtoa): Remove unused variable. + * runtime/select.c (select_string): Add const. + * runtime/stop.c (stop_string): Add const. + +2003-08-10 Paul Brook + + * Makefile.am (gfor_helper_src): Add intrinsics/abort.c. + (FFLAGS): Add -fno-underscoring. + * Makefile.in: Regenerate. + * intrinsics/abort.c: New file. + +2003-08-10 Erik Schnetter + + * fmain.c (main): Do not call init and cleanup; call set_args instead. + * libgfortran.h (init, cleanup): Remove declarations. + (set_args): Add declaration. + * runtime/main.c (init, cleanup): Make them static, and give them + the constructor and destructor attributes. + (set_args): New function. + +2003-08-10 Paul Brook + + * intrinsics/strinf_intrinsics.c (compare_string): Return value based + on which string is longest. + +2003-08-10 Paul Brook + + * Makefile.am (EXTRA_DIST): Remove old files. + * Makefile.in: Regenerate. + +2003-07-26 Paul Brook + + Rename library to libgfortran. + * libgfortran.h: Change prefix to _libgfortran_. + +2003-07-24 Paul Brook + + * configure.in: Don't pull in system libtool. Use toplevel + auxiliary files. + +2003-07-22 Paul Brook + + Regenerate all configury files. + +2003-07-09 Chun Huang + + * intrinsics/string_intrinsic.c (string_scan): New function. + (string_verify): New function. + +2003-06-25 Paul Brook + + * io/unix.c (mem_alloc_r_at, mem_alloc_w_at): Advance logical_offset. + (mem_seek): Don't bother setting physical_offset. + +2003-06-20 Paul Brook + + * libgfor.h (stop_numeric): Declare. + * runtime/pause.c: New file. + * Makefile.am: Add it. + +2003-06-08 Paul Brook + + * m4/cexp.m4 (cabs): Use correct typed version. + (csqrt): New function. + +2003-06-07 Canqun Yang + + Spotted by Benjamin and Tobias: + * io/list_read.c: Add Separator '\t'. + (parse_real, read_real): Accept real values starting with an optional + sign follows a decimal point. + +2003-06-06 Steven Bosscher + + * Makefile.am: Don't put cmath objects in subdir. + * configure.in: Rename MATHOBJ to MATH_OBJ. + +2003-06-02 Kejia Zhao + + * intrinsics/associated.c: New file. + * Makefile.am: Add it. Regenerate Makefile.in. + * libgfor.h: Define g95_array_void, G95_DESCRIPTOR_DATA, and + G95_DESCRIPTOR_DTYPE. + +2003-06-01 Canqun Yang + + * io/write.c (calcuate_exp): Rewrite it to avoid overflow. + (calculate_G_format): Rewrite it to eliminate an infinte loop and set + the scale_factor to 0 for F editing. + +2003-05-11 Tobias Schlter + + * libgfor.h: Only include stdint.h if it exists. + +2003-05-07 Paul Brook + + * libgfor.h: Use stdint.h types. + * intrinsics/ishift.c: Ditto. + * runtime/memory.c (malloc_t): Reorder fields for better alignment. + +2003-05-05 Steven Bosscher + + * libgfor.h (offsetof): Define if nobody else does. + * runtime/memory.c (HEADER_SIZE): Use it. + +2003-05-01 Tobias Schlter + + * configure.in: Require autoconf 2.54. + +2003-04-28 Tobias Schlter + Paul Brook + + * intrinsics/reshape_generic.c: Copy the whole element, not just the + first byte. + * m4/transpose.m4: New file. + * Makefile.am: Add them. + Regenerate generated files. + +2003-04-18 Steven Bosscher + + * io/format.c (parse_format_list): Allow 'X' without integer + prefix. This is an extension. Interpretation is '1X'. + +2003-04-18 Tobias Schlter + + * io/format.c (parse_format_list): Allow '0P'. + +2003-04-18 Steven Bosscher + + * Makefile.in: Re-regenerate for automake 1.7.3. + +2003-04-18 Canqun Yang + + Port implementation for CHARACTER SELECT from Andy's tree. + * runtime/select.c: New file + * Makefile.am: Add it. + * Makefile.in: Regenerate. + +2003-04-17 Xiaoqiang Zhang + + * io/transfer.c (formatted_transfer): Modified + * io/unix.c (move_pos_offset): New Function. + * io/format.c (parse_format_list): Modified. + +2003-04-15 Xiaoqiang Zhang + + * io/write.c (write_float,write_real): New implemention of + FMT_G and default float editing. + (calculate_exp,calculate_G_format,output_float): New Function. + (write_float,write_real,write_logical): Modified + * libgfor.h (default_rtoa): Remove Declaration. + * runtime/error.c (default_rtoa): Remove Function. + +2003-04-15 Steven Bosscher + + Spotted by Yang: + * io/write.c (extract_real): Add missing break statement. + +2003-04-13 Steven Bosscher + + * cpu_time.c: Make sure we have a definition of HZ. Don't + rely on CLOCKS_PER_SEC, it is always 1000000, on any system. + +2003-04-13 Steven Bosscher + Paul Brook + + * configure.in: Check for process time headers and GETTIMEOFDAY. + * makefile.am: Add intrinsics/cpu_time.c. + * acinclude.m4: New file. + * intrinsics/cpu_time.c: New file. + * m4/dotprodl.m4: Fix typo. + Regenerate generated files. + +2003-04-11 Xiaoqiang Zhang + + * io/write.c (extract_real): Ouput floating point value. + (write_float): New Function. + (write_e, write_f, write_en, write_es): Modified + * io/transfer.c (formatted_transfer): Modified. + * libgfor.h (default_rtoa): Declaration. + (rtoa): Declaration. + * runtime/error.c (default_rtoa): New Function. + (rtoa): New Function. + +2003-04-05 Paul Brook + + * intrinsics/spread_generic.c: New file. + * Makefile.am: Add it. Regenerate Makefile.in. + +2003-03-29 Paul Brook + + * intrinsics/pack_generic.c: New file. + * intrinsics/unpack_generic.c: New file. + * Makefile.am: Add them. Regenerate Makefile.in. + +2003-03-25 Paul Brook + + * intrinsics/eoshift0.c: New file. + * intrinsics/eoshift2.c: New file. + * m4/eoshift1.m4: New file. + * m4/eoshift3.m4: New file. + * Makefile.am: Add them. + * in_unpack_generic.c: Initialize src. + Regenerate generated files. + +2003-03-14 Paul Brook + + * m4/shape.m4: Work properly with array temporaries. + * m4/in_pack.m4: Skip redundant checks for array temporaries. + * runtime/in_pack_generic.c: Ditto. + +2003-03-12 Paul Brook + + * m4/shape.m4: Work properly with noncontiguous arrays. + +2003-03-08 Paul Brook + + * m4/in_pack.m4: Correctly handle zero sized and assumed size arrays. + * runtime/in_pack_generic.c: Ditto. + +2003-02-08 Paul Brook + + * intrinsics/reshape_generic.c: Use runtime_error to report errors. + * io/close.c (st_close): Return void. + * io/open.c (st_open): Return void. + * libgfor.h (g95_array_char): Declare. + (internal_malloc_size): Ditto. + (internal_pack*, internal_unpack*): Ditto. + * m4/in_pack.m4: Allocate storage if neccessary. Fix logic for packed + arrays. + * m4/in_unpack.m4: Include file fixes. + * m4/reshape.m4: Increment the correct source pointer. + * Makefile.am (maxloc): Fix typo. + * runtime/in_pack_generic.c: Call optimized functions. Allocate + storage if neccessary. Fix logic for packed arrays. + * runtime/in_unpack_generic.c: Call optimized functions. + * runtime/main.c: Use runtime_error to report errors. + * memory.c (internal_malloc_size): Make non-static. + +2003-02-02 Arnaud Desitter + + * reshape_packed.c, lock.c: Add #include . + * libgfor.h, format.c, inquire.c, io.h, transfer.c, unix.c, + environ.c, error.c, memory.c, string.c: Add const. + * error.c (show_locus): Add void. + +2003-02-21 Paul Brook + + * m4/in_pack.m4: Avoid returning const * parameter. + * Makefile.am: Only regenerate files in maintainer mode. + +2003-02-20 Paul Brook + + Add array repacking support functions. + * m4/in_pack.m4, m4/in_unpack.m4: New files. + * runtime/in_pack_generic.c, runtime/in_unpack_generic.c: New files. + * Makefile.am: Build them. Regenerate configury files. + * generated/: New directory for generated files (need to move + everything else there). + +2003-02-07 Tobias Schlueter + + * m4/cexp.m4: Fix typo. + +2003-01-26 Paul Brook + + * intrinsics/: Add missing generated files. + +2003-01-26 Paul Brook + + * Makefile.am: Put -I before the filename. + +2003-01-24 Paul Brook + + * configure.in: Add AM_MAINTAINER_MODE. + +2003-01-23 Paul Brook + + * configure.in, Makefile.am: Modify to work with unmodified autoconf + and auotmake. + Also regenerate other configury files. + +2003-01-21 Paul Brook + + * io/read.c: Don't use stdint.h, it doesn't exist on cygwin. + +2003-01-20 Steven Bosscher + + * io/read.c (read_f): Don't use alloca, but safe get_mem instead. + Don't include "alloca.h". + +2003-01-20 Steven Bosscher + + * intrinsics/string.c: Rename to intrinsics/string_intrinsics.c. + * Makefile.am: Adjust file name. + * Makefile.in: Regenerate. + * gfortypes.h: Kill, include everything in... + * libgfor.h: ...here. Include config.h + * fmain.c, intrinsics/ishftc.c, intrinsic/reshape_generic.c, + intrinsics/reshape_i4.c, intrinsics/reshape_i8.c, + intrinsics/reshape_packed.c, intrinsics/size.c, + m4/reshape.m4, runtime/main.c, runtime/memory.c: Use macro + for prefix for all functions instead of hardcoded. + +2003-01-19 Steven Bosscher + + * io/lock.c (library_end): Propagate library return + code. + +2003-01-19 Steven Bosscher + + Port fixes from Andy's tree: + * io/read.c (read_decimal): Reverse sense of overflow + comparison during integer reads. + * io/format.c (revert): Fix comment. + (next_format): Fix format revision. + * io/unix.c: Fix and simplify mmap version of stream + functions. + +2003-01-11 Paul Brook + + * configure, Makefile.in: Regenerate. + +2003-01-11 Paul Brook + + * runtime/stop.c: Rewrite. + +2003-01-08 Paul Brook + + * configure, Makefile.in: Regenerate. + +2003-01-05 Paul Brook + + * (*.m4) Move to m4/. + * intrinsics/string.c (_gfor_string_index): New Function. + + +Copyright (C) 2003 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/libgfortran/ChangeLog-2004 b/libgfortran/ChangeLog-2004 new file mode 100644 index 000000000..4775115a3 --- /dev/null +++ b/libgfortran/ChangeLog-2004 @@ -0,0 +1,1111 @@ +2004-12-27 Tobias Schlueter + + * libgfortran/libgfortran.h (GFC_UINTEGER_1, GFC_UINTEGER_2): + Define. + * intrinsics/ishftc.c: Update copyright years. + (ishftc8): Change 'shift' and 'size' to GFC_INTEGER_4. + * intrinsics/mvbits.c: Correct non-ASCII character in my name. + Add implementations for GFC_INTEGER_1 and GFC_INTEGER_2. + +2004-12-23 Bud Davis + + PR fortran/19071 + * io/tranfer.c (formatted_transfer): moved check for + format reversion inside the processing loop. + +2004-12-19 Aaron W. LaFramboise + + PR libfortran/19074 + * libgfortran.h (itoa): Rename to gfc_itoa. + * io/write.c (itoa): Same. + * runtime/environ.c (itoa): Same. + * runtime/error.c (itoa): Same. + +2004-12-15 Bud Davis + Steven G. Kargl + + PR fortran/17597 + * io/list_read.c (read_real): do not push back a comma when + it delimits a real value without a decimal point + +2004-12-14 Steve Ellcey + + * libgfortran/io/transfer.c (us_read): Use memcpy/memset + instead of assignment to fill unaligned buffer. + (us_write): Ditto. + (next_record_w): Ditto. + +2004-12-14 Steven G. Kargl + + PR libfortran/18966 + * gfortran.h: typedef GFC_INTEGER_1 and GFC_INTEGER_2 + * intrinsics/cshift0.c (cshift0_1,cshift0_2): New functions. + * intrinsics/eoshift0.c (eoshift0_1,eoshift0_2): New functions. + * intrinsics/eoshift2.c (eoshift2_1,eoshift2_2): New functions. + +2004-12-13 David Edelsohn + + * io/transfer.c (read_sf): Change bitwise "and" to logical "and". + +2004-12-12 Richard Henderson + + * intrinsics/cshift0.c, intrinsics/eoshift0.c, intrinsics/eoshift2.c, + intrinsics/pack_generic.c, intrinsics/reshape_generic.c, + intrinsics/spread_generic.c, intrinsics/transpose_generic.c, + intrinsics/unpack_generic.c, m4/cshift1.m4, m4/dotprod.m4, + m4/dotprodc.m4, m4/dotprodl.m4, m4/eoshift1.m4, m4/eoshift3.m4, + m4/iforeach.m4, m4/ifunction.m4, m4/matmul.m4, m4/matmull.m4, + m4/reshape.m4, m4/shape.m4, m4/transpose.m4: Use standard prefix + instead of "__". + * generated/*: Rebuild. + +2004-12-12 Richard Henderson + + * acinclude.m4 (LIBGFOR_CHECK_ATTRIBUTE_VISIBILITY): New. + (LIBGFOR_CHECK_ATTRIBUTE_DLLEXPORT): New. + (LIBGFOR_CHECK_ATTRIBUTE_ALIAS): New. + * configure.ac: Use them. + * configure, config.h.in, aclocal.m4: Rebuild. + * libgfortran.h (prefix): Remove. + (PREFIX, IPREFIX): New. + (sym_rename, sym_rename1, sym_rename2): New. + (internal_proto, export_proto, export_proto_np): New. + (iexport_proto, iexport): New. + (iexport_data_proto, iexport_data): New. + * intrinsics/abort.c, intrinsics/args.c, intrinsics/associated.c, + intrinsics/cpu_time.c, intrinsics/cshift0.c, + intrinsics/date_and_time.c, intrinsics/env.c, intrinsics/eoshift0.c, + intrinsics/eoshift2.c, intrinsics/etime.c, intrinsics/exit.c, + intrinsics/flush.c, intrinsics/fnum.c, intrinsics/getXid.c, + intrinsics/getcwd.c, intrinsics/ishftc.c, intrinsics/mvbits.c, + intrinsics/pack_generic.c, intrinsics/rand.c, intrinsics/random.c, + intrinsics/reshape_generic.c, intrinsics/size.c, + intrinsics/spread_generic.c, intrinsics/stat.c, + intrinsics/string_intrinsics.c, intrinsics/system.c, + intrinsics/system_clock.c, intrinsics/transpose_generic.c, + intrinsics/umask.c, intrinsics/unlink.c, intrinsics/unpack_generic.c, + io/backspace.c, io/close.c, io/endfile.c, io/inquire.c, io/io.h, + io/open.c, io/rewind.c, io/transfer.c, libgfortran.h, 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/iforeach.m4, + m4/ifunction.m4, m4/matmul.m4, m4/matmull.m4, m4/nearest.m4, + m4/pow.m4, m4/reshape.m4, m4/set_exponent.m4, m4/shape.m4, + m4/transpose.m4, runtime/environ.c, runtime/error.c, + runtime/in_pack_generic.c, runtime/in_unpack_generic.c, + runtime/main.c, runtime/memory.c, runtime/pause.c, runtime/select.c, + runtime/stop.c: Use them to mark symbols internal or external. + * generated/*: Rebuild. + +2004-12-09 David Edelsohn + + PR bootstrap/18895 + Revert 2004-12-07 change. + * Makefile.am (AM_MAKEFLAGS): Delete. + * Makefile.in: Regenerate. + +2004-12-07 Steve Ellcey + + * libgfortran/Makefile.am (AM_MAKEFLAGS): New. + * libgfortran/Makefile.in: Regenerate + +2004-12-07 Steve Ellcey + + * io/io.h (open_external): Change prototype. + * io/unix.c (regular_file): Change prototype and set flags->action if + needed. + (open_external): Ditto. + * io/open.c (new_unit): Let open_external set flags->action. + +2004-12-07 Eric Botcazou + + * configure.ac: Check for ieeefp.h. Check for fabsf in libm. + * configure: Regenerate. + * config.h.in: Likewise. + * c99_protos.h: New file. + * libgfortran.h: Include c99_protos.h and conditionally ieeefp.h. + * intrinsics/c99_functions.c (fabsf): New function. + +2004-12-06 Richard Henderson + + * intrinsics/cshift0.c, intrinsics/eoshift0.c, intrinsics/eoshift2.c, + intrinsics/pack_generic.c, intrinsics/string_intrinsics.c, + intrinsics/transpose_generic.c, m4/ifunction.m4, m4/matmul.m4, + m4/matmull.m4, m4/transpose.m4: Use internal_malloc_size instead + of internal_malloc. + * generated/*: Rebuild. + +2004-12-06 Richard Henderson + + * intrinsics/c99_functions.c, intrinsics/eoshift0.c, + intrinsics/eoshift2.c, intrinsics/exit.c, intrinsics/flush.c, + intrinsics/ishftc.c, intrinsics/mvbits.c, intrinsics/pack_generic.c, + intrinsics/random.c, intrinsics/reshape_generic.c, intrinsics/size.c, + intrinsics/spread_generic.c, intrinsics/stat.c, + intrinsics/string_intrinsics.c, intrinsics/system_clock.c, + intrinsics/transpose_generic.c, intrinsics/unlink.c, + intrinsics/unpack_generic.c, io/backspace.c, io/format.c, + io/list_read.c, io/lock.c, io/open.c, io/transfer.c, io/unix.c, + io/write.c, runtime/environ.c, runtime/error.c, + runtime/in_pack_generic.c, runtime/in_unpack_generic.c, runtime/main.c, + runtime/memory.c, runtime/pause.c, runtime/stop.c, + runtime/string.c: Whitespace fixes. + +2004-12-06 Richard Henderson + + * Makefile.am: Generate all m4 output under $(srcdir). + * Makefile.in: Regenerate. + +2004-12-02 Tobias Schlueter + + PR fortran/18710 + * io/transfer.c (unformatted_read, unformatted_write): width of + a COMPLEX is twice its kind. + +2004-12-02 Richard Sandiford + + * configure.ac: Use TL_AC_GCC_VERSION to set gcc_version. + * configure, aclocal.m4, Makefile.in: Regenerate. + +2004-12-02 Bud Davis + + PR libfortran/18284 + * io/unix.c (fd_alloc_w_at): Update file_length when extending. + * io/backspace.c (formatted_backspace): Reset endfile after backspace. + +2004-12-02 Bud Davis + + * io/inquire.c (inquire_via_unit): do not allow a direct access + file to be opened for sequential I/O. + +2004-12-02 Steven G. Kargl + Paul Brook + + * intrinsics/flush.c: New file. + * intrinsics/fnum.c: ditto + * intrinsics/stat.c: ditto + * io/io.h (unit_to_fd): Add prototype. + * io/unix.c (unit_to_fd): New function. + * configure.ac: Add test for members of struct stat. Check for + sys/types.h and sys/stat.h + * Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c} + * configure.in: Regenerate. + * config.h.in: Regenerate. + * Makefile.in: Regenerate. + +2004-12-01 Aaron W. LaFramboise + + * Makefile.am (AM_CPPFLAGS): Use -iquote instead of -I. + +2004-11-28 Bud Davis + + * io/unix.c (mmap_alloc_w_a): check for a write to a location + less than the mapped area. + +2004-11-27 Bud Davis + + PR fortran/18364 + * io/endfile.c (st_endfile): flush the stream before truncating. + +2004-11-24 Kelley Cook + + * configure: Regenerate for libtool change. + +2004-11-22 Steven Bosscher + + PR libfortran/15960 + * configure.ac: Check for finite in libm. + * libgfortran.h: Define isfinite macro if not defined. + * intrinsics/c99_functions.c: Use defined(fpclassify) instead of + HAVE_FPCLASSIFY. + * io/write.c (write_float): Use isfinite instead of finite. + * configure, config.h.in: Rebuilt. + +2004-11-20 Roger Sayle + + * io/write.c (write_float, list_formatted_write): Fix indentation. + +2004-11-20 Eric Botcazou + + PR target/16135 + * acinclude.m4 (LIBGFOR_TARGET_ILP32): New check. + * configure.ac: Include LIBGFOR_TARGET_ILP32. + * configure: Regenerate. + * config.h.in: Likewise. + * libgfortran.h: Provide default definitions for C99 types + on ILP32 targets that don't have them. + + PR target/17999 + * configure.ac: Check for snprintf. + * configure: Regenerate. + * config.h.in: Likewise. + * intrinsics/date_and_time.c (date_and_time): Do not + use snprinf if it is not available. + * io/write.c (output_float): Likewise. + +2004-11-20 Steven G. Kargl + + * Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c} + * Makefile.in: Regenerated + * intrinsics/umask.c: New file + * intrinsics/unlink.c: ditto + * intrinsics/exit.c: ditto + +2004-11-18 Victor Leikehman + + * m4/matmul.m4: Loops reordered to improve cache behavior. + * generated/matmul_??.c: Regenerated. + +2004-11-10 Paul Brook + + PR fortran/18218 + * configure.ac: Check for strtof. + * configure: Regenerate. + * config.h.in: Regenerate. + * io/read.c (convert_real): Use strtof if available. + (convert_precision_real): Remove. + (read_f): Avoid poor exponentiation algorithm. + +2004-11-05 Andreas Schwab + + * configure.ac: Use AC_PROG_FC, FC and FCFLAGS instead of + AC_PROG_F77, F77 and FFLAGS. + * Makefile.am (selected_int_kind.inc, selected_real_kind.inc): Use + FCCOMPILE instead of F77COMPILE. + * configure, Makefile.in: Regenerate. + +2004-11-05 Kelley Cook + + * acinclude.m4: Properly quote AC_CACHE_CHECK. + * Makefile.am: Add in ACLOCAL_AMFLAGS. + * aclocal.m4, configure, Makefile.in: Regenerate. + +2004-10-30 Aaron W. LaFramboise + + * config.h.in: Regenerate. + * configure: Regenerate. + * configure.ac (AC_CHECK_FUNCS): Add mkstemp. + * io/unix.c (S_IRGRP): Define if undefined. + (S_IWGRP): Same. + (S_IROTH): Same. + (S_IWOTH): Same. + (tempfile): Use mktemp if mkstemp missing, fix typos. + +2004-10-30 Aaron W. LaFramboise + + * intrinsics/system.c ("libgfortran.h"): Move after system headers. + +2004-10-30 Canqun Yang + + * intrinsics/rand.c (irand): Handle NULL argument. + +2004-10-07 Paul Brook + + * io/transfer.c (finalize_transfer): Free internal streams. + * io/unix.c (mem_close): Free stream object. + +2004-10-07 Paul Brook + + * intrinsics/string_intrinsics.c (string_verify): Fix off by one + error. + +2004-10-06 Paul Brook + + PR libfortran/17709 + * io/transfer.c (data_transfer_init): Reset sf_seen_eor. + +2004-10-04 Andrew Pinski + + * intrinsics/mvbits.c: Commit the file. + +2004-10-04 Tobias Schlueter + + PR fortran/17283 + * intrinsics/pack_generic.c (__pack): Allocate memory for return array + if not done by caller. + (__pack_s): New function. + * runtime/memory.c (internal_malloc, internal_malloc64): Allow + allocating zero memory. + + PR fortran/17631 + * Makefile.am (gfor_helper_src): Add intrinsics/mvbits.h. + * Makefile.in: Regenerate. + * intrinsics/mvbits.h: New file. + + PR fortran/17776 + * intrinsics/system.c: New file. + * Makefile.am: Add dependency for the new file. + * Makefile.in: Regenerate. + +2004-10-04 Paul Brook + Bud Davis + + PR fortran/17706 + PR fortran/16434 + * io/format.c (parse_format_list): Set repeat count for S, SP, SS, + BN and BZ formats. + * io/write.c (output_float): Don't output minus zero. + +2004-10-03 Aaron W. LaFramboise + + * intrinsics/abort.c ("libgfortran.h"): Move. + * intrinsics/date_and_time.c ("libgfortran.h"): Same. + * intrinsics/write.c ("libgfortran.h"): Same. + +2004-09-26 Tobias Schlueter + + PR libfortran/16137 + * config.h.in (HAVE_POWF): Undefine. + * configure.ac: Check for 'powf' in library. + * configure: Regenerate. + * intrinsics/c99_functions.c (powf): New function. + +2004-09-24 Tobias Schlueter + + * intrinsics/etime.c (etime_): New function. + +2004-09-21 Steven G. Kargl + + * libgfortran.h: define gfc_alloca() + * intrinsics/env.c (getenv, get_environment_variable_i4): Use it. + +2004-09-21 Bud Davis + + PR fortran/17286 + * io/list_read.c (namelist_read): ignore spaces after + the '=' for namelist reads. + +2004-09-15 Aaron W. LaFramboise + + * config.h.in: Regenerate. + * configure: Regenerate. + * configure.ac (AC_CHECK_HEADERS): Check for sys/mman.h. + * unix.c: Include stdio.h. + (HAVE_SYS_MMAN_H): Check. + (PROT_READ, PROT_WRITE): Provide default definitions. + +2004-09-15 Steven G. Kargl + + * intrincics/getcwd.c: New file. + * Makefile.am: Add getcwd.c. + * Makefile.in: Regenerated. + +2004-09-15 Steven G. Kargl + Paul Brook + + * intrinsics/env.c (getenv, get_environmental_variable): Remove + trailing white space. Use alloca. Honour trim_name. + +2004-09-13 Bud Davis + + PR fortran/17090 + + * io/list_read.c (list_formatted_read): Handle trailing spaces + at end of line. + +2004-09-06 Steven G. Kargl + + * io/write.c (output_float): Typo in comment. Remove debugging + printf. Fix format for FP of form 1e10. + +2004-09-03 Richard Henderson + + * intrinsics/cshift0.c (DEF_COPY_LOOP, copy_loop_int, copy_loop_long, + copy_loop_double, copy_loop_ldouble): New. + (__cshift0): Make shift type ssize_t. Use % operator instead of + div. Use specialized versions of copy loop depending on the shape. + +2004-09-02 Paul Brook + + * io/format.c (parse_format_list): Set repeat count for P descriptors. + * write.c (output_float): Fix condition. Correctly handle nonzero + scale factor. + +2004-09-01 Eric Botcazou + + * mk-sik-inc.sh: Use a temporary string instead of 'echo -n'. + * mk-srk-inc.sh: Likewise. + +2004-09-01 Paul Brook + + * runtime/error.c (generate_error): Set both iostat and + library_return. + +2004-08-31 Paul Brook + + PR libfortran/16805 + * io/list_read.c (next_char): Don't signal EOF for internal files. + * io/unix.c (mem_alloc_r_at): Don't return NULL for incomplete reads. + +2004-08-31 Tobias Schlueter + + * io/unit.c: Separate copyright years by ','. + (compare, insert_unit, delete_unit, is_internal_unit, close_units): + Remove blank line in beginning of function. + (get_unit): Simplify code. + +2004-08-31 Paul Brook + + * io/unit.c (get_unit): Remove superfluous if. + +2004-08-31 Paul Brook + + * io/transfer.c (read_sf): Rename uinty to readlen. Detect EOF. + (finalize_transfer): Move setjmp after namlist IO. + * io/unix.c (mem_alloc_r_at): Calculate remaining length correctly. + +2004-08-31 Paul Brook + + * list_read.c (eat_separator): Set at_eo when a '/' is seen. + +2004-08-31 Tobias Schlueter + + * libgfortran.h: Replace 'gfc_strlen_type' by + 'gfc_charlen_type'. Update comment accordingly. + * intrinsics/args.c, intrinsics/env.c, io/io.h, io/transfer.c: + Replace all occurences of 'gfc_strlen_type' by 'gfc_charlen_type'. + +2004-08-31 Paul Brook + + * libgfortran.h: Add comments. + +2004-08-30 Richard Henderson + + * Makefile.am (gfor_helper_src): Split selected_kind.f90. + (gfor_built_src): Add selected_int_kind.inc selected_real_kind.inc. + (selected_int_kind.inc selected_real_kind.inc): New rules. + * Makefile.in: Regenerate. + * mk-sik-inc.sh, mk-srk-inc.sh: New files. + * intrinsics/selected_int_kind.f90: Split from selected_kind.f90, + include table of detected kinds. + * intrinsics/selected_real_kind.f90: Similarly. + +2004-08-29 Steven G. Kargl + Paul Brook + + * intrinsics/bessel.c: New file. + * intrinsics/erf.c: New file. + * Makefie.am: Add intrinsics/bessel.c and intrinsics/erf.c. + * configure.ac: Test for C99 Bessel and Error functions. + * Makefile.in: Regenerate. + * config.h.in: Regenerate. + * configure: Regenerate. + +2004-08-29 Steven G. Kargl + Paul Brook + + * Makefile.am: Add intrinsics/getXid.c. + * configure.ac: Add tests for get{g,p,u}id. + * config.h.in: Regenerate. + * Makefile.in: Regenerate. + * configure: Regenerate. + +2004-08-28 Paul Brook + + PR libfortran/17195 + * libgfortran.h (rtoa): Remove prototype. + * runtime/error.c (rtoa): Remove. + * io/write.c (calculate_G_format): Don't add blanks if E format is + used. Add correct number of blanks when exponent width is specified. + (output_float): Rewrite. + +2004-08-27 Paul Brook + + * io/rewind.c (st_rewind): Reset unit to read mode. + +2004-08-27 Bud Davis + + PR fortran/16597 + * io/io.h: created typedef for unit_mode. + * io/io.h (gfc_unit): added mode to unit structure. + * io/transfer.c (data_transfer_init): flush if a write then + read is done on a unit (direct access files). + * io/rewind.c (st_rewind): Used unit mode instead of global. + +2004-08-24 Bud Davis + + PR fortran/17143 + * runtime/error.c (itoa): keep from overflowing during + mod operation by using unsigned variable. + +2004-08-24 Bud Davis + + PR fortran/17164 + * runtime/string_intrinsics.c (string_index):check for + substring longer than string. + +2004-08-24 David Edelsohn + + * Makefile.am (libgfortran_la_LDFLAGS): Add -lm. + * Makefile.in: Rebuilt. + +2004-08-23 Tobias Schlueter + + * io/io.h, io/list_read.c, io/open.c, io/transfer.c, io/write.c: + Fix formatting issues, update copyright years. + +2004-08-21 Bud Davis + + PR 16908 + * io/transfer.c (next_record_w): Do not blank pad. + * io/transfer.c (next_record): Take into account partial records. + +2004-08-18 Victor Leikehman + + PR fortran/13278 + * io/transfer.c (st_set_nml_var) + * io/write.c (namelist_write): Allow var_name and var_name_len to be + null. For strings, use string_length field instead of len. + * io/io.h (struct namelist_type): New field string_length. + (st_set_nml_var_char): New argument string_length. + +2004-08-13 Bud Davis + + PR gfortran/16935 + * io/open.c (st_open): use flags instead of the unit structure. + +2004-08-10 Victor Leikehman + + * io/list_read.c (namelist_read): Convert variable names + to lower case, so that mixed-case names are recognized. + Don't read beyond terminating slash. + +2004-08-09 Richard Henderson + Roger Sayle + + * intrinsics/c99_functions.c (nextafterf): New implementation that + works correctly with denormalized numbers. + +2004-08-09 Victor Leikehman + + * m4/matmul.m4, m4/matmull.m4, intrinsics/eoshift0.c, + intrinsics/eoshift2.c, intrinsics/transpose_generic.c: + Allocate space if return value has NULL in its data field. + * generated/*.c: Regenerate. + +2004-08-06 Janne Blomqvist + + * intrinsics/env.c: New file. + * Makefile.am: Add env.c to build. + * Makefile.in: Regenerate. + +2004-08-05 Victor Leikehman + + PR libfortran/16704 + * io/read.c (read_radix): Understand letters f and F as hex digits. + +2004-08-04 Victor Leikehman + + * libgfortran.h (array_t, size0) New declarations. + * m4/ifunction.m4, m4/transpose.m4, intrinsics/cshift0.c: Allocate + space if return value descriptor has NULL in its data field, + and initialize bounds and stride. + * intrinsics/size.c (array_t, size0): Declarations moved to + libgfortran.h. + * generated/*.c: Regenerate. + +2004-08-03 Roger Sayle + + PR libfortran/16137 + * configure.ac: Add tests for acosf, asinf, atan2f, atanf, ceilf, + copysignf, cosf, coshf, expf, floorf, frexpf, hypotf, logf, log10f, + scalbnf, sinf, sinhf, sqrtf, tanf and tanhf in libm. + * config.h.in: Regenerate. + * configure: Regenerate. + + * instrinsics/c99_functions.c (acosf, asinf, atan2f, atanf, ceilf, + copysignf, cosf, coshf, expf, floorf, frexpf, hypotf, logf, log10f, + nextafterf, scalbnf, sinf, sinhf, sqrtf, tanf, tanhf): New stub + implementations for targets that don't support C99 float functions. + +2004-08-01 Roger Sayle + + * io/write.c (write_float): Use the slightly more portable isnan + in preference to isinf. + +2004-07-18 Bud Davis + + * configure.ac: Add check for LFS support. + * configure: Regenerate + +2004-07-11 Paul Brook + + PR fortran/16303 + * m4/cexp.m4 (carg): Return -pi to pi. + * generated/exp_c?.c: Regenerate. + +2004-07-08 Andreas Krebbel + + PR fortran/16291 + * libgfortran/io/write.c: (write_float): Added length check. + Remove pointless memset calls. + +2004-07-04 Bud Davis + Paul Brook + + PR fortran/15472 + * io/transfer.c(us_write): set recl for seq unform writes to max size. + * io/transfer.c(data_transfer_init): handle un-opened seq unform unit. + * io/unix.c(fd_alloc_w_at): handle requests at start, fd_flush at + right time. + * io/unix.c(is_seekable): set based upon the file/device, not the + method being used to access it (fd or mmap). + * io/unix.c(fd_flush): don't set file_size if !seekable. + * io/unix.c(fd_truncate: ditto. + +2004-07-04 Janne Blomqvist + Paul Brook + + PR fortran/15280 + PR fortran/15665 + * libgfortran.h (gfc_strlen_type): Define. + * intrinsics/args.c (getarg): Rename ... + (getarg_i4): ... to this. + (getarg_i8, get_command_argument_i4, get_command_argument_i8, + get_command_i4, get_command_i8): New functions. + +2004-07-04 Matthias Klose + + * libtool-version: New. + * Makefile.am (libgfortran_la_LDFLAGS): Use -version-info for soname. + * Makefile.in: Regenerate. + * configure.ac: Remove libtool_VERSION macro + * configure: Regenerate + +2004-06-30 Steve Kargl + Steven Bosscher + + * intrinsics/rand.c (rand): Wrap the irand() call from the previous + commit in prefix. + +2004-06-29 Tobias Schlueter + Paul Brook + + * runtime/normalize.c (normalize_r4_i4, normalize_r8_i8): Fix + comments. + * intrinsics/rand.c (rand): Call irand() in call to normalize_r4_i4. + +2004-06-27 Bud Davis + + PR gfortran/12839 + * io/write.c (write_float): check signbit for Infinity. + +2004-06-26 Bud Davis + + PR gfortran/16196 + * unix.c(regular_file): create file if it does not exist. + +2004-06-24 Andrew Pinski + + * configure.ac: Remove check for libmx. + * configure: Regenerate. + +2004-06-22 Janne Blomqvist + + PR fortran/15750 + * inquire.c (st_inquire): Add comment + * io.h (st_parameter): Add iolength. + (st_iolength, st_iolength_done): Declare. + * transfer.c (iolength_transfer, iolength_transfer_init, + st_iolength, st_iolength_done): New functions. + +2004-06-21 Steven G. Kargl + + * etime.c (etime_sub): Remove array rank check; + Add check for sufficient space. + +2004-06-19 Bud Davis + + PR gfortran/16080 + * io/list_read.c(set_value): fixed spelling. + +2004-06-19 Bud Davis + + PR gfortran/16080 + * io/list_read.c(set_value): don't copy if the string is null. + +2004-06-14 Bud Davis + + PR gfortran/15292 + * intrinsics/c99_functions.c: Use fpclassify if it exists. + +2004-06-13 Paul Brook + + * Makefile.am (gfor_helper_src): Add runtime/normalize.f90. + * configure.ac: Add checks for nextafter and nextafterf. + * Makefile.in, config.h.in, configure: Regenerate. + * libgfortran.h (normalize_r4_i4, normalize_r8_i8): Declare. + * intrinsics/rand.c (rand): Use normalize_r4_i4. + * intrinsics/random.c (random_r4): Use normalize_r4_i4. + (random_r8): Use normalize_r8_i8. + * runtime/normalize.c: New file. + +2004-06-13 Steven G. Kargl + Tobias Schlueter + + * random.c: Fix several spelling and formatting mistakes in + comments. + (random_r8): Fix loop to make random numbers range in [0,1(. + + +2004-06-13 Steven G. Kargl + + * random.c (random_r4): Burn a random number. + (random_r8): fix infinite loop. + +2004-06-12 Bud Davis + Steve Kargl + + PR gfortran/15292 + * intrinsics/c99_functions.c: New file. + * Makefile.am: Add new file. + * configure.ac: Added test for round/roundf. + * Makefile.in: Regenerate. + * configure: Regenerate. + * configure.h.in: Regenerate. + +2004-06-12 Steven G. Kargl + + * Makefile.am: Add rand.c and etime.c + * Makefile.in: Regenerated. + * aclocal.in: Regenerated. + * cpu_time.c (second_sub, second): New functions. + * rand.c (irand, rand, srand): New file. + * etime.c (etime_sub, etime): New file. + +2004-06-12 Tobias Schlueter + Steven Bosscher + + PR fortran/14923 + * intrinsics/date_and_time.c: New file. + * Makefile.am (gfor_helper_src): Add intrinsics/date_and_time.c. + * Makefile.in, aclocal.m4: Regenerate. + * libgfortran.h: Prototype date_and_time(). + +2004-06-12 Bud Davis + + PR fortran/15665 + * intrinsics/args.c: Implement GETARG and IARGC. + * Makefile.am: Add it. + * Makefile.in: Regenerate. + +2004-06-12 Bud Davis + + PR gfortran/12839 + * io/write.c(write_float): Format inf and nan IAW F2003. + +2004-06-09 Bud Davis + + PR gfortran/14897 + * io/transfer.c (formatted_transfer): position is unique + for T and TL edit descriptors. + (data_transfer_init): set record length to size of internal + file. + +2004-06-09 Bud Davis + + PR gfortran/15755 + * io/backspace.c(st_backspace): call correct routine for + formatted and un-formatted units. + +2004-05-30 Andreas Jaeger , Steven Bosscher + + PR gfortran/11800 + * Makefile.am (AM_CPPFLAGS): Renamed from INCLUDES. + (lib_LTLIBRARIES): Rename to ... + (toolexeclib_LTLIBRARIES): this for multilib support. + * configure.in: Rename to ... + * configure.ac: this. Update to modern autoconf style, enable + multilibs, support --enable-version-specific-runtime-libs. + * Makefile.in: Regenerated. + * configure: Regenerated. + * aclocal.m4: Regenerated. + +2004-05-30 Steven G. Kargl + + * libgfortran.h (random_seed): Update prototype. + * intrinsics/random.c: Disable old implementation and add new one. + +2004-05-30 Andreas Jaeger + + * intrinsics/random.c: Include unistd.h for close and read + prototypes, remove unneeded inclusion of assert.h. + + * intrinsics/abort.c: Include stdlib.h for abort prototype, remove + unneeded inclusion of assert.h. + +2004-05-27 Tobias Schlueter + + PR fortran/15234 + * intrinsics/associated.c: Remove enum. + (associated): Replace TRUE/FALSE by 1/0. + +2004-05-23 Steven G. Kargl + + * random.c (random_seed): Use correct variable. + +2004-05-22 Steven G. Kargl + + * intrinsics/system_clock: New file. + * Makefile.am: Add intrinsics/system_clock.c. + * Makefile.in: Regenerate. + +2004-05-21 Roger Sayle + + * io/format.c (parse_format_list): Allow the comma after a string + literal to be optional. + +2004-05-18 Paul Brook + Feng Wang + + * Makefile.am (i_pow_c): Set it. Add build rule. + (gfor_built_src): Use it. + (m4_files): add m4/pow.m4. + * Makefile.in: Regenerate. + * m4/pow.m4: New file. + * generated/pow_*.c: Regenerate. + +2004-05-18 Paul Brook + + * Makefile.am: Remove references to types.m4. + * m4/iparm.m4: Merge with types.m4. + * m4/types.m4: Remove. + * m4/cshift1.m4, m4/dotprod.m4, m4/dotprodc.m4, m4/dotprodl.m4, + m4/eoshift1.m4, m4/eoshift3.m4, m4/iforeach.m4, m4/ifunction.m4, + m4/in_pack.m4, m4/in_unpack.m4, m4/iparm.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/reshape.m4, + m4/shape.m4, m4/specific.m4, m4/specific2.m4, m4/transpose.m4): + Update to use new iparm.m4. + * generated/*.c: Regenerate. + +2004-05-18 Tobias Schlueter + + PR fortran/15235 + * gfortran.h (offset_t): Rename to ... + (gfc_offset): ... this. + * io/backspace.c (formatted_backspace, unformatted_backspace), + io/io.h (stream, gfc_unit, global_t, file_length, file_position), + transfer.c (us_read, us_write, next_record_r, next_record_w), + io/unit.c (init_units), unix.c (unix_stream, fd_alloc, + fd_alloc_r_at, fd_alloc_w_at, fd_seek, mmap_alloc, + mmap_alloc_r_at, mmap_alloc_w_at, mmap_seek, mem_alloc_r_at, + mem_alloc_w_at, mem_seek, file_length, file_position): Replace all + occurences of offset_t by gfc_offset. + +2004-05-16 Paul Brook + + * io/format.c (write_real): Don't include padding in format. + +2004-05-16 Paul Brook + + * io/format.c (format_lex): Make c an int. + +2004-05-16 Janne Blomqvist + Paul Brook + + * io/write.c (write_logical): Don't print extra blank. + (write_integer): Base field width on kind. + (list_formatted_write): Output initial blank. + +2004-05-16 Janne Blomqvist + + * io/io.h (flush): Add prototype. + * io/transfer.c (finalize_transfer): Flush partial records. + * io/unix.c (flush): New function. + +2004-05-15 Tobias Schlueter + + PR fortran/15234 + * io/io.h (unit_t): Rename to ... + (gfc_unit) ... this. + (unit_root, current_unit, find_file, find_unit, get_unit): Now + of type gfc_unit. + (delete_file, insert_unit, close_unit): Argument now of type + gfc_unit. + * backspace.c (st_backspace), close.c (st_close), endfile.c + (st_endfile), inquire.c (inquire_via_unit, st_inquire), open.c + (test_endfile, edit_modes, new_unit, already_open, st_open), + rewind.c (st_rewind), transfer.c (current_unit), unit.c + (internal_unit, unit_cache, rotate_left, rotate_right, insert, + insert_unit, delete_root, delete_treap, delete_unit, find_unit, + get_unit, init_units, close_unit), unix.c (find_file0, + find_file, delete_file): Replace all occurences of unit_t by + gfc_unit. + +2004-05-15 Bud Davis + + PR fortran/15311 + * io/write.c (write_a): right justify A edit output. + +2004-05-14 Bud Davis + + PR fortran/15149 + * libgfortan.h,intrinsics/random.c: Made random_seed visible. + * runtime/main.c(init): Call random_seed as part of MAIN init. + +2004-05-13 Tobias Schlter + + * io/format.c: (parse_format_list): No comma is required after + P descriptor. + +2004-05-13 Bud Davis + + PR fortran/15204 + * io/intrinsic/string_intrinsics.c (adjustr): rework logic. + +2004-05-06 Rainer Orth + Steven Bosscher + + PR libfortran/15234 + * libgfortran.h: Include if available. + +2004-05-03 Rainer Orth + + * io/unix.c (MAP_FAILED): Define if missing. + (mmap_alloc): Cast MAP_FAILED to char *. + (mmap_open): Likewise. + +2004-04-26 Bud Davis + + * generated/_abs_i8.f90: New file. + * generated/_abs_c4.f90: New file. + * generated/_abs_c8.f90: New file. + * Makefile.am: Add them. + * Makefile.in: Regenerate. +` +2004-04-26 Bud Davis + + PR fortran/14056 + * generated/_abs_i4.f90: New file. + * Makefile.am: Add it. + * Makefile.in: Regenerate. + +2004-04-25 Bud Davis + + PR fortran/14942 + * io/list_read.c(list_formatted_read): finish consuming the + spaces and seperators at eoln to get ready for next item. + +2004-04-23 Bud Davis + + PR fortran/15113 + * io/read.c(read_a): Handle field width > destination and no field width. + +2004-04-22 Bud Davis + + PR fortran/14906 + * io/format.c (format_item): gracefully handle a ')' + when it is the first character encountered in the string. + +2004-04-11 Bud Davis + + PR fortran/14904 + * io/transfer.c (next_record): Update last_record when + more than one record is written to a direct access file + with one write statement. + +2004-04-11 Bud Davis + + PR fortran/14901 + * io/transfer.c (next_record_w) : No '\n' if internal. + * io/unix.c (empty_internal_buffer) : Init to spaces, not '\n'. + +2004-04-11 Bud Davis + + * io.h (ioparm): Interface from FE is 32 bit, irregardless of offset_t. + Will need to change this later to support direct access files > 2gb. + +2004-04-03 Bud Davis + + PR gfortran/14762 + * io/transfer.c (next_record_r) : Skip to next record. + +2004-04-03 Bud Davis + + PR gfortran/14836 + * io/transfer.c (next_record): Update last_record for DIRECT + +2004-04-03 Bud Davis + + PR gfortran/14837 + * io/unix.c (find_file0): Use fd field of struct + +2004-04-03 Bud Davis + + PR 14831 + * io/inquire.c (inquire_via_unit): Changed return string for + BLANK=NULL. Use correct variable for ACTION. + +2004-04-01 Bud Davis + + PR 14746 + * io/read.c (read_f): Allow a decimal without a leading digit. + * io/write.c (output_float): remove a leading '0' to keep from + overflowing the field (F edit descriptor). + +2004-04-01 Bud Davis + + PR gfortran/14565 + * io/open.c (new_unit), + * io/io.h : new_unit is now visible + * io/transfer.c (data_transfer_init): open unit if no OPEN statement. + * io/transfer.c (data_transfer_init): remove compile warnings. + * io/rewind.c (st_rewind): ftruncate if writing. + +2004-03-24 Bud Davis + + * write.c (write_l): Use extract_int for 'L' edit descriptor. + +2004-03-24 Bud Davis + + PR 13919 + * io/io.h (global_t): + * io/list_read.c (next_char,list_formatted_read,ist_formatted_read): + Move eof_jmp to a global structure. + * io/transfer.c(finalize_transfer) : Set up eof_jump for callers. + +2004-03-24 Bud Davis + + * m4/cexp.m4 (csqrt): Actually use the passed value. + * generated/exp_c?.c: Regenerate. + +2004-03-24 Bud Davis + + PR 12921 + * io.h, transfer.c, open.c : recl_in changed from ptr to variable. + * open.c (new_unit): Moved test for positioned direct access error. + (init_units): Corrected calculation of max records. + +2004-02-06 Feng Wang + + * Makefile.am: Add m4/dotprodc.m4. And fix spelling. + * Makefile.in: Regenerate. + * m4/dotprodc.m4: New file. Implement complex dot_product. + * m4/dotprod.m4: Delete the complex implementation. + * generated/dotprod_*: Update. + +2004-02-07 Bud Davis + + * transfer.c (write_constant_string): Do not delete H's in hollerith + formats. + +2004-01-05 Andrew Pinski + + * configure.in: Check for csin in -lmx also. + * configure: Regenerate. + +2004-01-01 Paul Brook + + * io/list_read.c (find_nml_node): Make static. + (match_namelist_name): Ditto. + * io/read.c (convert_precision_real): Make static, fix spelling. + * io/transfer.c (extract_real): Remove unused prototype. + (st_set_nml_var): Make static. + * io/write.c (extract_real): Make static. + + +Copyright (C) 2004 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/libgfortran/ChangeLog-2005 b/libgfortran/ChangeLog-2005 new file mode 100644 index 000000000..1e04f52d1 --- /dev/null +++ b/libgfortran/ChangeLog-2005 @@ -0,0 +1,2922 @@ +2005-12-31 Jerry DeLisle + + PR libfortran/25594 + PR libfortran/25419 + * io/list_read.c (list_formatted_read_scalar): Test for comma to return + a null value (default). Revert patch of 25419 on 2005-12-28. + +2005-12-28 Jerry DeLisle + + PR libfortran/25139 + * io/unix.c (fd_truncate): Set s->active to zero. + PR libfortran/25510 + * libgfortran.h: Add ERROR_INTERNAL and ERROR_INTERNAL_UNIT. + * runtime/error.c (translate_error): Add messages for new errors. + * io/list_read.c (next_char): Use new errors. + * io/transfer.c (next_record_r) (next_record_w): Use new errors. + +2005-12-28 Jerry DeLisle + + PR libfortran/25550 + * io/file_pos.c (st_rewind): Reset bytes left so no error occurs in + next_record_r. + +2005-12-28 Jerry DeLisle + + PR libfortran/25419 + * io/list_read.c (list_formatted_read_scalar): Allow comma to return a + null value (default). + +2005-12-21 Jerry DeLisle + + PR libfortran/25307 + * io/list_read.c (next_char): Handle end-of-file conditions for + internal units and add support for internal character array units. + +2005-12-18 Jerry DeLisle + + PR libfortran/25463 + * io/transfer.c (finalize_transfer): Fix execution order so that + next_record is set to zero in all cases. + +2005-12-16 Jerry DeLisle + + PR libfortran/25264 + PR libfortran/25349 + * io/unit.c (get_unit): Delete code that cleared the string when the + unit was opened, which is too soon. + * io/transfer.c (next_record_w): Pass done flag in. Change logic for + setting max_pos. Add code to position unit and pad record as needed. + +2005-12-13 Richard Sandiford + Victor Leikehman + + * m4/matmul.m4: Use a different order in the special case of a + transposed first argument. + * generated/matmul_c4.c, generated/matmul_c8.c, generated/matmul_c10.c, + * generated/matmul_c16.c, generated/matmul_i4.c, generated/matmul_i8.c, + * generated/matmul_i10.c, generated/matmul_r4.c, generated/matmul_r8.c + * generated/matmul_r10.c, generated/matmul_r16.c: Regenerated. + +2005-12-10 Janne Blomqvist + + * Makefile.am: Enable loop unrolling for matmul. + * configure: Regenerated. + * Makefile.in: Regenerated. + * aclocal.m4: Regenerated. + +2005-12-10 Thomas Koenig + + PR fortran/23815 + * io/file_pos.c (unformatted_backspace): If flags.convert + does not equal CONVERT_NATIVE, reverse the record marker. + * io/open.c: Add convert_opt[]. + (st_open): If no convert option is given, set CONVERT_NATIVE. + If CONVERT_BIG or CONVERT_LITTLE are given, set flags.convert to + CONVERT_NATIVE or CONVERT_SWAP (depending on wether we have + a big- or little-endian system). + * io/transfer.c (unformatted_read): Remove unused attribute + from arguments. + If we need to reverse + bytes, break up large transfers into a loop. Split complex + numbers into its two parts. + (unformatted_write): Likewise. + (us_read): If flags.convert does not equal CONVERT_NATIVE, + reverse the record marker. + (next_record_w): Likewise. + (reverse_memcpy): New function. + * io/inquire.c (inquire_via_unit): Implement convert. + * io/io.h (top level): Add enum unit_convert. + Add convert to st_parameter_open and st_parameter_inquire. + Define IOPARM_OPEN_HAS_CONVERT and IOPARM_INQUIRE_HAS_CONVERT. + Increase padding for st_parameter_dt. + Declare reverse_memcpy(). + +2005-12-09 Jakub Jelinek + + PR libfortran/24991 + * acinclude.m4: Include acx.m4 and no-executables.m4. + * configure.ac: Add GCC_TOPLEVEL_SUBDIRS. + * configure: Rebuilt. + * Makefile.am (AM_CPPFLAGS): Use $(host_subdir) in build dir + path. + * Makefile.in: Rebuilt. + +2005-12-08 Jerry DeLisle + + PR libfortran/25039 + * io/io.h: Create a new flag sf_read_comma to control comma + separators in numeric reads. + * io/transfer.c (formatted_transfer_scalar): Initialize the flag. + (read_sf): Check for commas coming in and if the flag is set, + shortcut the read. + * io/read.c (read_a) (read_x): Clear the flag for character reads and + reset it after the reads. + +2005-12-04 Francois-Xavier Coudert + + * io/format.c: Removing unused code. + * intrinsics/random.c: Likewise. + +2005-12-02 Francois-Xavier Coudert + + PR libfortran/25116 + * io/transfer.c (data_transfer_init): Don't set the default for + namelist I/O on preconnected files to UNFORMATTED. + +2005-11-30 Eric Botcazou + + * libgfortran.h (ILP32 typedefs): Define _UINT8_T, _UINT32_T and + _UINT64_T on Solaris. + +2005-11-28 Steven G. Kargl + + PR libfortran/25149 + * intrinsics/abort.c: Add external abort_ to allow linking when + invoking -std=f95 in testsuite. + +2005-11-28 Jakub Jelinek + + PR libfortran/24991 + * acinclude.m4 (LIBGFOR_CHECK_PRAGMA_WEAK): Rename to... + (LIBGFOR_GTHREAD_WEAK): ... this. Define SUPPORTS_WEAK rather + than HAVE_PRAGMA_WEAK. Define GTHREAD_USE_WEAK to 0 on hosts + that shouldn't use weak in gthr.h. + * configure.ac: Use LIBGFOR_GTHREAD_WEAK instead of + LIBGFOR_CHECK_PRAGMA_WEAK. + * config.h.in: Regenerated. + * configure: Regenerated. + * io/io.h (SUPPORTS_WEAK): Don't define here. + + * intrinsics/ftell.c (ftell, FTELL_SUB): Add unlock_unit call. + * intrinsics/fget.c (fgetc, fputs): Likewise. + * intrinsics/tty.c (ttynam): Likewise. + +2005-11-27 Jerry DeLisle + + PR libfortran/25109 + * io/unit.c (init_units): Set default flag to BLANK_NULL per + requirement of F95 standard. Set PAD_YES for stdin. + +2005-11-27 David Edelsohn + + * intrinsics/random.c: Include config.h + * io/size_from_kind.c: Include config.h and libgfortran.h + * io/io.h: Revert 2005-11-21 change. + +2005-11-27 Francois-Xavier Coudert + + * io/write.c (namelist_write): Correct type in previous + commit. + +2005-11-27 Francois-Xavier Coudert + + PR libfortran/24919 + * io/list_read.c (eat_separator, finish_separator, + read_character): Handle CRLF separators correctly during reads. + (nml_query): Use the HAVE_CRLF macro to print adequate newlines. + * io/io.h (st_parameter_dt): Add comment about the possible + values for sf_seen_eor. + * io/unix.c (tempfile, regular_file): HAVE_CRLF doesn't imply + that O_BINARY is defined, so we add that condition. + (stream_at_bof): Fix typo in comment. + * io/transfer.c (read_sf): Handle correctly CRLF, setting + sf_seen_eor value to 2 instead of 1. + (formatted_transfer_scalar): Use the sf_seen_eor value to + handle CRLF the right way. + * io/write.c (nml_write_obj, namelist_write): Use CRLF as newline + when HAVE_CRLF is defined. + +2005-11-27 Janne Blomqvist + + * m4/ifunction.m4: Add const restrict to function arguments. + * m4/iforeach.m4: Likewise. + * m4/eoshift1.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * m4/dotprod.m4: Likewise. + * m4/dotprodc.m4: Likewise. + * m4/dotprodl.m4: Likewise. + * m4/shape.m4: Likewise. + * m4/cshift1.m4: Likewise. + * m4/reshape.m4: Likewise. + * m4/transpose.m4: Likewise. + * generated/eoshift*: Regenerated + * generated/dotprod*: Likewise. + * generated/shape*: Likewise. + * generated/cshift1*: Likewise. + * generated/reshape*: Likewise. + * generated/transpose*: Likewise. + +2005-11-26 Richard Henderson + + * io/list_read.c (nml_parse_qualifier): Use ssize_t instead of int + in dtp->u.p.value. + +2005-11-26 Janne Blomqvist + + PR libfortran/24945 + * io/open.c (edit_modes): Check for STATUS_UNKNOWN flag. + +2005-11-25 Richard Henderson + + * io/list_read.c (nml_parse_qualifier): Use memcpy to extract + values from dtp->u.p.value. + * io/io.h (struct st_parameter_dt): Change reversion_flag, first_item, + seen_dollar, sf_seen_eor, eor_condition, no_leading_blank, char_flag, + input_complete, at_eol, comma_flag, namelist_mode, nml_read_error to + single-bit fields. Move value to where it'll be at least pointer + aligned. + +2005-11-23 Alan Modra + + * io/open.c (new_unit): Use the right unit number when checking + for stdin, stdout, stderr. + +2005-11-22 Jerry DeLisle + + PR libfortran/24794 + * io/list_read.c (read_character): Add auto completion on short + namelist reads. + +2005-11-21 David Edelsohn + + * io/io.h (_LARGE_FILES): Undefine for AIX. + (_LARGE_FILE_API): Define for AIX. + +2005-11-21 Jakub Jelinek + + PR fortran/24774 + PR fortran/14943 + PR fortran/21647 + * Makefile.am (AM_CPPFLAGS): Add gcc directories as -I paths, + add -D_GNU_SOURCE. + * Makefile.in: Regenerated. + * acinclude.m4 (LIBGFOR_CHECK_SYNC_FETCH_AND_ADD, + LIBGFOR_CHECK_GTHR_DEFAULT, LIBGFOR_CHECK_PRAGMA_WEAK): New macros. + * configure.ac: Add them. + * configure: Rebuilt. + * config.h.in: Rebuilt. + * libtool-version: Bump libgfortran.so SONAME to libgfortran.so.1. + * libgfortran.h (library_start, show_locus, internal_error, + generate_error, find_option): Add st_parameter_common * argument. + (library_end): Change into a dummy macro. + * io/io.h: Include gthr.h. + (SUPPORTS_WEAK): Define if HAVE_PRAGMA_WEAK. + (CHARACTER): Remove define. + (st_parameter, global_t): Remove typedef. + (ioparm, g, ionml, current_unit): Remove variables. + (init_error_stream): Remove prototype. + (CHARACTER1, CHARACTER2): Define. + (st_parameter_common, st_parameter_open, st_parameter_close, + st_parameter_filepos, st_parameter_inquire, st_parameter_dt): New + typedefs. + (IOPARM_LIBRETURN_MASK, IOPARM_LIBRETURN_OK, IOPARM_LIBRETURN_ERROR, + IOPARM_LIBRETURN_END, IOPARM_LIBRETURN_EOR, IOPARM_ERR, IOPARM_END, + IOPARM_EOR, IOPARM_HAS_IOSTAT, IOPARM_HAS_IOMSG, IOPARM_COMMON_MASK, + IOPARM_OPEN_HAS_RECL_IN, IOPARM_OPEN_HAS_FILE, IOPARM_OPEN_HAS_STATUS, + IOPARM_OPEN_HAS_ACCESS, IOPARM_OPEN_HAS_FORM, IOPARM_OPEN_HAS_BLANK, + IOPARM_OPEN_HAS_POSITION, IOPARM_OPEN_HAS_ACTION, + IOPARM_OPEN_HAS_DELIM, IOPARM_OPEN_HAS_PAD, IOPARM_CLOSE_HAS_STATUS, + IOPARM_INQUIRE_HAS_EXIST, IOPARM_INQUIRE_HAS_OPENED, + IOPARM_INQUIRE_HAS_NUMBER, IOPARM_INQUIRE_HAS_NAMED, + IOPARM_INQUIRE_HAS_NEXTREC, IOPARM_INQUIRE_HAS_RECL_OUT, + IOPARM_INQUIRE_HAS_FILE, IOPARM_INQUIRE_HAS_ACCESS, + IOPARM_INQUIRE_HAS_FORM, IOPARM_INQUIRE_HAS_BLANK, + IOPARM_INQUIRE_HAS_POSITION, IOPARM_INQUIRE_HAS_ACTION, + IOPARM_INQUIRE_HAS_DELIM, IOPARM_INQUIRE_HAS_PAD, + IOPARM_INQUIRE_HAS_NAME, IOPARM_INQUIRE_HAS_SEQUENTIAL, + IOPARM_INQUIRE_HAS_DIRECT, IOPARM_INQUIRE_HAS_FORMATTED, + IOPARM_INQUIRE_HAS_UNFORMATTED, IOPARM_INQUIRE_HAS_READ, + IOPARM_INQUIRE_HAS_WRITE, IOPARM_INQUIRE_HAS_READWRITE, + IOPARM_DT_LIST_FORMAT, IOPARM_DT_NAMELIST_READ_MODE, + IOPARM_DT_HAS_REC, IOPARM_DT_HAS_SIZE, IOPARM_DT_HAS_IOLENGTH, + IOPARM_DT_HAS_FORMAT, IOPARM_DT_HAS_ADVANCE, + IOPARM_DT_HAS_INTERNAL_UNIT, IOPARM_DT_HAS_NAMELIST_NAME, + IOPARM_DT_IONML_SET): Define. + (gfc_unit): Add lock, waiting and close fields. Change file + from flexible array member into pointer to char. + (open_external): Add st_parameter_open * argument. + (find_file, file_exists): Add file and file_len arguments. + (flush_all_units): New prototype. + (max_offset, unit_root, unit_lock): New variable. + (is_internal_unit, is_array_io, next_array_record, + parse_format, next_format, unget_format, format_error, + read_block, write_block, next_record, convert_real, + read_a, read_f, read_l, read_x, read_radix, read_decimal, + list_formatted_read, finish_list_read, namelist_read, + namelist_write, write_a, write_b, write_d, write_e, write_en, + write_es, write_f, write_i, write_l, write_o, write_x, write_z, + list_formatted_write, get_unit): Add st_parameter_dt * argument. + (insert_unit): Remove prototype. + (find_or_create_unit, unlock_unit): New prototype. + (new_unit): Return gfc_unit *. Add st_parameter_open * + and gfc_unit * arguments. + (free_fnodes): Remove prototype. + (free_format_data): New prototype. + (scratch): Remove. + (init_at_eol): Remove prototype. + (free_ionml): New prototype. + (inc_waiting_locked, predec_waiting_locked, dec_waiting_unlocked): + New inline functions. + * io/unit.c (max_offset, unit_root, unit_lock): New variables. + (insert): Adjust os_error caller. + (insert_unit): Made static. Allocate memory here, initialize + lock and after inserting it return it, locked. + (delete_unit): Adjust for deletion of g. + (find_unit_1): New function. + (find_unit): Use it. + (find_or_create_unit): New function. + (get_unit): Add dtp argument, change meaning of the int argument + as creation request flag. Adjust for different st_* calling + conventions, lock internal unit's lock before returning it + and removal of g. Call find_unit_1 instead of find_unit. + (is_internal_unit, is_array_io): Add dtp argument, adjust for + removal of most of global variables. + (init_units): Initialize unit_lock. Adjust insert_unit callers + and adjust for g removal. + (close_unit_1): New function. + (close_unit): Use it. + (unlock_unit): New function. + (close_units): Lock unit_lock, use close_unit_1 rather than + close_unit. + * io/close.c (st_close): Add clp argument. Adjust for new + st_* calling conventions and internal function API changes. + * io/file_pos.c (st_backspace, st_endfile, st_rewind, st_flush): + Add fpp argument. Adjust for new st_* calling conventions and + internal function API changes. + (formatted_backspace, unformatted_backspace): Likewise. Add + u argument. + * io/open.c (edit_modes, st_open): Add opp argument. Adjust for + new st_* calling conventions and internal function API changes. + (already_open): Likewise. If not HAVE_UNLINK_OPEN_FILE, unlink + scratch file. Instead of calling close_unit just call sclose, + free u->file if any and clear a few u fields before calling + new_unit. + (new_unit): Return gfc_unit *. Add opp and u arguments. + Adjust for new st_* calling conventions and internal function + API changes. Don't allocate unit here, rather than work with + already created unit u already locked on entry. In case + of failure, close_unit it. + * io/unix.c: Include unix.h. + (BUFFER_SIZE, unix_stream): Moved to unix.h. + (unit_to_fd): Add unlock_unit call. + (tempfile): Add opp argument, use its fields rather than ioparm. + (regular_file): Likewise. + (open_external): Likewise. Only unlink file if fd >= 0. + (init_error_stream): Add error argument, set structure it points + to rather than filling static variable and returning its address. + (FIND_FILE0_DECL, FIND_FILE0_ARGS): Define. + (find_file0): Use them. Don't crash if u->s == NULL. + (find_file): Add file and file_len arguments, use them instead + of ioparm. Add locking. Pass either an array of 2 struct stat + or file and file_len pair to find_file0. + (flush_all_units_1, flush_all_units): New functions. + (file_exists): Add file and file_len arguments, use them instead + of ioparm. + * io/unix.h: New file. + * io/lock.c (ioparm, g, ionml): Remove variables. + (library_start): Add cmp argument, adjust for new st_* calling + conventions. + (library_end): Remove. + (free_ionml): New function. + * io/inquire.c (inquire_via_unit, inquire_via_filename, + st_inquire): Add iqp argument, adjust for new st_* calling + conventions and internal function API changes. + * io/format.c (FARRAY_SIZE): Decrease to 64. + (fnode_array, format_data): New typedefs. + (avail, array, format_string, string, error, saved_token, value, + format_string_len, reversion_ok, saved_format): Remove variables. + (colon_node): Add const. + (free_fnode, free_fnodes): Remove. + (free_format_data): New function. + (next_char, unget_char, get_fnode, format_lex, parse_format_list, + format_error, parse_format, revert, unget_format, next_test): Add + fmt or dtp arguments, pass it all around, adjust for internal + function API changes and adjust for removal of global variables. + (next_format): Likewise. Constify return type. + (next_format0): Constify return type. + * io/transfer.c (current_unit, sf_seen_eor, eor_condition, max_pos, + skips, pending_spaces, scratch, line_buffer, advance_status, + transfer): Remove variables. + (transfer_integer, transfer_real, transfer_logical, + transfer_character, transfer_complex, transfer_array, current_mode, + read_sf, read_block, read_block_direct, write_block, + write_block_direct, unformatted_read, unformatted_write, + type_name, write_constant_string, require_type, + formatted_transfer_scalar, us_read, us_write, pre_position, + data_transfer_init, next_record_r, next_record_w, next_record, + finalize_transfer, iolength_transfer, iolength_transfer_init, + st_iolength, st_iolength_done, st_read, st_read_done, st_write, + st_write_done, st_set_nml_var, st_set_nml_var_dim, + next_array_record): Add dtp argument, pass it all around, adjust for + internal function API changes and removal of global variables. + * io/list_read.c (repeat_count, saved_length, saved_used, + input_complete, at_eol, comma_flag, last_char, saved_string, + saved_type, namelist_mode, nml_read_error, value, parse_err_msg, + nml_err_msg, prev_nl): Remove variables. + (push_char, free_saved, next_char, unget_char, eat_spaces, + eat_separator, finish_separator, nml_bad_return, convert_integer, + parse_repeat, read_logical, read_integer, read_character, + parse_real, read_complex, read_real, check_type, + list_formatted_read_scalar, list_formatted_read, finish_list_read, + find_nml_node, nml_untouch_nodes, nml_match_name, nml_query, + namelist_read): Add dtp argument, pass it all around, adjust for + internal function API changes and removal of global variables. + (nml_parse_qualifier): Likewise. Add parse_err_msg argument. + (nml_read_obj): Likewise. Add pprev_nl, nml_err_msg, clow and + chigh arguments. + (nml_get_obj_data): Likewise. Add pprev_nl and nml_err_msg + arguments. + (init_at_eol): Removed. + * io/read.c (convert_real, read_l, read_a, next_char, read_decimal, + read_radix, read_f, read_x): Add dtp argument, pass it all around, + adjust for internal function API changes and removal of global + variables. + (set_integer): Adjust internal_error caller. + * io/write.c (no_leading_blank, nml_delim): Remove variables. + (write_a, calculate_sign, calculate_G_format, output_float, + write_l, write_float, write_int, write_decimal, write_i, write_b, + write_o, write_z, write_d, write_e, write_f, write_en, write_es, + write_x, write_char, write_logical, write_integer, write_character, + write_real, write_complex, write_separator, + list_formatted_write_scalar, list_formatted_write, nml_write_obj, + namelist_write): Add dtp argument, pass it all around, adjust for + internal function API changes and removal of global variables. + (extract_int, extract_uint, extract_real): Adjust internal_error + callers. + * runtime/fpu.c (_GNU_SOURCE): Don't define here. + * runtime/error.c: Include ../io/unix.h. + (filename, line): Remove variables. + (st_printf): Pass address of a local variable to init_error_stream. + (show_locus): Add cmp argument. Use fields it points to rather than + filename and line variables. + (os_error, runtime_error): Remove show_locus calls. + (internal_error): Add cmp argument. Pass it down to show_locus. + (generate_error): Likewise. Use flags bitmask instead of non-NULL + check for iostat and iomsg parameter presence, adjust for st_* + calling convention changes. + * runtime/stop.c (stop_numeric, stop_string): Remove show_locus + calls. + * runtime/pause.c (pause_numeric, pause_string): Likewise. + * runtime/string.c: Include ../io/io.h. + (find_option): Add cmp argument. Pass it down to generate_error. + * intrinsics/flush.c (recursive_flush): Remove. + (flush_i4, flush_i8): Use flush_all_units. Add unlock_unit + call. + * intrinsics/rand.c: Include ../io/io.h. + (rand_seed_lock): New variable. + (srand, irand): Add locking. + (init): New constructor function. + * intrinsics/random.c: Include ../io/io.h. + (random_lock): New variable. + (random_r4, random_r8, arandom_r4, arandom_r8): Add locking. + (random_seed): Likewise. open failed if fd < 0. Set i correctly. + (init): New constructor function. + * intrinsics/system_clock.c (tp0, t0): Remove. + (system_clock_4, system_clock_8): Don't subtract tp0/t0 from current + time, use just integer arithmetics. + * intrinsics/tty.c (isatty_l4, isatty_l8, ttynam_sub): Add + unlock_unit calls. + +2005-11-20 Richard Henderson + + * Makefile.am: Revert 2005-11-14 change. Enable -free-vectorize + via gmake per-target variables. + * Makefile.in, aclocal.m4: Regenerate. + +2005-11-18 Francois-Xavier Coudert + + * configure.ac: Add "-I ." to the AM_FCFLAGS. + * configure: Regenerate. + +2005-11-18 Hans-Peter Nilsson + + * config/fpu-glibc.h (set_fpu): Only call fedisableexcept for + nonzero FE_ALL_EXCEPT. + +2005-11-17 Francois-Xavier Coudert + + PR fortran/24892 + * io/io.h (unit_access): Add ACCESS_APPEND. + * io/open.c (access_opt): Add APPEND value for ACCESS keyword. + (st_open): Use that new value to set the POSITION accordingly. + +2005-11-14 Janne Blomqvist + + PR fortran/21468 + * Makefile.am: Add -ftree-vectorize for compiling matmul. + * m4/matmul.m4: Add const and restrict to type declarations as + appropriate. + * m4/matmull.m4: Likewise. + * Makefile.in: Regenerated. + * generated/matmul_*.c: Likewise. + +2005-11-13 Francois-Xavier Coudert + + * intrinsics/fget.c: New file. + * intrinsics/ftell.c: New file. + * io/unix.c (stream_offset): New function. + * io/io.h: Add prototype for stream_offset. + * Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c. + * Makefile.in: Regenerate. + +2005-11-12 Steven G. Kargl + + PR libfortran/24787 + * intrinsics/string_intrinsics.c (string_scan): Off by one; Fix typos + in nearby comment. + +2005-11-10 Andreas Jaeger + + * libgfortran.h: Add proper defines where needed. + +2005-11-10 Andreas Jaeger + + * libgfortran.h: Add missing prototypes for internal_pack + functions. + +2005-11-06 Janne Blomqvist + + PR fortran/24174 + PR fortran/24305 + * io/io.h: Add argument to prototypes, add prototypes for + size_from_*_kind functions. + * io/list_read.c (read_complex): Add size argument, use + it. + (list_formatted_read): Add size argument, cleanup. + (list_formatted_read_scalar): Add size argument. + (nml_read_obj): Fix for padding. + * io/transfer.c: Add argument to transfer function pointer. + (unformatted_read): Add size argument. + (unformatted_write): Likewise. + (formatted_transfer_scalar): Fix for padding with complex(10). + (formatted_transfer): Add size argument, cleanup. + (transfer_integer): Add size argument to transfer call. + (transfer_real): Likewise. + (transfer_logical): Likewise. + (transfer_character): Likewise. + (transfer_complex): Likewise. + (transfer_array): New kind argument, use it. + (data_transfer_init): Add size argument to formatted_transfer + call. + (iolength_transfer): Add size argument, cleanup. + * io/write.c (write_complex): Add size argument, fix for padding + with complex(10). + (list_formatted_write): Add size argument, cleanup. + (list_formatted_write_scalar): Add size argument, use it. + (nml_write_obj): Fix for size vs. kind issue. + * io/size_from_kind.c: New file. + * Makefile.am: Add io/size_from_kind.c. + * configure: Regenerate. + * Makefile.in: Regenerate. + +2005-11-06 Francois-Xavier Coudert + + * intrinsics/ctime.c: New file. + * configure.ac: Add check for ctime. + * Makefile.am: Add ctime.c + * configure: Regenerate. + * config.h.in: Regenerate. + * Makefile.in: Regenerate. + +2005-11-05 Richard Guenther + + * configure.ac: Use AM_FCFLAGS for extra flags, not FCFLAGS. + * configure: Regenerate. + +2005-11-05 Francois-Xavier Coudert + + * intrinsics/tty.c (ttynam): New function. + +2005-11-04 Steven G. Kargl + + PR fortran/24636 + * runtime/stop.c (stop_numeric): Use stop_code = -1. + +2005-11-04 Francois-Xavier Coudert + + PR libfortran/22298 + * runtime/main.c (stupid_function_name_for_static_linking): New + function. + * runtime/error.c (internal_error): Call + stupid_function_name_for_static_linking. + * libgfortran.h: Add prototype for + stupid_function_name_for_static_linking. + +2005-11-01 Paul Thomas + + PR fortran/14994 + * libgfortran/intrinsics/date_and_time.c: Add interface to + the functions date_and_time for the intrinsic function secnds. + +2005-10-31 Jerry DeLisle + + PR libfortran/24584 + * io/list_read.c (free_saved): Set saved_used to zero. + +2005-10-30 Francois-Xavier Coudert + + PR libfortran/20179 + * io/unix.c (flush_if_preconnected): New function. + * io/io.h: Add prototype for flush_if_preconnected. + * io/transfer.c (data_transfer_init): Use flush_if_preconnected + to workaround buggy mixed C-Fortran code. + +2005-10-30 Francois-Xavier Coudert + + * Makefile.am: Add intrinsics/malloc.c file. + * Makefile.in: Regenerate. + * intrinsics/malloc.c: New file, with implementations for free + and malloc library functions. + +2005-10-29 Mike Stump + + * Makefile.am (kinds.h): Remove target, if command fails. + (selected_int_kind.inc): Likewise. + (selected_real_kind.inc): Likewise. + * Makefile.in: Regenerate. + +2005-10-28 Francois-Xavier Coudert + + + * Makefile.am (intrinsics): Add signal.c. + * Makefile.in: Regenerate. + * configure.ac: Checks for signal and alarm. + * config.h.in: Regenerate. + * configure: Regenerate. + * intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics. + +2005-10-28 Francois-Xavier Coudert + + * acinclude.m4 (LIBGFOR_CHECK_FPSETMASK): New check. + * configure.ac: Check for floatingpoint.h, fptrap.h and float.h + headers. Use LIBGFOR_CHECK_FPSETMASK. Check for fp_trap and + fp_enable functions. + * configure.host: Add case for systems with fpsetmask and systems + with fp_trap/fp_enable. + * config/fpu-sysv.h: New file, FPU code using fpsetmask. + * config/fpu-aix.h: New file, FPU code for AIX using fp_trap and + fp_enable. + * aclocal.m4: Regenerate. + * configure: Regenerate. + * config.h.in: Regenerate. + +2005-10-24 Jerry DeLisle + + PR libfortran/24224 + * libgfortran.h: Remove array stride error code. + * runtime/error.c: Remove array stride error. + * io/io.h: Change name of 'nml_loop_spec' to 'array_loop_spec' to be + generic. Add pointer to array_loop_spec and rank to gfc_unit + structure. + * io/list_read.c: Revise nml_loop_spec references to array_loop_spec. + * io/transfer.c (init_loop_spec): New function to initialize + an array_loop_spec. + (next_array_record): New function to return the index to the next array + record by incrementing through the array_loop_spec. + (next_record_r): Use new function. + (next_record_w): Use new function. + (finalize_transfer): Free memory allocated for array_loop_spec. + * io/unit.c (get_array_unit_len): Delete this function. Use new + function init_loop_spec to initialize the array_loop_spec. + +2005-10-24 Paul Thomas + + PR fortran/24416 + * libgfortran/io/list_read.c (namelist_read): Exit with call to + free_saved () so that character strings do not accumulate. + +2005-10-23 Jerry DeLisle + + PR libfortran/24489 + * io/transfer.c (read_block): Change the order of execution to not read + past end-of-record. + (read_block_direct): Same change. + +2005-10-23 Francois-Xavier Coudert + + PR libfortran/23272 + * acinclude.m4 (LIBGFOR_CHECK_WORKING_STAT): New check. + * configure.ac: Use LIBGFOR_CHECK_WORKING_STAT. + * Makefile.in: Regenerate. + * configure: Regenerate. + * config.h.in: Regenerate. + * aclocal.m4: Regenerate. + * io/unix.c (compare_file_filename): Add fallback case for + systems without working stat. + * io/open.c (already_open): Correct call to + compare_file_filename. + * io/io.h: Correct proto for compare_file_filename. + +2005-10-23 Francois-Xavier Coudert + + * runtime/fpu.c: Add _GNU_SOURCE definition. + * config/fpu-glibc.h: Remove __USE_GNU definition. + +2005-10-23 Paul Thomas + + PR fortran/24384 + * intrinsics/spread_generic.c (spread_internal_scalar): New + function that handles the special case of spread with a scalar + source. This has new interface functions - + (spread_scalar, spread_char_scalar): New functions to interface + with the calls specified in gfc_resolve_spread. + +2005-10-21 Francois-Xavier Coudert + + PR libfortran/24383 + * io/unix.c: Add fallback definition for SSIZE_MAX. + +2005-10-19 Francois-Xavier Coudert + + * c99_protos.h: Define preprocessor HAVE_ macros with value 1 + instead of empty value. + * intrinsics/c99_functions.c: Likewise. + * intrinsics/getXid.c: Define HAVE_GETPID with value 1 instead of + empty value. + * intrinsics/sleep.c: Define HAVE_SLEEP with value 1 instead of + empty value. + +2005-10-19 Francois-Xavier Coudert + + PR libfortran/24432 + * c99_protos.h: Define HAVE_ macros for all provided functions. + +2005-10-14 Uros Bizjak + + * config/fpu-387.h (set_fpu): Remove extra ":" in stmxcsr. + Change cw and cw_sse variables to unsigned. + (SSE): New definition. + (has_sse): Use it. + +2005-10-13 Thomas Koenig + + * io/unix.c(fd_alloc_r_at): Use read() instead of do_read() + only in case of special files (e.g. terminals). + +2005-10-13 Uros Bizjak + + * config/fpu-387.h (set_fpu): Add "=m" for stmxcsr. + +2005-10-12 Francois-Xavier Coudert + + * Makefile.am: Add fpu.c to the build process, and + target-dependent code as fpu-target.h. + * Makefile.in: Regenerate. + * configure.ac: Add call to configure.host to set + FPU_HOST_HEADER. + * configure: Regenerate. + * configure.host: New script to determine which host-dependent + code should go in. + * libgfortran.h: Add fpe option, remove previous fpu_ options. + Add bitmasks for different FPE traps. Add prototype for set_fpu. + * runtime/environ.c: Remove environment variables to control + fpu behaviour. + * runtime/fpu.c (set_fpe): New function for the front-end. + * runtime/main.c (init): Set FPU state. + * config: New directory to store host-dependent code. + * config/fpu-387.h: New file with code handling the i387 FPU. + * config/fpu-glibc.h: New file with code for glibc systems. + * config/fpu-generic.h: Fallback for the most generic host. Issue + warnings. + +2005-10-12 Janne Blomqvist + + * io/unix.c(fd_alloc_r_at): Remove parts of patch of 2005/10/07 that + cause input from the terminal to hang. + +2005-10-11 Steven G. Kargl + + PR libfortran/24313 + * c99_functions.c (csqrtf, csqrt): Fix choice of branch cut. Note + csqrt{f} were imported from glibc, and this bug is still present + there. glibc PR is 1146. + +2005-10-07 Janne Blomqvist + + PR fortran/16339 + PR fortran/23363 + * io/io.h: Add read and write members to stream, define access + macros. + * io/transfer.c (read_block_direct): New function. + (write_block_direct): New function. + (unformatted_read): Change to use read_block_direct. + (unformatted_write): Change to use write_block_direct. + * io/unix.c: Remove mmap includes and defines. + (writen): Remove. + (readn): Remove. + (reset_stream): New function. + (do_read): New function. + (do_write): New function. + (fd_flush): Change to use do_write() instead of writen(). + (fd_alloc_r_at): Change to use do_read(). + (fd_seek): Change return type to try, as the prototype. Add check + to avoid syscall overhead if possible. + (fd_read): New function. + (fd_write): New function. + (fd_open): Set pointers for new functions. + (mem_read): New function. + (mem_write): New function. + (open_internal): Set pointers for new functions. + (is_seekable): Clean up comment. + +2005-10-07 Jerry DeLisle + + * io/transfer.c (write_block): Add test for end-of-file condition, + removed from mem_alloc_w_at. (next_record_w): Clean up checks for + NULL pointer returns from s_alloc_w. + * io/unix.c (mem_alloc_w_at): Remove call to generate_error end-of-file. + * io/write.c (write_float): Add checks for NULL pointer returns from + write_block calls. (write_integer): Same. + +2005-10-03 Jakub Jelinek + + * runtime/memory.c (allocate_size): Malloc 1 byte if size == 0. + +2005-10-03 Francois-Xavier Coudert + + 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 + + * runtime/memory.c (malloc_t): Remove. + (GFC_MALLOC_MAGIC, HEADER_SIZE, DATA_POINTER, DATA_HEADER): Remove. + (mem_root, runtime_cleanup, malloc_with_header): Remove. + (internal_malloc_size): Use just get_mem if size != 0, return NULL + otherwise. + (internal_free): Just free if non-NULL. + (internal_realloc_size): Remove debugging stuff. + (allocate_size): Use malloc directly, remove debugging stuff. + (deallocate): Use free directly, fix error message wording. + + * libgfortran.h (GFC_ITOA_BUF_SIZE, GFC_XTOA_BUF_SIZE, + GFC_OTOA_BUF_SIZE, GFC_BTOA_BUF_SIZE): Define. + (gfc_itoa, xtoa): Add 2 extra arguments. + * runtime/environ.c: Include stdio.h. + (check_buffered): Use sprintf. + * runtime/error.c: Include assert.h. + (gfc_itoa, xtoa): Add 2 extra arguments, avoid using static + buffers. + (st_printf, st_sprintf): Adjust callers. + * io/write.c (otoa, btoa): Add 2 extra arguments, avoid using + static buffers. + (write_int, write_decimal): Add 2 extra arguments to conv + function pointer, adjust caller. + (write_integer): Adjust gfc_itoa caller. + + * io/unit.c (get_array_unit_len): Return 0 rather than NULL. + + * io/read.c (read_f): Remove spurious pointer dereference. + +2005-09-30 Janne Blomqvist + + PR 24112 + * io/open.c (edit_modes): Check for correct flag. + +2005-09-29 Jakub Jelinek + + * runtime/string.c (find_option): Change 3rd argument to + const st_option *. + * libgfortran.h (find_option): Likewise. + * runtime/environ.c (rounding, precision, signal_choices): Constify. + (init_choice, show_choice): Change 2nd argument to const choice *. + * io/open.c (access_opt, action_opt, blank_opt, delim_opt, form_opt, + position_opt, status_opt, pad_opt): Constify. + * io/transfer.c (advance_opt): Likewise. + * io/inquire.c (undefined): Likewise. + * io/close.c (status_opt): Likewise. + * io/format.c (posint_required, period_required, nonneg_required, + unexpected_element, unexpected_end, bad_string, bad_hollerith, + reversion_error): Likewise. + * io/unix.c (yes, no, unknown): Change from const char * + into const char []. + +2005-09-27 Steve Ellcey + + PR target/23552 + * acinclude.m4 (LIBGFOR_CHECK_FOR_BROKEN_ISFINITE): New. + (LIBGFOR_CHECK_FOR_BROKEN_ISNAN): New. + (LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY): New. + * configure.ac (LIBGFOR_CHECK_FOR_BROKEN_ISFINITE): Add use. + (LIBGFOR_CHECK_FOR_BROKEN_ISNAN): Add use. + (LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY): Add use. + * configure: Regenerate. + * 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. + * io/write.c: Remove TODO comment about working isfinite. + * intrinsics/c99_functions.c (round): Use isfinite instead + of fpclassify. + * intrinsics/c99_functions.c (roundf): Ditto. + +2005-09-24 Janne Blomqvist + + * io.h: Changed prototypes of list_formatted_{read|write}. + * list_read.c (list_formatted_read): Renamed to + list_formatted_read_scalar and made static. + (list_formatted_read): New function. + * transfer.c: Prototype for transfer_array. Changed transfer + function pointer. + (unformatted_read): Add nelems argument, use it. + (unformatted_write): Likewise. + (formatted_transfer): Changed name to formatted_transfer_scalar. + (formatted_transfer): New function. + (transfer_integer): Add nelems argument to transfer call, move + updating item count to transfer functions. + (transfer_real): Likewise. + (transfer_logical): Likewise. + (transfer_character): Likewise. + (transfer_complex): Likewise. + (transfer_array): New function. + (data_transfer_init): Call formatted_transfer with new argument. + (iolength_transfer): New argument, use it. + * write.c (list_formatted_write): Renamed to + list_formatted_write_scalar, made static. + (list_formatted_write): New function. + +2005-09-26 David Edelsohn + + * configure.ac: Add check for __clog. + * configure: Regenerate. + +2005-09-25 Francois-Xavier Coudert + + * c99_protos.h: Add prototypes for C99 complex functions. + * libgfortran.h: Include complex.h before c99_protos.h. + * intrinsics/c99_functions.c: Define HAVE_ macros for the + fallback functions we provide. + (cabsf, cabs, cabsl, cargf, carg, cargl, cexpf, cexp, cexpl, + clogf, clog, clogl, clog10f, clog10, clog10l, cpowf, cpow, cpowl, + cqsrtf, csqrt, csqrtl, csinhf, csinh, csinhl, ccoshf, ccosh, + ccoshl, ctanhf, ctanh, ctanhl, csinf, csin, csinl, ccosf, ccos, + ccosl, ctanf, ctan, ctanl): New fallback functions. + * Makefile.am (gfor_math_trig_c, gfor_math_trig_obj, + gfor_specific_c, gfor_cmath_src, gfor_cmath_obj): Remove. + * Makefile.in: Regenerate. + * configure.ac: Remove checks for csin. Add checks for all C99 + complex functions. + * config.h.in: Regenerate. + * configure: Regenerate. + * aclocal.m4: Regenerate. + +2005-09-25 Francois-Xavier Coudert + Danny Smith + + PR libfortran/23803 + * intrinsics/getXid.c: Add getpid wrapper for MinGW. + * intrinsics/getlog.c: Add getlogin wrapper for MinGW. + * intrinsics/hostnm.c: Add gethostname wrapper for MinGW. + +2005-09-24 Francois-Xavier Coudert + + PR libfortran/23802 + * intrinsics/sleep.c: Add correct sleep macro for MinGW. + +2005-09-24 Francois-Xavier Coudert + + PR libfortran/23380 + * intrinsics/cpu_time.c (__cpu_time_1): Provide a MS Windows + version. + +2005-09-14 Jerry DeLisle + + PR target/19269 + * intrinsics/cshift0.c (cshift0): Add an extra size argument. + (cshift0_1, cshift0_2, cshift0_4, cshift0_8): Replace explicit + implementations with... + (DEFINE_CSHIFT): ...this new macro. Define character versions too. + * intrinsics/eoshift0.c (zeros): Delete. + (eoshift0): Add extra size and filler arguments. Use memset if no + bound is provided. + (eoshift0_1, eoshift0_2, eoshift0_4, eoshift0_8): Replace explicit + implementations with... + (DEFINE_EOSHIFT): ...this new macro. Define character versions too. + * intrinsics/eoshift2.c (zeros): Delete. + (eoshift2): Add extra size and filler arguments. Use memset if no + bound is provided. + (eoshift2_1, eoshift2_2, eoshift2_4, eoshift2_8): Replace explicit + implementations with... + (DEFINE_EOSHIFT): ...this new macro. Define character versions too. + * intrinsics/pack.c (pack_internal): New static function, reusing + the contents of pack and adding an extra size argument. Change + "mptr" rather than "m" when calculating the array size. + (pack): Redefine as a forwarder to pack_internal. + (pack_s_internal): New static function, reusing the contents of + pack_s and adding an extra size argument. + (pack_s): Redefine as a forwarder to pack_s_internal. + (pack_char, pack_s_char): New functions. + * intrinsics/reshape.c (reshape_internal): New static function, + reusing the contents of reshape and adding an extra size argument. + (reshape): Redefine as a forwarder to reshape_internal. + (reshape_char): New function. + * intrinsics/spread.c (spread_internal): New static function, + reusing the contents of spread and adding an extra size argument. + (spread): Redefine as a forwarder to spread_internal. + (spread_char): New function. + * intrinsics/transpose.c (transpose_internal): New static function, + reusing the contents of transpose and adding an extra size argument. + (transpose): Redefine as a forwarder to transpose_internal. + (transpose_char): New function. + * intrinsics/unpack.c (unpack_internal): New static function, reusing + the contents of unpack1 and adding extra size and fsize arguments. + (unpack1): Redefine as a forwarder to unpack_internal. + (unpack0): Call unpack_internal instead of unpack1. + (unpack1_char, unpack0_char): New functions. + * m4/cshift1.m4 (cshift1): New static function, reusing the contents + of cshift1_ and adding an extra size argument. + (cshift1_): Redefine as a forwarder to cshift1. + (cshift1__char): New function. + * m4/eoshift1.m4 (zeros): Delete. + (eoshift1): New static function, reusing the contents of + eoshift1_ and adding extra size and filler arguments. + Fix calculation of hstride. Use memset if no bound is provided. + (eoshift1_): Redefine as a forwarder to eoshift1. + (eoshift1__char): New function. + * m4/eoshift3.m4 (zeros): Delete. + (eoshift3): New static function, reusing the contents of + eoshift3_ and adding extra size and filler arguments. + Use memset if no bound is provided. + (eoshift3_): Redefine as a forwarder to eoshift3. + (eoshift3__char): New function. + * generated/cshift1_4.c, generated/cshift1_8.c, + * generated/eoshift1_4.c, generated/eoshift1_8.c, + * generated/eoshift3_4.c, generated/eoshift3_8.c: Regenerate. + +2005-09-11 Francois-Xavier Coudert + + PR libfortran/20179 + * io/unix.c (is_preconnected): Add function to test if a stream + corresponds to a preconnected unit. + * io/io.h: Add prototype for is_preconnected. + * io/transfer.c (data_transfer_init): Do not truncate + preconnected units. + +2005-09-10 Janne Blomqvist + + * io/unix.c: Remove mmap code. + +2005-09-09 Francois-Xavier Coudert + + PR libfortran/23784 + * io/close.c (st_close): Call library_end even in case of error. + +2005-09-09 Thomas Koenig + + * io/io.h: Add iomsg as last field of st_parameter. + * runtime/error.c (generate_error): If iomsg is present, copy + the message there. + +2005-09-09 Richard Sandiford + + PR fortran/12840 + * runtime/memory.c (internal_malloc_size): Return a null pointer + if the size is zero. + (internal_free): Do nothing if the pointer is null. + (internal_realloc_size, internal_realloc, internal_realloc64): New. + +2005-09-07 Francois-Xavier Coudert + + PR libfortran/23262 + * acinclude.m4 (LIBGFOR_CHECK_CRLF): New check. + * configure.ac: Use new check. + * configure.in: Regenerate. + * config.h.in: Regenerate. + * configure: Regenerate. + * io/transfer.c (next_record_w): Add case for CRLF as line + terminator. + * io/unix.c (tempfile, regular_file): Open files with + O_BINARY on systems with CRLF. + +2005-09-07 Steve Ellcey + + PR libfortran/23419 + * io/write.c (extract_int): Use memcpy to access buffer. + (extract_uint): Ditto. + (extract_real): Ditto. + +2005-09-05 Thomas Koenig + + * io/list_read.c: Adjust size of of value to 32 (to hold + kind=16 complex values). + +2005-09-04 Thomas Koenig + + PR libfortran/23321 + * io/transfer.c(data_transfer_init): Check for a too-large + record number. Return if sseek failed. + +2005-09-03 Jakub Jelinek + + * io/read.c (read_x): Take int argument instead of fnode * and + digging the N from F->u.n. + * io/io.h (read_x): Adjust prototype. + * io/transfer.c (formatted_transfer): Adjust callers. Don't clobber + f->u.n for FMT_T. + +2005-09-02 Francois-Xavier Coudert + + * io/unix.c (stream_ttyname): Protect use of ttyname by + HAVE_TTYNAME macro. + * configure.ac: Add check for ttyname. + * config.h.in: Regenerate. + * configure: Regenerate. + +2005-09-02 Andreas Jaeger + + * libgfortran.h: Add prototype for init_compile_options. + + * io/io.h: Add prototype for notify_std. + +2005-08-31 Steve Ellcey + + * io/read.c (set_integer): Use memcpy to fill buffer. + +2005-08-31 Steve Ellcey + + PR target/23556 + * io/read.c (convert_real): Use memcpy to fill buffer. + +2005-08-29 Thomas Koenig + + PR libfortran/23598 + * io/lock.c(library_start): If ioparm.iostat is present, clear + it unconditionally. + +2005-08-27 Francois-Xavier Coudert + + * acinclude.m4 (LIBGFOR_CHECK_UNLINK_OPEN_FILE): Add check to see + if target can unlink open files. + * configure.ac: Use this new test. + * config.h.in: Regenerate. + * configure: Regenerate. + * Makefile.in: Regenerate. + * aclocal.ac: Regenerate. + * io/io.h: Add prototype for unpack_filename. + * io/close.c (st_close): Delete file after closing unit if + HAVE_UNLINK_OPEN_FILE is not defined. + * io/unix.c (unpack_filename): Unlink scratch file after opening + it only if HAVE_UNLINK_OPEN_FILE is defined. + +2005-08-17 Kelley Cook + + * All files: Update FSF address. + +2005-08-16 Thomas Koenig + + PR libfortran/23428 + * io/transfer.c (iolength_transfer): Remove __attribute__ ((unused)) + from type. Return correct length for inquire(iolength=) + for complex variables. + +2005-08-11 Francois-Xavier Coudert + Steven Bosscher + + PR libfortran/20006 + * Makefile.am: Add file runtime/compile_options.c. + * Makefile.in: Regenerate. + * libgfortran.h: Create structure compile_options_t. Define the + compile_options variable and GFC_STD_ macros. + * runtime/compile_options.c: New file. + * runtime/error.c (notify_std): New function. + * runtime/main.c (init): Call init_compile_options during + initialization. + * io/format.c: Use the new notify_std function for the $ + descriptor extension. + +2005-08-09 Francois-Xavier Coudert + * Makefile.am: Add file intrinsics/tty.c to Makefile process. + * Makefile.in: Regenerate. + * io/io.h: Prototypes for new functions stream_isatty and + stream_ttyname. + * io/unix (stream_isatty, stream_ttyname): New functions to call + isatty() and ttyname() on a given unit. + * intrinsics/tty.c: New file to implement g77 intrinsics TTYNAM + and ISATTY. + +2005-08-08 Jerry DeLisle + + PR libfortran/23154 + * io/transfer.c (data_transfer_init): Initialize + current_unit->bytes_left for a read. + +2005-08-07 Janne Blomqvist + + PR fortran/22390 + * io/backspace.c: File removed, contents moved to ... + * io/endfile.c: Ditto. + * io/rewind.c: Ditto. + * io/file_pos.c: New file, ... here. + * Makefile.am: Add file_pos.c to list, remove obsolete files. + * Makefile.in: Regenerated. + +2005-08-07 Francois-Xavier Coudert + + * io/io.h: Change DEFAULT_TEMPDIR to /tmp instead of /var/tmp. + * io/unix.c (tempfile): Look at the TEMP environment variable + to find the temporary files directory. Whitespace correction. + +2005-08-06 Francois-Xavier Coudert + + * io/unix.c: Add O_RDWR to open() call. + +2005-08-04 Paul Thomas + + * transfer.c (data_transfer_init): Truncate file in + sequential WRITE when last_record == 0, rather than + current_record. Cures problem on RH9. + +2005-08-03 Francois-Xavier Coudert + + * libgfortran.h: When isfinite is not provided by the system, + define it as a macro, so that it can accept any floating point + type. + +2005-08-01 Francois-Xavier Coudert + + PR libfortran/23178 + * intrinsics/flush.c (flush_i8): Add function flush_i8. Update + copyright years. + +2005-07-31 Francois-Xavier Coudert + + PR libfortran/21787 + * intrinsics/abort.c (abort): Close units before aborting. + Updated copyright years. + +2005-07-30 Francois-Xavier Coudert + + PR libfortran/22436 + * io/write.c (write_real): Add default formats for real(10) and + real(16). + +2005-07-30 Paul Thomas + + PR fortran/22570 and related issues. + * transfer.c (formatted_transfer): Make sure that there + really is data present before X- or T- editing. Move all + treatment of tabbing during writes to start of next data + producing format. Suppress incorrect zeroing of bytes_left + in slash formating. Insert int cast for assignment of a + difference of two gfc_offsets. + +2005-07-23 Jerry DeLisle + + * io/write.c (write_float): Revise output of IEEE exceptional + values to comply with F95 and F2003 standards. + +2005-07-22 Jerry DeLisle + + PR libfortran/22570 + * io/unit.c (init_units): Replace BLANK_ZERO with + BLANK_UNSPECIFIED. + +2005-07-22 Jerry DeLisle + + PR libfortran/21875 (FM111.f) + * io/read.c (next_char): Return a ' ' character when BLANK_ZERO + or BLANK_NULL are active. + (read_decimal): Interpret ' ' character correctly for BZ or BN. + (read_radix): Interpret ' ' character correctly for BZ or BN. + (read_f): Interpret ' ' character correctly for BZ or BN. + +2005-07-22 Paul Thomas + + PR libfortran/22570 + * read.c (read_x): Correct the condition for doing the + x-editing during formatted input. + * transfer.c (formatted_transfer): Cast offset difference + as int, clean-up arithmetic with new variable, bytes_used, + zero counters for FMT_SLASH, + (data_transfer_init) Zero X- and T-editing counters + unconditionally. + (next_record_w) Zero X- and T-editing counters. + unconditionally. + +2005-07-17 Jerry DeLisle + + * io/write.c (write_float): Fix field width checks for + printing 'Infinity' or 'Inf'. + (output_float): Fix typo in comment. + +2005-07-12 Paul Thomas + + PR libfortran/16435 + * transfer.c (formatted_transfer): Correct the problems + with X- and T-editting that caused TLs followed by TRs + to overwrite data, which caused NIST FM908.FOR to fail + on many tests. + (data_transfer_init): Zero X- and T-editting counters at + the start of formatted IO. + * write.c (write_x): Write specified number of skips with + specified number of spaces at the end. + +2005-07-13 Paul Thomas + + * io/read.c (read_complex): Prevent X formatting during reads + from going beyond EOR to fix NIST fm908.FOR failure. + * io/list_read.c (read_complex): Allow complex data in list- + directed reads to have eols either side of the comma to + fix NIST FM906.FOR failure. + +2005-07-12 Thomas Koenig + + PR libfortran/21593 + * io/unix.c: Add member special_file to type unix_stream. + (fd_truncate): Don't call ftruncate or chsize if + s refers to a special file. + (fd_to_stream): initialize s->special_file. + +2005-07-11 David Edelsohn + + PR libfortran/22412 + * io/write.c (otoa): Bias p by SCRATCH_SIZE, not + sizeof (SCRATCH_SIZE). + (btoa): Same. + +2005-07-09 Jerry DeLisle + + PR libfortran/21875 (FM111.f) + * io/read.c (next_char): Return a ' ' character when BLANK_ZERO or + BLANK_NULL are active. + (read_decimal): Interpret ' ' character correctly for BZ or BN. + (read_radix): Interpret ' ' character correctly for BZ or BN. + (read_f): Interpret ' ' character correctly for BZ or BN. + * gfortran.dg/test (fmt_read_bz_bn.f90): New test case. + +2005-07-09 Francois-Xavier Coudert + Thomas Koenig + + PR libfortran/22217 + * io/write.c (extract_unit): New function; extract + ints as unsigned signed int of the correct size. + (write_int): Use it. + * runtime/error.c: Adjust copyright years. + Adjust size of buffer to maximum that can occur. + +2005-07-07 Tobias Schl"uter + + * libgfortran.h (GFC_ARRAY_DESCRIPTOR): Replace 'type *base' by + 'size_t offset'. + * intrinsics/cshift0.c, intrinsics/eoshift0.c, + intrinsics/eoshift2.c,intrinsics/pack_generic.c, + intrinsics/reshape_generic.c, intrinsics/spread_generic.c, + intrinsics/transpose_generic.c, intrinsics/unpack_generic, + m4/cshift1.m4, m4/eoshift1.m4, m4/eoshift3.m4, m4/iforeach.m4, + m4/ifunction.m4, m4/matmul.m4, m4/matmull.m4, m4/reshape.m4, + m4,transpose.m4: Set renamed field 'offset' to zero instead of + 'base'. + * generated/all_l4.c, generated/all_l8.c, + generated/any_l4.c, generated/any_l8.c, generated/count_4_l4.c, + generated/count_4_l8.c, generated/count_8_l4.c, + generated/count_8_l8.c, generated/chift1_4.c, + generated/cshift1_8.c, generated/eoshift1_4.c, + generated/eoshift1_8.c, generated/eoshift3_4.c, + generated/eoshift3_8.c, generated/matmul_c4.c, + generated/matmul_c8.c, generated/matmul_i4.c, matmul_i8.c, + generated/matmul_l4.c, generated/matmul_l8.c, + generated/matmul_r4.c, generated/matmul_r8.c, + generated/maxloc0_4_i4.c, generated/maxloc0_4_i8.c, + generated/maxloc0_4_r4.c, generated/maxloc0_4_r8.c, + generated/maxloc0_8_i4.c, generated/maxloc0_8_i8.c, + generated/maxloc0_8_r4.c, generated/maxloc0_8_r8.c, + generated/maxloc1_4_i4.c, generated/maxloc1_4_i8.c, + generated/maxloc1_4_r4.c, generated/maxloc1_4_r8.c, + generated/maxloc1_8_i4.c, generated/maxloc1_8_i8.c, + generated/maxloc1_8_r4.c, generated/maxloc1_8_r8.c, + generated/maxval_i4.c, generated/maxval_i8.c, + generated/maxval_r4.c, generated/maxval_r8.c, + generated/minloc0_4_i4.c, generated/minloc0_4_i8.c, + generated/minloc0_4_r4.c, generated/minloc0_4_r8.c, + generated/minloc0_8_i4.c, generated/minloc0_8_i8.c, + generated/minloc0_8_r4.c, generated/minloc0_8_r8.c, + generated/minloc1_4_i4.c, generated/minloc1_4_i8.c, + generated/minloc1_4_r4.c, generated/minloc1_4_r8.c, + generated/minloc1_8_i4.c, generated/minloc1_8_i8.c, + generated/minloc1_8_r4.c, generated/minloc1_8_r8.c, + generated/minval_i4.c, generated/minval_i8.c, + generated/minval_r4.c, generated/minval_r8.c, + generated/product_c4.c, generated/product_c8.c, + generated/product_i4.c, generated/product_i8.c, + generated/product_r4.c, generated/product_r8.c, + generated/reshape_c4.c, generated/reshape_c8.c, + generated/reshape_i4.c, generated/reshape_i8.c, + generated/sum_c4.c, generated/sum_c8.c, generated/sum_i4.c, + generated/sum_i8.c, generated/sum_r4.c, generated/sum_r8.c, + generated/transpose_c4.c, generated/transpose_c8.c, + generated/transpose_i4.c, generated/transpose_i8.c: Regenerate: + +2005-07-07 Thomas Koenig + + PR libfortran/21594 + * intrinsics/eoshift0.c: If abs(shift) > len, fill the + the whole array with the boundary value, but don't overrun it. + * intrinsics/eoshift2.c: Likewise. + * m4/eoshift1.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + +2005-07-07 Feng Wang + + PR fortran/16531 + * io/transfer.c (formatted_transfer): Enable FMT_A on other types to + support Hollerith constants. + +2005-07-01 Andreas Jaeger + + * intrinsics/unpack_generic.c: Remove const from parameter. + + * io/transfer.c (formatted_transfer): Remove unused variable. + +2005-06-28 Thomas Koenig + + PR libfortran/22142 + * m4/eoshift1.m4: Correct bstride (it needs to be multiplied + by size since it's a char pointer). + * m4/eoshift1_4.c: Regenerated. + * m4/eoshift1_8.c: Regenerated. + +2005-06-28 Thomas Koenig + + PR libfortran/22142 + * m4/eoshift3.m4: Correct bstride (it needs to be multiplied + by size since it's a char pointer). + * m4/eoshift3_4.c: Regenerated. + * m4/eoshift3_8.c: Regenerated. + +2005-06-28 Francois-Xavier Coudert + + PR libfortran/22170 + * io/transfer.c (formatted_transfer): Do not iterate on the + repeat count of a FMT_SLASH, since this is already done in + next_format(). + +2005-06-25 Thomas Koenig + + PR libfortran/22144 + * m4/cshift1.m4: Remove const from argument ret. + Populate return array descriptor if ret->data is NULL. + * m4/eoshift1.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + +2005-06-24 Jerry DeLisle + + PR libfortran/21915 + * Makefile.am: Include intrinsics/hyper.c. + * c99_protos.h: Add prototypes for single precision versions of + acosh, asinh, and atanh for platforms that do not have these. + * config.h.in: Add #undef for wrappers. + * configure.ac: Add checks for single precision versions. + * aclocal.m4: Regenerated. + * Makefile.in: Regenerated. + * configure: Regenerated. + * intrinsics/hyper.c: New file, adds new wrapper functions. + +2005-06-23 Francois-Xavier Coudert + + * intrinsics/c99_functions.c (log10l): New log10l function for + systems where this is not available. + * c99_protos.h: Prototype for log10l function. + * libgfortran.h: Use generated kinds.h to define GFC_INTEGER_*, + GFC_UINTEGER_*, GFC_LOGICAL_*, GFC_REAL_*, GFC_COMPLEX_*. Update + prototypes for gfc_itoa and xtoa. + * io/io.h: Update prototypes for set_integer and max_value. + * io/list_read.c (convert_integer): Use new + GFC_(INTEGER|REAL)_LARGEST type. + * io/read.c (set_integer): Likewise. + (max_value): Likewise. + (convert_real): Likewise. + (real_l): Likewise. + (next_char): Likewise. + (read_decimal): Likewise. + (read_radix): Likewise. + (read_f): Likewise. + * io/write.c (extract_int): Use new GFC_INTEGER_LARGEST type. + (extract_real): Use new GFC_REAL_LARGEST type. + (calculate_exp): Likewise. + (calculate_G_format): Likewise. + (output_float): Likewise. Use log10l for long double values. + Add comment for sprintf format. Use GFC_REAL_LARGEST_FORMAT. + (write_l): Use new GFC_INTEGER_LARGEST type. + (write_float): Use new GFC_REAL_LARGEST type. + (write_int): Remove useless special case for (len < 8). + (write_decimal): Use GFC_INTEGER_LARGEST. + (otoa): Use GFC_UINTEGER_LARGEST as argument. + (btoa): Use GFC_UINTEGER_LARGEST as argument. + * runtime/error.c (gfc_itoa): Use GFC_INTEGER_LARGEST as + argument. + (xtoa): Use GFC_UINTEGER_LARGEST as argument. + * Makefile.am: Use mk-kinds-h.sh to generate header kinds.h + with all Fortran kinds available. + * configure.ac: Check for strtold and log10l. + * Makefile.in: Regenerate. + * aclocal.m4: Regenerate. + * configure: Regenerate. + * config.h.in: Regenerate. + * mk-kinds-h.sh: Configuration script for available integer + and real kinds. + + +2005-06-18 Janne Blomqvist + + * unix.c (stream_at_bof): Don't assume that all non-mmapped files + are non-seekable. + (stream_at_eof): Likewise. + +2005-06-18 Francois-Xavier Coudert + + PR libfortran/19155 + * io/read.c (convert_real): strtod can set errno to EINVAL on an + empty string, but we shouldn't have an error in that case. + +2005-06-17 Francois-Xavier Coudert + + PR libfortran/19216 + * io/list_read.c (eat_separator): No need to call next_record, + even in non-namelist_mode. + +2005-06-17 Francois-Xavier Coudert + + * io/transfer.c (formatted_transfer): Fix typo in error message. + +2005-06-17 Francois-Xavier Coudert + + PR libfortran/16436 + * io/transfer.c (read_sf): Correct updating of bytes_left field. + (formatted_transfer): Correct updating of bytes_left field and + reformatting code (comments and whitespace). + * io/unix.c (move_pos_offset): "active" field should not be + changed here. Whitespace corrections. + +2005-06-15 Francois-Xavier Coudert + + PR libfortran/21950 + * intrinsics/c99_functions.c (scalbn): Provide fallback + implementation for scalbn. + * c99_protos.h: Prototype for scalbn. + * configure.ac: Add check for scalbn. + * configure: Regenerate. + * config.h.in: Regenerate. + +2005-06-14 Thomas Koenig + + * intrinsics/eoshift0.c: Removed prototype for eoshift0. + * intrinsics/eoshift2.c: Removed prototype for eoshift2. + +2005-06-14 Tom Tromey + + PR libgcj/19877: + * configure, aclocal.m4, Makefile.in: Rebuilt. + +2005-06-12 Thomas Koenig + + PR libfortran/21594 + * intrinsics/eoshift0.c: Add prototype for eoshift0. + * intrinsics/eoshift2.c: Add prototype for eoshift2. + +2005-06-12 Steven G. Kargl + Thomas Koenig + + PR libfortran/PR21797 + * m4/cexp.m4 (csqrt`'q): Add type qualifyer to + sqrt and fabs. + * generated/exp_c4.c: Regenerated. + +2005-06-12 Francois-Xavier Coudert + + PR libfortran/19155 + * io/read.c (read_f): Take care of spaces after initial sign. + +2005-06-11 Thomas Koenig + + PR libfortran/21333 + * Makefile.am: Add in_pack_c4.c, in_pack_c8.c, in_unpack_c4.c + and in_unpack_c8.c. + * Makefile.in: Regenerate. + * libgfortran.h: Declare internal_pack_c4, internal_pack_c8, + internal_unpack_c4 and internal_unpack_c8. + * m4/in_pack.m4: Use rtype_ccode insteald of rtype_kind + in function name. + Use sizeof (rtype_name) as size for memory allocation. + * m4/in_unpack.m4: Use rtype_ccode insteald of rtype_kind + in function name. + Use sizeof (rtype_name) for calculation of sizes for memcpy. + * runtime/in_pack_generic.c: For real, integer and logical + call internal_pack_4 if size==4 and internal_pack_8 if + size==8. + For complex, call internal_pack_c4 if size==8 and + internal_pack_c8 if size==16. + * runtime/in_unpack_generic.c: For real, integer and logical + call internal_unpack_4 if size==4 and internal_unpack_8 if + size==8. + For complex, call internal_unpack_c4 if size==8 and + internal_unpack_c8 if size==16. + * generated/in_pack_i4.c: Regenerated. + * generated/in_pack_i8.c: Regenerated. + * generated/in_unpack_i4.c: Regenerated. + * generated/in_unpack_i8.c: Regenerated. + * generated/in_pack_c4.c: New file. + * generated/in_pack_c8.c: New file. + * generated/in_unpack_c4.c: New file. + * generated/in_unpack_c8.c: New file. + +2005-06-09 Thomas Koenig + + PR libfortran/21480 + * m4/reshape.m4: Use sizeof (rtype_name) for sizes to be passed + to reshape_packed. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_i4.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + +2005-06-07 Thomas Koenig + + PR libfortran/21926 + * m4/matmul.m4: Correct zeroing of result for non-packed + arrays with lowest stride is one. + * generated/matmul_c4.c: Regenerated. + * generated/matmul_c8.c: Regenerated. + * generated/matmul_i4.c: Regenerated. + * generated/matmul_i8.c: Regenerated. + * generated/matmul_r4.c: Regenerated. + * generated/matmul_r8.c: Regenerated. + +2005-05-30 Francois-Xavier Coudert + + PR libfortran/20179 + * io/unix.c (fd_close): Add test so that we don't close() + stdout and stderr. + +2005-05-29 Francois-Xavier Coudert + + PR libfortran/20006 + * io/format.c (parse_format_list): Set repeat count of $ format + node to 1. + * io/transfer.c (read_sf): Add g.seen_dollar to the test + concerning advancing I/O. + (data_transfer_init): Likewise. + (finalize_transfer): Likewise. + +2005-05-27 Thomas Koenig + + * runtime/in_pack_generic.c: Adjust copyright years. + (in_pack_generic): Change dimension of auxiliary arrays from + GFC_MAX_DIMENSION - 1 to GFC_MAX_DIMENSION. + * runtime/in_unpack_generic.c: Adjust copyright years. + (in_unpack_generic): Change dimension of auxiliary arrays from + GFC_MAX_DIMENSION - 1 to GFC_MAX_DIMENSION. + +2005-05-26 Thomas Koenig + + PR libfortran/17283 + * intrinsics/unpack_generic.c: Fix name of routine + on top. Update copyright years. + (unpack1): Remove const from return array descriptor. + rs: New variable, for calculating return sizes. + Populate return array descriptor if ret->data is NULL. + +2005-05-22 Peter Wainwright + + PR libfortran/21376 + * io/write.c (output_float): Rework logic to avoid call to log10 + with argument equal to zero. + +2005-05-21 Eric Botcazou + + * configure.ac: Check for trunc and truncf in libm. + * configure: Regenerate. + * config.h.in: Likewise. + * intrinsics/c99_functions.c (trunc, truncf): New functions. + * c99_protos.h (trunc, truncf): Declare them. + +2005-05-18 Thomas Koenig + + PR libfortran/21127 + * Makefile.am: Really commit. + * Makefile.in: Really commit. + +2005-05-18 Thomas Koenig + + PR libfortran/21127 + * Makefile.am: Add generated/reshape_c4.c and + generated/reshape_c8.c. + * Makefile.in: Regenerated. + * m4/iparm.m4: Define rtype_ccode to be c4 or c8 for + complex types, 4 or 8 otherwise. + * m4/reshape.m4: Use rtype_ccode instead of rtype_kind + in function name. + * generated/reshape_c4.c: New file. + * generated/reshape_c8.c: New file. + +2005-05-16 Andreas Jaeger + + * configure.ac: Add additional warning flags. + * configure: Regenerate. + + * io/write.c (calculate_G_format): Remove unused parameter. + (output_float): Remove unused parameter. + (write_float): Change callers. + (nml_write_obj): Avoid signed warning. + Make variable const to support -Wwrite-strings. + + * io/unix.c (fd_alloc, mmap_open, mmap_sfree, mem_sfree, + mem_truncate): Mark argument as unused. + + * io/unit.c (get_unit): Mark argument as unused. + (init_units): Avoid warning about signed comparision. + + * io/transfer.c (next_record_r): Remove unused parameter. + (next_record_w): Remove unused parameter. + (next_record): Change callers. + (iolength_transfer): Mark arguments as unused. + + * io/open.c: Add initializer. + + * io/list_read.c (read_character): Mark argument as unused. + (nml_match_name): Add const to make compile with -Wwrite-strings. + + * io/format.c: Add initializer. + +2005-05-15 Andreas Jaeger + + * m4/eoshift1.m4: Initialize variables to avoid warnings. + * m4/eoshift3.m4: Initialize variables to avoid warnings. + * generated/eoshift1_4.c, generated/eoshift1_8.c, + generated/eoshift3_4.c, generated/eoshift3_8.c: Regenerated. + + * intrinsics/spread_generic.c (spread): Initialize variables to + avoid warnings. + + * intrinsics/eoshift0.c (eoshift0): Initialize variables to avoid + warnings. + * intrinsics/eoshift2.c (eoshift2): Initialize variables to avoid + warnings. + + * io/list_read.c (nml_get_obj_data): Initialize variables to avoid + warnings. + + * intrinsics/pack_generic.c (pack): Remove unneeded calculation. + + * m4/matmull.m4 (matmul_): Remove unneeded calculations, fix + pointer cast to avoid warning. + * generated/matmul_l4.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + + * Makefile.am: Remove AM_CFLAGS here. + * configure.ac: Define AM_CFLAGS and AM_FCFLAGS so that warnings + are set. Set additionally -Wstrict-prototypes for CFLAGS. + * Makefile.in: Regenerated. + * aclocal.m4: Regenerated. + * configure: Regenerated. + + * intrinsics/system_clock.c (system_clock_4, system_clock_8): Add + missing returns, reformat a bit. + + * io/write.c (nml_write_obj): Use %d again - and cast to int, + st_sprintf does not handle %ld. + + * io/unit.c (is_internal_unit): Add void as parameter list. + + * io/transfer.c: Move prototype declarations before the functions. + + * runtime/normalize.c (almostone_r4, almostone_r8): Fix parameter + list. + + * intrinsics/random.c (KISS_DEFAULT_SEED): Remove extra semicolon. + + * io/transfer.c: Do not use empty initializers for global objects. + Add missing initializers. + + * io/lock.c: Do not use empty initializers for global objects. + + * io/close.c: Add missing initializers. + + * runtime/environ.c: Add missing initializers. Do not use empty + initializers for global object. + (init_string): Mark argument as unused. + + * runtime/main.c (cleanup): Fix parameter list. + + * io/io.h: Fix parameter lists. + + * m4/transpose.m4, m4/matmul.m4: Fix pointer cast to avoid + warning. + + * generated/transpose_c4.c, generated/transpose_c8.c, + generated/transpose_i4.c, generated/transpose_i8.c, + generated/matmul_c4.c, generated/matmul_c8.c, + generated/matmul_i4.c, generated/matmul_i8.c, + generated/matmul_r4.c, generated/matmul_r8.c: Regenerated. + + * io/write.c (nml_write_obj): Fix 64-bit problem. + + * io/list_read.c (nml_get_obj_data): Add missing braces around + initializer to avoid warnings. + + * intrinsics/etime.c (etime_sub): Remove unused variable. + + * intrinsics/chdir.c, intrinsics/getlog.c, intrinsics/link.c, + intrinsics/symlnk.c, intrinsics/perror.c: Include for + prototypes. + + * runtime/string.c (compare0): Remove unused variable. + * io/unit.c (init_units): Remove unused variables. + * intrinsics/getcwd.c (getcwd_i4_sub): Remove unused variable. + * intrinsics/unlink.c (unlink_i4_sub): Remove unused variable. + * intrinsics/stat.c (stat_i4_sub, fstat_i8_sub, fstat_i4_sub, + stat_i8_sub): Remove unused variable. + +2005-05-12 Thomas Koenig + + PR libfortran/21324 + * runtime/memory.c: Don't define GFC_CLEAR_MEMORY (it's a + performance hog). + * io/open.c (new_unit): Zero freshly allocated memory for + unit structure. + * io/unit.c (init_units): Zero freshly allocated memory for + STDIN, STDOUT and STDERR. + * io/unix.c (open_internal): Zero freshly allocated memory + for unix_stream. + (fd_to_stream): Likewise. + +2005-05-11 Bud Davis + + PR fortran/19478 + * io/unix.c (fd_truncate): update positions when ftruncate + fails (like writing to /dev/null). + +2005-05-10 Francois-Xavier Coudert + + PR libfortran/21471 + * open.c (new_unit): Take care of the case where POSITION_APPEND + is specified (sseek to the end, and set u>-endfile). + +2005-05-10 Tobias Schl"uter + + PR fortran/20178 + * Makefile.am (gfor_specific_src): Add 'intrinsics/f2c_intrinsics.F90' + to dependencies. + * Makefile.in: Regenerate. + * intrinsics/f2c_specific.F90: New file. + +2005-05-10 Francois-Xavier Coudert + + PR libfortran/20788 + * io/unix.c (fd_to_stream): Add an avoid_mmap argument indicating + we don't we to mmap this stream. Use fd_open instead of mmap_open + in that case. + (open_external): Call fd_to_stream with avoid_mmap = 0. + (input_stream): Call fd_to_stream with avoid_mmap = 1. + (output_stream): Likewise. + (error_stream): Likewise. + +2005-05-09 Mike Stump + + * configure: Regenerate. + +2005-05-09 Francois-Xavier Coudert + + PR libfortran/19155 + * io/read.c (read_f): Accept 'e', 'E', 'd' and 'D' as first + non-blank characters of a real number. + +2005-05-04 Thomas Koenig + + PR libfortran/21354 + * m4/cshift1.m4: Change dimension of auxiliary arrays from + GFC_MAX_DIMENSION - 1 to GFC_MAX_DIMENSION. + * m4/eoshift1.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * m4/ifunction.m4: Likewise. + * m4/in_pack.m4: Likewise. + * m4/in_unpack.m4: Likewise. + * intrinsics/cshift0.c: Likewise. + * intrinsics/eoshift0.c: Likewise. + * intrinsics/eoshift2.c: Likewise. + * intrinsics/random.c: Likewise. + * intrinsics/spread_generic.c: Likewise. + * intrinsics/stat.c: Likewise. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_4_l4.c: Regenerated. + * generated/count_4_l8.c: Regenerated. + * generated/count_8_l4.c: Regenerated. + * generated/count_8_l8.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + * generated/in_pack_i4.c: Regenerated. + * generated/in_pack_i8.c: Regenerated. + * generated/in_unpack_i4.c: Regenerated. + * generated/in_unpack_i8.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2005-04-30 Thomas Koenig + + PR libfortran/18958 + libgfortran.h: Change typedef of index_type from size_t + to ssize_t. + +2005-04-30 Paul Thomas + + PR libfortran/18857 + * generated/matmul_r8.c: Remove incorrect assertions. + * generated/matmul_c4.c: Regenerate + * generated/matmul_c8.c: Regenerate + * generated/matmul_i4.c: Regenerate + * generated/matmul_i8.c: Regenerate + * generated/matmul_r4.c: Regenerate + * generated/matmul_r8.c: Regenerate + +2005-04-29 Francois-Xavier Coudert + + * configure.ac: Check for ftruncate and chsize. + * io/unix.c (fd_truncate): Provide chsize as alternative to + ftruncate. + * config.h.in: Regenerate. + * configure: Regenerate. + +2005-04-29 Tobias Schl"uter + + * intrinsics/rename.c: Add missing #includes. + +2005-04-28 Tobias Schl"uter + + * AUTHORS, COPYING, INSTALL, NEWS, README: Remove. + +2005-04-26 David Edelsohn + + PR libfortran/20930 + * io/rewind.c (st_rewind): Flush the stream when resetting the mode + from WRITING to READING. + +2005-04-22 Paul Thomas + Jerry DeLisle + + * io/write.c (nml_write_obj): Provide 1 more byte for ext_name. + * io/list_read.c (nml_get_obj_data): Put extra brackets in get_mem + call for ext_name. These fix the bug reported by Jerry DeLisle to + the fortran list and are based on his suggested fix. + +2005-04-22 Thomas Koenig + + PR libfortran/20074 + PR libfortran/20436 + PR libfortran/21108 + * m4/reshape.m4 (reshape_`'rtype_kind): rs, rex: New + variables, to be used in calculation of return array sizes. + Populate return array descriptor if ret->data is NULL. + Fix condition for early return (it used to test something + undefined if order was used). + Remove duplicate check wether pad is used. + * intrinsics/reshape_generic.c (reshape_generic): Likewise. + Fix a few places where the wrong variables were set. + * generated/reshape_i4.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + +2005-04-18 Paul Thomas + + * io/list_read.c (nml_touch_nodes, nml_read_obj, + nml_get_obj_data): Fix memory leaks in code for derived types. + +2005-04-11 Francois-Xavier Coudert + + PR libfortran/20950 + * io/inquire.c (inquire_via_unit): Check for the gfc_unit being + NULL when setting ioparm.sequential. + +2005-04-17 Thomas Koenig + + PR libfortran/21075 + * m4/reshape.m4 (reshape_`'rtype_kind): Change dimension + of auxiliary arrays from GFC_MAX_DIMENSIONS - 1 to + GFC_MAX_DIMENSIONS. + * intrinsics/reshape_generic.c (reshape_generic): Likewise. + * generated/reshape_i4.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + +2005-04-17 Paul Thomas + + * io/list_read.c (eat_separator): at_eol = 1 replaced + (zapped at some time?). + +2005-04-17 Paul Thomas + + PR libfortran/12884 + PR libfortran/17285 + PR libfortran/18122 + PR libfortran/18210 + PR libfortran/18392 + PR libfortran/18591 + PR libfortran/18879 + * io/io.h (nml_ls): Declare. + (namelist_info): Modify for arrays. + * io/list_read.c (namelist_read): Reduced to call to new functions. + (match_namelist_name): Simplified. + (nml_query): Handles stdin queries ? and =?. New function. + (nml_get_obj_data): Parses object name. New function. + (touch_nml_nodes): Marks objects for read. New function. + (untouch_nml_nodes): Resets objects. New function. + (parse_qualifier): Parses and checks qualifiers. New function + (nml_read_object): Reads and stores object data. New function. + (eat_separator): No new_record on '/' in namelist. + (finish_separator): No new_record on '/' in namelist. + (read_logical): Error return for namelist. + (read_integer): Error return for namelist. + (read_complex): Error return for namelist. + (read_real): Error return for namelist. + * io/lock.c (library_end): Free extended namelist_info types. + * io/transfer.c (st_set_nml_var): Modified for arrays. + (st_set_nml_var_dim): Dimension descriptors. New function. + * io/write.c (namelist_write): Reduced to call to new functions. + (nml_write_obj): Writes output for object. New function. + (write_integer): Suppress leading blanks for repeat counts. + (write_int): Suppress leading blanks for repeat counts. + (write_float): Suppress leading blanks for repeat counts. + (output_float): Suppress leading blanks for repeat counts. + +2005-04-15 Thomas Koenig + + PR libfortran/18495 + * intrinsics/spread_generic.c (spread): Remove const from + return array descriptor. + New variables: rrank (rank of return array), rs (for + calculating the size of the return array), srank (rank + of the source array). + Generate runtime error if the dim= argument is larger than + the rank of the return array. + Generate runtime error if the needed rank of the return + array is larger than 7. + If ret->data is null, populate the return array descriptor + and initialize the variables for the actual operation. + Otherwise, set ret->dim[0].stride to one if it is zero. + Change second, independent use of variable dim to srank. + +2005-04-12 Mike Stump + + * configure: Regenerate. + +2005-04-13 Thomas Koenig + + PR libfortran/19106 + * m4/iforeach.c (name`'rtype_qual`_'atype_code): Add TODO + that setting correct strides is a front end job. + (`m'name`'rtype_qual`_'atype_code): Likewise. If mask has + a lowest stride of 0, adjust to 1. + * m4/ifunction.c (name`'rtype_qual`_'atype_code): Add TODO + that setting correct strides is a front end job. + (`m'name`'rtype_qual`_'atype_code): Likewise. If mask has + a lowest stride of 0, adjust to 1. + * maxloc0_4_i4.c: Regenerated + * maxloc0_4_i8.c: Regenerated + * maxloc0_4_r4.c: Regenerated + * maxloc0_4_r8.c: Regenerated + * maxloc0_8_i4.c: Regenerated + * maxloc0_8_i8.c: Regenerated + * maxloc0_8_r4.c: Regenerated + * maxloc0_8_r8.c: Regenerated + * maxloc1_4_i4.c: Regenerated + * maxloc1_4_i8.c: Regenerated + * maxloc1_4_r4.c: Regenerated + * maxloc1_4_r8.c: Regenerated + * maxloc1_8_i4.c: Regenerated + * maxloc1_8_i8.c: Regenerated + * maxloc1_8_r4.c: Regenerated + * maxloc1_8_r8.c: Regenerated + * maxval_i4.c: Regenerated + * maxval_i8.c: Regenerated + * maxval_r4.c: Regenerated + * maxval_r8.c: Regenerated + * minloc0_4_i4.c: Regenerated + * minloc0_4_i8.c: Regenerated + * minloc0_4_r4.c: Regenerated + * minloc0_4_r8.c: Regenerated + * minloc0_8_i4.c: Regenerated + * minloc0_8_i8.c: Regenerated + * minloc0_8_r4.c: Regenerated + * minloc0_8_r8.c: Regenerated + * minloc1_4_i4.c: Regenerated + * minloc1_4_i8.c: Regenerated + * minloc1_4_r4.c: Regenerated + * minloc1_4_r8.c: Regenerated + * minloc1_8_i4.c: Regenerated + * minloc1_8_i8.c: Regenerated + * minloc1_8_r4.c: Regenerated + * minloc1_8_r8.c: Regenerated + * minval_i4.c: Regenerated + * minval_i8.c: Regenerated + * minval_r4.c: Regenerated + * minval_r8.c: Regenerated + * product_c4.c: Regenerated + * product_c8.c: Regenerated + * product_i4.c: Regenerated + * product_i8.c: Regenerated + * product_r4.c: Regenerated + * product_r8.c: Regenerated + * sum_c4.c: Regenerated + * sum_c8.c: Regenerated + * sum_i4.c: Regenerated + * sum_i8.c: Regenerated + * sum_r4.c: Regenerated + * sum_r8.c: Regenerated + +2005-04-10 Francois-Xavier Coudert + + PR libfortran/20788 + * runtime/environ.c (init_unsigned_integer): Function for + environment variables we want to be positive. + (init_integer): Function to allow negative environment + variables (e.g. for GFORTRAN_STDIN_UNIT). + +2005-04-10 Thomas Koenig + + PR libfortran/17992 + PR libfortran/19568 + PR libfortran/19595 + PR libfortran/20005 + PR libfortran/20092 + PR libfortran/20131 + PR libfortran/20661 + PR libfortran/20744 + * io/transfer.c (top level): eor_condition: New static variable. + (read_sf): Remove unnecessary zeroing of buffer (there is enough + information in its length). + Return a string of length 0 (to be padded by caller) if EOR was + seen previously. + Remove erroneous special casing of EOR for standard input. + Set eor_condition for non-advancing I/O if an end of line was + detected. + Increment ioparm.size if necessary. + (formatted_transfer): Skip the function if there is an EOR condition. + (data_transfer_init): Initialize eor_condition to zero (false). + (next_record_r): Clear sf_seen_eor if a \n has been seen already. + (finalize_transfer): If there is an EOR condition, raise the error. + +2005-04-09 Bud Davis + Steven G. Kargl + + PR fortran/19872 + * io/transfer.c (data_transfer_init): truncate an existing + file on the first write. + +2005-04-09 Thomas Koenig + + PR libfortran/19106 + PR libfortran/19014 + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): ditto. + If retarray->data is NULL (i.e. the front end does not + know the rank and dimenson of the array), fill in its + properties and allocate memory. + Change the assertions about rank and dimension of retarray into + runtime errors and only check them for retarray->data != NULL. + Do the same for correcting the stride from 0 to 1 in retarray. + (`m'name`'rtype_qual`_'atype_code): Likewise. + * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise. + Change assertion about rank of array to runtime error. + (`m'name`'rtype_qual`_'atype_code): Likewise. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_4_l4.c: Regenerated. + * generated/count_4_l8.c: Regenerated. + * generated/count_8_l4.c: Regenerated. + * generated/count_8_l8.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2005-04-09 Thomas Koenig + + PR libfortran/20163 + * runtime/string.c (compare0): Use fstrlen() to + strip trailing blanks from option string. + +2005-04-09 Andrew Pinski + + PR fortran/13257 + * format.c (parse_format_list): Allow an optional comma + between descriptors. + +2005-04-08 Eric Botcazou + + * io/backspace.c (unformatted_backspace): Do not dereference + the pointer to the stream. + +2005-04-07 Andrew Pinski + + PR libfortran/20766 + * configure.ac (extra_ldflags_libgfortran): Set for *-darwin* to + "-Wl,-single_module". + * configure: Regenerate. + * Makefile.am (libgfortran_la_LDFLAGS): Add extra_ldflags_libgfortran. + * Makefile.in: Regenerate. + +2005-04-05 Francois-Xavier Coudert + + PR libfortran/20755 + * write.c (write_float): A G edit descriptor may locally change + the scale factor, but it needs to be restored afterwards. + +2005-04-03 Dale Ranta + Francois-Xavier Coudert + + PR libfortran/20068 + PR libfortran/20125 + PR libfortran/20156 + PR libfortran/20471 + * io/backspace.c (unformatted_backspace): Fix error in arithmetic. + (st_backspace): When in WRITING mode, we flush and falling back + into READING mode. In all cases, correctly position the stream. + +2005-03-31 Francois-Xavier Coudert + + PR libfortran/20660 + * io/inquire.c (inquire_via_unit): Non-opened units should still be + reported by an INQUIRE statement as existing. + * io/transfer.c (data_transfer_init): Never accept negative units. + +2005-03-29 Dale Ranta + Francois-Xavier Coudert + + PR libfortran/20163 + * io/open.c (st_open): call library_end() before returning even if + an error arises. + +2005-03-25 Francois-Xavier Coudert + + PR libfortran/19678 + * list_read.c (next_char, eat_separator, finish_separator, read_real) + (namelist_read): Add support for '\r' as well as '\n' as EOL + character. + + PR libfortran/19679 + * list_read.c (read_sf): Add a '\r' in a test to support DOS + line-endings when line length is exceeded. + +2005-03-25 Francois-Xavier Coudert + + PR libfortran/15332 + * io/format.c (parse_format_list): format node for colon edit + descriptor needs a repeat counter set to 1. + +2005-02-24 Francois-Xavier Coudert + + * config.h.in: Regenerate. + +2005-02-23 Francois-Xavier Coudert + + PR libfortran/18025 + * write.c (output_float): Handling the "F0.d" format similarly as + commercial compilers. + +2005-03-22 Francois-Xavier Coudert + + * Makefile.am: Added new files. + * Makefile.in: Regenerate. + * aclocal.m4: Regenerate. + * configure.ac: add checks for signal.h headers file, as well as + following functions: chdir, strerror, getlogin, gethostname, kill, + link, symlink, perror, sleep, time. + * configure: Regenerate. + * intrinsics/chdir.c, intrinsics/gerror.c, intrinsics/getlog.c, + intrinsics/hostnm.c, intrinsics/ierrno.c, intrinsics/kill.c, + intrinsics/link.c, intrinsics/perror.c, intrinsics/rename.c, + intrinsics/sleep.c, intrinsics/symlnk.c, intrinsics/time.c: Newly + implementend g77 intrinsics. + +2005-03-21 Zack Weinberg + + * configure.ac: Do not invoke TL_AC_GCC_VERSION. + In all substitutions, leave gcc_version to be expanded by the Makefile. + * aclocal.m4, configure: Regenerate. + * Makefile.am: Set gcc_version. + * Makefile.in: Regenerate. + +2005-03-16 Francois-Xavier Coudert + + PR libfortran/20257 + * open.c (new_unit): set record length to max_offset rather than + using a hard-coded limit (which was too low). + +2005-03-16 Francois-Xavier Coudert + + PR libfortran/20480 + * write.c (output_float): special check when writing 0.0 with + EN and ES formats. + +2005-03-11 Francois-Xavier Coudert + + PR libfortran/20124 + * write.c (output_float): Adds a nzero_real variable to store + the number of leading zeros whatever the format width is. Corrects + the rounding of numbers less than 10^(-width). Fixes typo in an + error message. Updates copyright years + +2005-02-27 Toon Moene + + * runtime/environ.c: Update copyright years. + +2005-02-27 Tobias Schl"uter + + * io/write.c: Update copyright years. + +2005-02-27 Francois-Xavier Coudert + + PR libfortran/20101 + * io/write.c (output_float): Added special check for value 0.0 in + PE format. + +2005-02-27 Tobias Schl"uter + + * io/write.c (output_float): Fix typo in condition. + +2005-02-25 Peter O'Gorman + Toon Moene + + PR libfortran/17748 + * runtime/environ.c: Remove references to environ. + (show_variables): remove GFORTRAN_UNBUFFERED_* and + GFORTRAN_NAME_* because they require environ. + (pattern_scan): Remove function. + +2005-02-22 Paul Thomas + Bud Davis + + * io/list_read.c (read_real): Handle separators properly + in list directed read. + +2005-02-21 Bud Davis + + PR fortran/20086 + * io/transfer.c (write_constant_string): accept an 'h' as + the start of a hollerith format string. + +2005-02-21 Eric Botcazou + + PR libfortran/19302 + * intrinsics/c99_functions.c (nextafterf): Special-case infinite + numbers. + +2005-02-21 Steven G. Kargl + + * io/write.c (output_float): Typo in error meesage. + +2005-02-20 Steven G. Kargl + + PR 20085 + * intrinsic/args.c (iargc): Off by 1. + +2005-02-19 Steven G. Kargl + + * intrinsic/date_and_time.c: Fix conformance problems. + +2005-02-01 Paul Thomas + + PR libfortran/19363 + PR libfortran/19691 + * libgfortran.h (isfinite): Work around broken isfinite(x) in Cygwin. + +2005-01-30 Bud Davis + + PR fortran/19647 + * io/inquire.c (inquire_via_unit): Use correct variable for + pad. + +2005-01-29 Thomas Koenig + + PR libfortran/19595 + * io/transfer.c (data_transfer_init): eor requires advance="NO". + +2005-01-25 Tobias Schl"uter + + PR libfortran/19524 + * io/read.c (read_f): Don't free uninitialized pointer. + +2005-01-23 James A. Morrison + Paul Brook + + PR fortran/19294 + * Makefile.am: Add transpose_c4.c and transpose_c8.c. + * intrinsics/cshift0.c: Use separate optimized loops for complex types. + * m4/transpose.m4: Include type letter in function name. + * Makefile.in: Regenerate. + * generated/transpose_*.c: Regenerate. + +2005-01-22 Thomas Koenig + + PR libfortran/19451 + * io/transfer.c (finalize_transfer): Don't do anything if + there is an error condition. + +2005-01-22 David Edelsohn + + PR libfortran/19052 + * libgfortran.h (options_t): Add stderr_unit. + * io/io.h (error_stream): Declare. + * io/open.c (new_unit): Do not terminate abnormally if opening + file preconnected to stdin, stdout, or stderr. + * io/unit.c (init_units): Initialize stderr_unit. + * io/unix.c (error_stream): New function. + * runtime/environ.c (GFORTRAN_STDERR_UNIT): New environment variable. + +2005-01-22 Thomas Koenig + + PR libfortran/18982 + * io/unix.c (regular_file): No need to change flags->action + if an error occurs. Document this. + No need to call stat() for STATUS_OLD, open() will + fail anyway. + For ACTION_UNSPECIFIED, try open for read-write, then for + read-only if open fails with EACCES, then for write-only + if that fails with EACCES again. + * io/unix.c (open_external): Document changed behavior of + regular_file. + +2005-01-22 Tobias Schl"uter + + PR fortran/19194 + * io/io.h (st_parameter): Use 'GFC_INTEGER_4' instead of 'int', + use CHARACTER macro for definition of string valued paramters. + +2005-01-22 Bud Davis + + PR fortran/19314 + * io/inquire.c(inquire_via_unit): implement POSITION=. + * io/transfer.c(next_record): update position for + INQUIRE. + * io/rewind.c(st_rewind): update position for + INQUIRE. + +2005-01-16 Bud Davis + + PR fortran/18778 + * io/transfer.c (us_read): no bytes available is not a + runtime error. + +2005-01-15 Bud Davis + + PR fortran/18983 + * io/transfer.c (st_write_done): only truncate when it + is required. + +2005-01-12 Toon Moene + + PR libfortran/19280 + c99_protos.h: License changed to GPL+exception. + libgfortran.h: Ditto. + intrinsics/abort.c: Ditto. + intrinsics/args.c: Ditto. + intrinsics/associated.c: Ditto. + intrinsics/bessel.c: Ditto. + intrinsics/c99_functions.c: Ditto. + intrinsics/cpu_time.c: Ditto. + intrinsics/cshift0.c: Ditto. + intrinsics/date_and_time.c: Ditto. + intrinsics/env.c: Ditto. + intrinsics/eoshift0.c: Ditto. + intrinsics/eoshift2.c: Ditto. + intrinsics/erf.c: Ditto. + intrinsics/etime.c: Ditto. + intrinsics/exit.c: Ditto. + intrinsics/flush.c: Ditto. + intrinsics/fnum.c: Ditto. + intrinsics/getXid.c: Ditto. + intrinsics/getcwd.c: Ditto. + intrinsics/ishftc.c: Ditto. + intrinsics/mvbits.c: Ditto. + intrinsics/pack_generic.c: Ditto. + intrinsics/rand.c: Ditto. + intrinsics/random.c: Ditto. + intrinsics/reshape_generic.c: Ditto. + intrinsics/reshape_packed.c: Ditto. + intrinsics/size.c: Ditto. + intrinsics/spread_generic.c: Ditto. + intrinsics/stat.c: Ditto. + intrinsics/string_intrinsics.c: Ditto. + intrinsics/system.c: Ditto. + intrinsics/system_clock.c: Ditto. + intrinsics/transpose_generic.c: Ditto. + intrinsics/umask.c: Ditto. + intrinsics/unlink.c: Ditto. + intrinsics/unpack_generic.c: Ditto. + io/backspace.c: Ditto. + io/close.c: Ditto. + io/endfile.c: Ditto. + io/format.c: Ditto. + io/inquire.c: Ditto. + io/io.h: Ditto. + io/list_read.c: Ditto. + io/lock.c: Ditto. + io/open.c: Ditto. + io/read.c: Ditto. + io/rewind.c: Ditto. + io/transfer.c: Ditto. + io/unit.c: Ditto. + io/unix.c: Ditto. + io/write.c: Ditto. + m4/all.m4: Ditto. + m4/any.m4: Ditto. + m4/cexp.m4: Ditto. + m4/chyp.m4: Ditto. + m4/count.m4: Ditto. + m4/cshift1.m4: Ditto. + m4/ctrig.m4: Ditto. + m4/dotprod.m4: Ditto. + m4/dotprodc.m4: Ditto. + m4/dotprodl.m4: Ditto. + m4/eoshift1.m4: Ditto. + m4/eoshift3.m4: Ditto. + m4/exponent.m4: Ditto. + m4/fraction.m4: Ditto. + m4/head.m4: Ditto. + m4/iforeach.m4: Ditto. + m4/ifunction.m4: Ditto. + m4/in_pack.m4: Ditto. + m4/in_unpack.m4: Ditto. + m4/iparm.m4: Ditto. + m4/matmul.m4: Ditto. + m4/matmull.m4: Ditto. + m4/maxloc0.m4: Ditto. + m4/maxloc1.m4: Ditto. + m4/maxval.m4: Ditto. + m4/minloc0.m4: Ditto. + m4/minloc1.m4: Ditto. + m4/minval.m4: Ditto. + m4/mtype.m4: Ditto. + m4/nearest.m4: Ditto. + m4/pow.m4: Ditto. + m4/product.m4: Ditto. + m4/reshape.m4: Ditto. + m4/set_exponent.m4: Ditto. + m4/shape.m4: Ditto. + m4/specific.m4: Ditto. + m4/specific2.m4: Ditto. + m4/sum.m4: Ditto. + m4/transpose.m4: Ditto. + m4/types.m4: Ditto. + runtime/environ.c: Ditto. + runtime/error.c: Ditto. + runtime/in_pack_generic.c: Ditto. + runtime/in_unpack_generic.c: Ditto. + runtime/main.c: Ditto. + runtime/memory.c: Ditto. + runtime/normalize.c: Ditto. + runtime/pause.c: Ditto. + runtime/select.c: Ditto. + runtime/stop.c: Ditto. + runtime/string.c: Ditto. + generated/_abs_c4.f90: Regenerated. + generated/_abs_c8.f90: Regenerated. + generated/_abs_i4.f90: Regenerated. + generated/_abs_i8.f90: Regenerated. + generated/_abs_r4.f90: Regenerated. + generated/_abs_r8.f90: Regenerated. + generated/_acos_r4.f90: Regenerated. + generated/_acos_r8.f90: Regenerated. + generated/_aint_r4.f90: Regenerated. + generated/_aint_r8.f90: Regenerated. + generated/_anint_r4.f90: Regenerated. + generated/_anint_r8.f90: Regenerated. + generated/_asin_r4.f90: Regenerated. + generated/_asin_r8.f90: Regenerated. + generated/_atan2_r4.f90: Regenerated. + generated/_atan2_r8.f90: Regenerated. + generated/_atan_r4.f90: Regenerated. + generated/_atan_r8.f90: Regenerated. + generated/_conjg_c4.f90: Regenerated. + generated/_conjg_c8.f90: Regenerated. + generated/_cos_c4.f90: Regenerated. + generated/_cos_c8.f90: Regenerated. + generated/_cos_r4.f90: Regenerated. + generated/_cos_r8.f90: Regenerated. + generated/_cosh_r4.f90: Regenerated. + generated/_cosh_r8.f90: Regenerated. + generated/_dim_i4.f90: Regenerated. + generated/_dim_i8.f90: Regenerated. + generated/_dim_r4.f90: Regenerated. + generated/_dim_r8.f90: Regenerated. + generated/_exp_c4.f90: Regenerated. + generated/_exp_c8.f90: Regenerated. + generated/_exp_r4.f90: Regenerated. + generated/_exp_r8.f90: Regenerated. + generated/_log10_r4.f90: Regenerated. + generated/_log10_r8.f90: Regenerated. + generated/_log_c4.f90: Regenerated. + generated/_log_c8.f90: Regenerated. + generated/_log_r4.f90: Regenerated. + generated/_log_r8.f90: Regenerated. + generated/_mod_i4.f90: Regenerated. + generated/_mod_i8.f90: Regenerated. + generated/_mod_r4.f90: Regenerated. + generated/_mod_r8.f90: Regenerated. + generated/_sign_i4.f90: Regenerated. + generated/_sign_i8.f90: Regenerated. + generated/_sign_r4.f90: Regenerated. + generated/_sign_r8.f90: Regenerated. + generated/_sin_c4.f90: Regenerated. + generated/_sin_c8.f90: Regenerated. + generated/_sin_r4.f90: Regenerated. + generated/_sin_r8.f90: Regenerated. + generated/_sinh_r4.f90: Regenerated. + generated/_sinh_r8.f90: Regenerated. + generated/_sqrt_c4.f90: Regenerated. + generated/_sqrt_c8.f90: Regenerated. + generated/_sqrt_r4.f90: Regenerated. + generated/_sqrt_r8.f90: Regenerated. + generated/_tan_r4.f90: Regenerated. + generated/_tan_r8.f90: Regenerated. + generated/_tanh_r4.f90: Regenerated. + generated/_tanh_r8.f90: Regenerated. + generated/all_l4.c: Regenerated. + generated/all_l8.c: Regenerated. + generated/any_l4.c: Regenerated. + generated/any_l8.c: Regenerated. + generated/count_4_l4.c: Regenerated. + generated/count_4_l8.c: Regenerated. + generated/count_8_l4.c: Regenerated. + generated/count_8_l8.c: Regenerated. + generated/cshift1_4.c: Regenerated. + generated/cshift1_8.c: Regenerated. + generated/dotprod_c4.c: Regenerated. + generated/dotprod_c8.c: Regenerated. + generated/dotprod_i4.c: Regenerated. + generated/dotprod_i8.c: Regenerated. + generated/dotprod_l4.c: Regenerated. + generated/dotprod_l8.c: Regenerated. + generated/dotprod_r4.c: Regenerated. + generated/dotprod_r8.c: Regenerated. + generated/eoshift1_4.c: Regenerated. + generated/eoshift1_8.c: Regenerated. + generated/eoshift3_4.c: Regenerated. + generated/eoshift3_8.c: Regenerated. + generated/exp_c4.c: Regenerated. + generated/exp_c8.c: Regenerated. + generated/exponent_r4.c: Regenerated. + generated/exponent_r8.c: Regenerated. + generated/fraction_r4.c: Regenerated. + generated/fraction_r8.c: Regenerated. + generated/hyp_c4.c: Regenerated. + generated/hyp_c8.c: Regenerated. + generated/in_pack_i4.c: Regenerated. + generated/in_pack_i8.c: Regenerated. + generated/in_unpack_i4.c: Regenerated. + generated/in_unpack_i8.c: Regenerated. + generated/matmul_c4.c: Regenerated. + generated/matmul_c8.c: Regenerated. + generated/matmul_i4.c: Regenerated. + generated/matmul_i8.c: Regenerated. + generated/matmul_l4.c: Regenerated. + generated/matmul_l8.c: Regenerated. + generated/matmul_r4.c: Regenerated. + generated/matmul_r8.c: Regenerated. + generated/maxloc0_4_i4.c: Regenerated. + generated/maxloc0_4_i8.c: Regenerated. + generated/maxloc0_4_r4.c: Regenerated. + generated/maxloc0_4_r8.c: Regenerated. + generated/maxloc0_8_i4.c: Regenerated. + generated/maxloc0_8_i8.c: Regenerated. + generated/maxloc0_8_r4.c: Regenerated. + generated/maxloc0_8_r8.c: Regenerated. + generated/maxloc1_4_i4.c: Regenerated. + generated/maxloc1_4_i8.c: Regenerated. + generated/maxloc1_4_r4.c: Regenerated. + generated/maxloc1_4_r8.c: Regenerated. + generated/maxloc1_8_i4.c: Regenerated. + generated/maxloc1_8_i8.c: Regenerated. + generated/maxloc1_8_r4.c: Regenerated. + generated/maxloc1_8_r8.c: Regenerated. + generated/maxval_i4.c: Regenerated. + generated/maxval_i8.c: Regenerated. + generated/maxval_r4.c: Regenerated. + generated/maxval_r8.c: Regenerated. + generated/minloc0_4_i4.c: Regenerated. + generated/minloc0_4_i8.c: Regenerated. + generated/minloc0_4_r4.c: Regenerated. + generated/minloc0_4_r8.c: Regenerated. + generated/minloc0_8_i4.c: Regenerated. + generated/minloc0_8_i8.c: Regenerated. + generated/minloc0_8_r4.c: Regenerated. + generated/minloc0_8_r8.c: Regenerated. + generated/minloc1_4_i4.c: Regenerated. + generated/minloc1_4_i8.c: Regenerated. + generated/minloc1_4_r4.c: Regenerated. + generated/minloc1_4_r8.c: Regenerated. + generated/minloc1_8_i4.c: Regenerated. + generated/minloc1_8_i8.c: Regenerated. + generated/minloc1_8_r4.c: Regenerated. + generated/minloc1_8_r8.c: Regenerated. + generated/minval_i4.c: Regenerated. + generated/minval_i8.c: Regenerated. + generated/minval_r4.c: Regenerated. + generated/minval_r8.c: Regenerated. + generated/nearest_r4.c: Regenerated. + generated/nearest_r8.c: Regenerated. + generated/pow_c4_i4.c: Regenerated. + generated/pow_c4_i8.c: Regenerated. + generated/pow_c8_i4.c: Regenerated. + generated/pow_c8_i8.c: Regenerated. + generated/pow_i4_i4.c: Regenerated. + generated/pow_i4_i8.c: Regenerated. + generated/pow_i8_i4.c: Regenerated. + generated/pow_i8_i8.c: Regenerated. + generated/pow_r4_i4.c: Regenerated. + generated/pow_r4_i8.c: Regenerated. + generated/pow_r8_i4.c: Regenerated. + generated/pow_r8_i8.c: Regenerated. + generated/product_c4.c: Regenerated. + generated/product_c8.c: Regenerated. + generated/product_i4.c: Regenerated. + generated/product_i8.c: Regenerated. + generated/product_r4.c: Regenerated. + generated/product_r8.c: Regenerated. + generated/reshape_i4.c: Regenerated. + generated/reshape_i8.c: Regenerated. + generated/set_exponent_r4.c: Regenerated. + generated/set_exponent_r8.c: Regenerated. + generated/shape_i4.c: Regenerated. + generated/shape_i8.c: Regenerated. + generated/sum_c4.c: Regenerated. + generated/sum_c8.c: Regenerated. + generated/sum_i4.c: Regenerated. + generated/sum_i8.c: Regenerated. + generated/sum_r4.c: Regenerated. + generated/sum_r8.c: Regenerated. + generated/transpose_i4.c: Regenerated. + generated/transpose_i8.c: Regenerated. + generated/trig_c4.c: Regenerated. + generated/trig_c8.c: Regenerated. + +2005-01-07 Bud Davis + + PR fortran/18398 + * transfer.c (next_record_r): always skip the + eol search if it was found during sf_read. + + +Copyright (C) 2005 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/libgfortran/ChangeLog-2006 b/libgfortran/ChangeLog-2006 new file mode 100644 index 000000000..5c8dfef25 --- /dev/null +++ b/libgfortran/ChangeLog-2006 @@ -0,0 +1,1641 @@ +2006-12-30 Thomas Koenig + + PR libfortran/30321 + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): + Check for extents < 0 for zero-sized arrays. If + no retarray has been specified and the size is zero, + return early. + (`m'name`'rtype_qual`_'atype_code): Likewise. + * generated/all_l16.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_16_l16.c: Regenerated. + * generated/count_16_l4.c: Regenerated. + * generated/count_16_l8.c: Regenerated. + * generated/count_4_l16.c: Regenerated. + * generated/count_4_l4.c: Regenerated. + * generated/count_4_l8.c: Regenerated. + * generated/count_8_l16.c: Regenerated. + * generated/count_8_l4.c: Regenerated. + * generated/count_8_l8.c: Regenerated. + * generated/cshift1_16.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2006-12-27 Jerry DeLisle + + PR libfortran/30014 + *io/io.h (st_parameter_dt): Change *size and *iolength type to + GFC_IO_INT. + *io/transfer.c (finalize_transfer): Cast dtp->u.p.size_used to + GFC_IO_INT. (iolength_transfer): Cast size * nelems to GFC_IO_INT. + +2006-12-17 Tobias Burnus + + * intrinsics/associated.c: Check for associated(NULL,NULL). + +2006-12-15 Jerry DeLisle + + PR libfortran/30145 + * io/transfer.c (transfer_array): Check for negative extent. + +2006-12-13 Richard Guenther + + PR fortran/30115 + * runtime/memory.c (allocate_size): Change interface to + void *()(size_t, GFC_INTEGER_4 *). + (allocate): Likewise. + (allocate64): Likewise. + (allocate_array): Change interface to + void *()(void *, size_t, GFC_INTEGER_4 *). + (allocate64_array): Likewise. + (deallocate): Change interface to + void ()(void *, GFC_INTEGER_4 *). + +2006-12-06 Francois-Xavier Coudert + + PR libfortran/29810 + * intrinsics/c99_functions.c (fmodf, fmodl, floorl): New functions. + * c99_protos.h (fmodf, fmodl, floorl): New prototypes. + * configure.ac: Check for fmodf, fmod and fmodl. + * configure: Regenerate. + * config.h.in: Regenerate. + +2006-12-06 Thomas Koenig + + PR libfortran/30009 + PR libfortran/30056 + * libgfortran.h: Add ERROR_CORRUPT_FILE to error_codes. + * runtime/error.c (translate_error): Add handling for + ERROR_CORRUPT_FILE. + * io/transfer.c (read_block_direct): Add comment about + EOR for stream files. + Remove test for no bytes left for direct access files. + Generate an ERROR_SHORT_RECORD if the read was short. + For unformatted sequential files: Check endfile condition. + Remove test for no bytes left. End of file here means + that the file structure has been corrupted. Pre-position + the file for the next record in case of error. + (write_buf): Whitespace fix. Subtract the number of bytes + written from bytes_left. + +2006-12-04 Jerry DeLisle + + PR libfortran/30005 + * io/open.c: Add errno.h include. + (new_unit): Add new error messages with file name for file open. + +2006-12-01 Thomas Koenig + + PR libfortran/29568 + * libgfortran/libgfortran.h (compile_options_t): Add + record_marker. (top level): Define GFC_MAX_SUBRECORD_LENGTH. + * runtime/compile_options.c (set_record_marker): Change + default to four-byte record marker. + (set_max_subrecord_length): New function. + * runtime/error.c (translate_error): Change error message + for short record on unformatted read. + * io/io.h (gfc_unit): Add recl_subrecord, bytes_left_subrecord + and continued. + * io/file_pos.c (unformatted_backspace): Change default of record + marker size to four bytes. Loop over subrecords. + * io/open.c: Default recl is max_offset. If + compile_options.max_subrecord_length has been set, set set + u->recl_subrecord to its value, to the maximum value otherwise. + * io/transfer.c (top level): Add prototypes for us_read, us_write, + next_record_r_unf and next_record_w_unf. + (read_block_direct): Separate codepaths for unformatted direct + and unformatted sequential. If a recl has been set by the + user, use the number of bytes left for the record if it is smaller + than the read request. Loop over subrecords. Set an error if the + user has set a recl and the read was short. + (write_buf): Separate codepaths for unformatted direct and + unformatted sequential. If a recl has been set by the + user, use the number of bytes left for the record if it is smaller + than the read request. Loop over subrecords. Set an error if the + user has set a recl and the read was short. + (us_read): Add parameter continued (to indicate that bytes_left + should not be intialized). Change default of record marker size + to four bytes. Use subrecord. If the subrecord length is smaller than + zero, this indicates a continuation. + (us_write): Add parameter continued (to indicate that the continued + flag should be set). Use subrecord. + (pre_position): Use 0 for continued on us_write and us_read calls. + (skip_record): New function. + (next_record_r_unf): New function. + (next_record_r): Use next_record_r_unf. + (write_us_marker): Default size for record markers is four bytes. + (next_record_w_unf): New function. + (next_record_w): Use next_record_w_unf. + +2006-11-25 Francois-Xavier Coudert + + * Makefile.am: Remove intrinsics/erf.c and intrinsics/bessel.c. + * Makefile.in: Regenerate. + * intrinsics/erf.c: Remove. + * intrinsics/bessel.c: Remove. + * c99_protos.h: Add prototypes for bessel and error functions. + * intrinsics/c99_functions.c: Move content for intrinsics/erf.c + and intrinsics/bessel.c here. + +2006-11-22 Jerry DeLisle + + * io/io.h (unit_flags): Add new flag has_recl. + * io.open.c (new_unit): Set flag if RECL= was specified. + * io/transfer.c (us_write): If flag set, leave recl as initialized by + new_unit. + +2006-11-16 Francois-Xavier Coudert + + * io/open.c (new_unit): Format %d expects an int variable. + * runtime/error.c (show_locus): Format %d expects an int variable. + +2006-11-08 Steven G. Kargl + + * io/read.c (max_value): Hide "int n" in an #ifdef. + +2006-11-08 Jerry DeLisle + + PR libfortran/29752 + * io/transfer.c (finalize_transfer): Flush on ADVANCE_NO. + +2006-11-05 Jerry DeLisle + + * io/transfer.c (next_record_w): Fix indentation. + +2006-11-04 Jerry DeLisle + + PR libfortran/25545 + * io/transfer.c (write_block): Cleanup code paths between + stream and non-stream I/O. + (write_buf): Cleanup. + (read_block): Cleanup. + (finalize_transfer): Call next_record for '$' edit descriptor handling + of internal unit. Cleanup code for readability. + +2006-11-03 Francois-Xavier Coudert + + PR libfortran/27895 + * intrinsics/reshape_generic.c (reshape_internal): Fix so that it + works correctly for zero-sized arrays. + * m4/reshape.m4: Likewise. + * generated/reshape_r16.c: Regenerate. + * generated/reshape_c4.c: Regenerate. + * generated/reshape_i4.c: Regenerate. + * generated/reshape_c16.c: Regenerate. + * generated/reshape_r10.c: Regenerate. + * generated/reshape_r8.c: Regenerate. + * generated/reshape_c10.c: Regenerate. + * generated/reshape_c8.c: Regenerate. + * generated/reshape_i8.c: Regenerate. + * generated/reshape_i16.c: Regenerate. + * generated/reshape_r4.c: Regenerate. + +2006-10-31 Thomas Koenig + + PR libfortran/29627 + * libgfortran.h: Add ERROR_SHORT_RECORD + * runtime/error.c (translate_error): Add case + for ERROR_SHORT_RECORD. + * io/transfer.c (read_block_direct): Separate codepaths + for stream and record unformatted I/O. Remove unneeded + tests for standard input, padding and formatted I/O. + If the record is short, read in as much data as possible, + then raise the error. + +2006-10-30 Tobias Burnus + + PR fortran/29452 + * runtime/string.c (compare0): Check whether string lengths match. + +2006-10-29 Francois-Xavier Coudert + + * configure: Regenerate. + * Makefile.in: Regenerate. + * aclocal.m4: Regenerate. + +2006-10-28 Tobias Burnus + + PR fortran/29625 + * io/transfer.c (formatted_transfer_scalar): Allow binary edit + descriptors for real variables; give error for BOZ edit + descriptor for non-integers when using -std=f*. + +2006-10-26 Jerry DeLisle + + PR libfortran/29563 + * io/list_read.c (next_char): Fix an error in previous commit. + +2006-10-25 Jerry DeLisle + + PR libfortran/29563 + * io/io.h (st_parameter_dt): Add new flag at_eof. + * io/list_read.c (next_char): Set flag when EOF and return '\n' to + signal EOR. Check flag on next call and jump out. + * io/unit.c (get_internal_unit): Initialize new flag. + +2006-10-22 Francois-Xavier Coudert + + PR fortran/26025 + * m4/matmul.m4: Add possible call to gemm routine. + * generated/matmul_r8.c: Regenerate. + * generated/matmul_r16.c: Regenerate. + * generated/matmul_c8.c: Regenerate. + * generated/matmul_i8.c: Regenerate. + * generated/matmul_c16.c: Regenerate. + * generated/matmul_r10.c: Regenerate. + * generated/matmul_r4.c: Regenerate. + * generated/matmul_c10.c: Regenerate. + * generated/matmul_c4.c: Regenerate. + * generated/matmul_i4.c: Regenerate. + * generated/matmul_i16.c: Regenerate. + +2006-10-21 Steven G. Kargl + + * runtime/error.c: Add errno.h + (generate_error): Set iostat to errno on OS error. + * libgfortran.h: Set ERROR_OS to 5000 + +2006-10-20 Francois-Xavier Coudert + + * generated/minval_r8.c: Regenerate. + * generated/maxloc1_4_r8.c: Regenerate. + * generated/minloc1_16_r16.c: Regenerate. + * generated/sum_i8.c: Regenerate. + * generated/eoshift3_4.c: Regenerate. + * generated/any_l16.c: Regenerate. + * generated/eoshift1_8.c: Regenerate. + * generated/reshape_r16.c: Regenerate. + * generated/product_r4.c: Regenerate. + * generated/maxloc1_8_i4.c: Regenerate. + * generated/maxloc0_4_r4.c: Regenerate. + * generated/in_unpack_i8.c: Regenerate. + * generated/minloc0_4_r16.c: Regenerate. + * generated/reshape_c4.c: Regenerate. + * generated/maxloc0_4_r16.c: Regenerate. + * generated/minloc1_8_r16.c: Regenerate. + * generated/maxloc1_8_r16.c: Regenerate. + * generated/in_unpack_i16.c: Regenerate. + * generated/maxloc0_8_i8.c: Regenerate. + * generated/sum_r16.c: Regenerate. + * generated/minloc1_4_r8.c: Regenerate. + * generated/maxloc1_16_r16.c: Regenerate. + * generated/minloc1_16_i4.c: Regenerate. + * generated/maxloc1_16_i4.c: Regenerate. + * generated/minloc0_16_i8.c: Regenerate. + * generated/maxloc0_16_i8.c: Regenerate. + * generated/maxval_r16.c: Regenerate. + * generated/count_16_l16.c: Regenerate. + * generated/count_8_l8.c: Regenerate. + * generated/product_c10.c: Regenerate. + * generated/minloc1_8_i4.c: Regenerate. + * generated/minloc0_16_i16.c: Regenerate. + * generated/eoshift1_16.c: Regenerate. + * generated/minloc0_4_r4.c: Regenerate. + * generated/product_c4.c: Regenerate. + * generated/sum_r4.c: Regenerate. + * generated/in_pack_c16.c: Regenerate. + * generated/reshape_i4.c: Regenerate. + * generated/minloc0_8_i8.c: Regenerate. + * generated/minloc1_16_r10.c: Regenerate. + * generated/in_pack_c4.c: Regenerate. + * generated/all_l16.c: Regenerate. + * generated/reshape_c16.c: Regenerate. + * generated/maxloc1_8_r8.c: Regenerate. + * generated/minval_i16.c: Regenerate. + * generated/reshape_r10.c: Regenerate. + * generated/maxval_i4.c: Regenerate. + * generated/any_l4.c: Regenerate. + * generated/minval_i8.c: Regenerate. + * generated/maxloc1_4_i8.c: Regenerate. + * generated/maxloc0_16_i16.c: Regenerate. + * generated/maxloc0_8_r4.c: Regenerate. + * generated/minloc1_4_i16.c: Regenerate. + * generated/minloc0_4_r10.c: Regenerate. + * generated/maxloc1_4_i16.c: Regenerate. + * generated/minloc0_8_i16.c: Regenerate. + * generated/maxloc0_4_r10.c: Regenerate. + * generated/maxloc0_8_i16.c: Regenerate. + * generated/minloc1_8_r10.c: Regenerate. + * generated/product_i4.c: Regenerate. + * generated/minloc0_16_r4.c: Regenerate. + * generated/sum_c16.c: Regenerate. + * generated/maxloc1_8_r10.c: Regenerate. + * generated/maxloc0_16_r4.c: Regenerate. + * generated/minloc1_16_r8.c: Regenerate. + * generated/maxloc0_4_i4.c: Regenerate. + * generated/maxloc1_16_r8.c: Regenerate. + * generated/cshift1_4.c: Regenerate. + * generated/sum_r10.c: Regenerate. + * generated/sum_c4.c: Regenerate. + * generated/maxloc1_16_r10.c: Regenerate. + * generated/count_4_l16.c: Regenerate. + * generated/in_pack_i4.c: Regenerate. + * generated/minloc1_8_r8.c: Regenerate. + * generated/count_4_l4.c: Regenerate. + * generated/maxval_r10.c: Regenerate. + * generated/minloc1_4_i8.c: Regenerate. + * generated/in_unpack_c4.c: Regenerate. + * generated/minloc0_8_r4.c: Regenerate. + * generated/product_i16.c: Regenerate. + * generated/minloc0_16_r16.c: Regenerate. + * generated/reshape_r8.c: Regenerate. + * generated/all_l4.c: Regenerate. + * generated/in_pack_c10.c: Regenerate. + * generated/minloc0_4_i4.c: Regenerate. + * generated/reshape_c10.c: Regenerate. + * generated/minval_r4.c: Regenerate. + * generated/maxloc1_4_r4.c: Regenerate. + * generated/sum_i4.c: Regenerate. + * generated/count_16_l8.c: Regenerate. + * generated/maxval_r8.c: Regenerate. + * generated/eoshift1_4.c: Regenerate. + * generated/eoshift3_8.c: Regenerate. + * generated/minval_r16.c: Regenerate. + * generated/product_r8.c: Regenerate. + * generated/maxloc1_8_i8.c: Regenerate. + * generated/maxloc0_4_r8.c: Regenerate. + * generated/maxloc0_16_r16.c: Regenerate. + * generated/in_unpack_i4.c: Regenerate. + * generated/sum_c10.c: Regenerate. + * generated/minloc1_4_r16.c: Regenerate. + * generated/maxloc1_4_r16.c: Regenerate. + * generated/in_unpack_c16.c: Regenerate. + * generated/minloc0_8_r16.c: Regenerate. + * generated/reshape_c8.c: Regenerate. + * generated/maxloc0_8_r16.c: Regenerate. + * generated/maxloc0_8_i4.c: Regenerate. + * generated/minloc1_4_r4.c: Regenerate. + * generated/minloc0_16_i4.c: Regenerate. + * generated/maxloc0_16_i4.c: Regenerate. + * generated/minloc1_16_i8.c: Regenerate. + * generated/maxloc1_16_i8.c: Regenerate. + * generated/count_8_l4.c: Regenerate. + * generated/minloc0_16_r10.c: Regenerate. + * generated/minloc1_8_i8.c: Regenerate. + * generated/minloc0_4_r8.c: Regenerate. + * generated/product_r16.c: Regenerate. + * generated/product_c8.c: Regenerate. + * generated/sum_r8.c: Regenerate. + * generated/in_pack_i16.c: Regenerate. + * generated/minloc0_8_i4.c: Regenerate. + * generated/minloc1_16_i16.c: Regenerate. + * generated/reshape_i8.c: Regenerate. + * generated/in_pack_c8.c: Regenerate. + * generated/maxloc1_8_r4.c: Regenerate. + * generated/reshape_i16.c: Regenerate. + * generated/minval_r10.c: Regenerate. + * generated/minval_i4.c: Regenerate. + * generated/maxloc1_4_i4.c: Regenerate. + * generated/maxval_i8.c: Regenerate. + * generated/eoshift3_16.c: Regenerate. + * generated/any_l8.c: Regenerate. + * generated/maxloc0_16_r10.c: Regenerate. + * generated/minloc0_4_i16.c: Regenerate. + * generated/maxloc0_8_r8.c: Regenerate. + * generated/maxloc0_4_i16.c: Regenerate. + * generated/minloc1_4_r10.c: Regenerate. + * generated/minloc1_8_i16.c: Regenerate. + * generated/maxloc1_4_r10.c: Regenerate. + * generated/minloc0_8_r10.c: Regenerate. + * generated/maxloc1_8_i16.c: Regenerate. + * generated/in_unpack_c10.c: Regenerate. + * generated/maxloc0_8_r10.c: Regenerate. + * generated/minloc1_16_r4.c: Regenerate. + * generated/maxloc1_16_r4.c: Regenerate. + * generated/minloc0_16_r8.c: Regenerate. + * generated/product_i8.c: Regenerate. + * generated/maxloc0_16_r8.c: Regenerate. + * generated/sum_i16.c: Regenerate. + * generated/maxloc0_4_i8.c: Regenerate. + * generated/cshift1_8.c: Regenerate. + * generated/maxloc1_16_i16.c: Regenerate. + * generated/minloc1_8_r4.c: Regenerate. + * generated/sum_c8.c: Regenerate. + * generated/count_8_l16.c: Regenerate. + * generated/in_pack_i8.c: Regenerate. + * generated/maxval_i16.c: Regenerate. + * generated/count_4_l8.c: Regenerate. + * generated/minloc1_4_i4.c: Regenerate. + * generated/product_c16.c: Regenerate. + * generated/reshape_r4.c: Regenerate. + * generated/minloc0_8_r8.c: Regenerate. + * generated/in_unpack_c8.c: Regenerate. + * generated/product_r10.c: Regenerate. + * generated/cshift1_16.c: Regenerate. + * generated/all_l8.c: Regenerate. + * generated/minloc0_4_i8.c: Regenerate. + * generated/maxval_r4.c: Regenerate. + * generated/count_16_l4.c: Regenerate. + +2006-10-19 Francois-Xavier Coudert + + PR libfortran/27895 + * intrinsics/cshift0.c: Special cases for zero-sized arrays. + * intrinsics/pack_generic.c: Likewise. + * intrinsics/spread_generic.c: Likewise. + +2006-10-18 Jerry DeLisle + + PR libfortran/29277 + * io/write.c (write_a): Add conversion of LF to CR-LF for systems with + #define HAVE_CRLF. + +2006-10-18 Tobias Burnus + + * m4/in_pack.m4: Fixed a typo. + * m4/iforeach.m4: Fixed a typo. + * m4/eoshift1.m4: Fixed a typo. + * m4/eoshift3.m4: Fixed a typo. + * m4/cshift1.m4: Fixed a typo. + * m4/in_unpack.m4: Fixed a typo. + * m4/reshape.m4: Fixed a typo. + * m4/ifunction.m4: Fixed a typo. + * runtime/environ.c: Fixed a typo. + * runtime/in_pack_generic.c: Fixed a typo. + * runtime/in_unpack_generic.c: Fixed a typo. + * runtime/memory.c: Fixed a typo. + * intrinsics/cshift0.c: Fixed a typo. + * intrinsics/cpu_time.c: Fixed a typo. + * intrinsics/pack_generic.c: Fixed a typo. + * intrinsics/unpack_generic.c: Fixed a typo. + * intrinsics/eoshift0.c: Fixed a typo. + * intrinsics/eoshift2.c: Fixed a typo. + * intrinsics/reshape_generic.c: Fixed a typo. + * io/open.c: Fixed a typo. + * io/list_read.c: Fixed a typo. + * io/io.h: Fixed a typo. + * io/transfer.c: Fixed a typo. + * io/write.c: Fixed a typo. + +2006-10-17 Jerry DeLisle + + PR libfortran/29277 + * io/list_read.c (next_char): Update strm_pos. + (eat_separator): Delete extra call to unget_char. + * io/transfer.c (read_block): Use read_sf for formatted stream I/O. + (next_record_r): Update strm_pos for formatted stream I/O and handle + end-of-record correctly. + (next_record_w): Ditto. + (next_record): Enable next record (r/w) functions and update strm_pos. + (finalize_transfer): Call next_record to finish the record. + +2006-10-13 Steven G. Kargl + + * m4/spacing.m4: Use scalbn[f,l] if ldexp[f,l] is unavailable. + * m4/rrspacing.m4: Ditto. + * generated/spacing_r4.c: Regenerated. + * generated/spacing_r8.c: Ditto. + * generated/spacing_r10.c: Ditto. + * generated/spacing_r16.c: Ditto. + * generated/rrspacing_r4.c: Ditto. + * generated/rrspacing_r8.c: Ditto. + * generated/rrspacing_r10.c: Ditto. + * generated/rrspacing_r16.c: Ditto. + +2006-10-06 Steven G. Kargl + + PR fortran/15441 + PR fortran/29312 + * configure.ac: Add HAVE_LDEXPF, HAVE_LDEXP, and HAVE_LDEXPL + * m4/spacing.m4: New file. Use new HAVE_* defines. + * m4/rrspacing.m4: Ditto. + * Makefile.am: Handle new files. + * configure: Regenerated. + * Makefile.in: Ditto. + * config.h.in: Ditto. + * generated/spacing_r4.c: Generated. + * generated/spacing_r8.c: Ditto. + * generated/spacing_r10.c: Ditto. + * generated/spacing_r16.c: Ditto. + * generated/rrspacing_r4.c: Ditto. + * generated/rrspacing_r8.c: Ditto. + * generated/rrspacing_r10.c: Ditto. + * generated/rrspacing_r16.c: Ditto. + +2006-10-08 Francois-Xavier Coudert + + * intrinsics/hyper.c: Remove file. + * intrinsics/c99_functions.c: Add fallback functions asinhf, + acoshf and atanhf. + * Makefile.am: Remove file intrinsics/hyper.c. + * Makefile.in: Regenerate. + +2006-10-08 Francois-Xavier Coudert + + * c99_protos.h: Correctly protect definitions of prototypes for + asinhf, acoshf and atanhf to be the same as in intrinsics/hyper.c. + +2006-10-08 Paul Thomas + Erik Edelmann + + PR libfortran/20541 + * Makefile.in : Add move_alloc. + * intrinsics/move_alloc.c: New function. + * Makefile.am : Add move_alloc. + +2006-10-08 Francois-Xavier Coudert + + PR libfortran/26540 + * intrinsics/signal.c (signal_sub, signal_sub_int): Use intptr_t + if available to cast function pointers to int and back. + * configure.ac: Check for intptr_t. + * config.h.in: Regenerate. + * configure: Regenerate. + +2006-10-01 Francois-Xavier Coudert + + PR fortran/16580 + PR fortran/29288 + * libgfortran/Makefile.am: Add the new files to the build + process, and rules to build them. + * libgfortran/Makefile.in: Regenerate. + * libgfortran/m4/misc_specifics.m4: New file. + * libgfortran/m4/specific.m4: Add new special cases for function + with complex argument and real result, like abs_c* and aimag_c*. + * libgfortran/intrinsics/f2c_specifics.F90: Add specifics for + AIMAG, ASINH, ACOSH and ATANH. + * libgfortran/generated/_aimag_c4.F90: New file. + * libgfortran/generated/_aimag_c8.F90: New file. + * libgfortran/generated/_asinh_r10.F90: New file. + * libgfortran/generated/_acosh_r16.F90: New file. + * libgfortran/generated/_aimag_c10.F90: New file. + * libgfortran/generated/_atanh_r16.F90: New file. + * libgfortran/generated/_acosh_r4.F90: New file. + * libgfortran/generated/_acosh_r8.F90: New file. + * libgfortran/generated/_asinh_r4.F90: New file. + * libgfortran/generated/_asinh_r8.F90: New file. + * libgfortran/generated/_asinh_r16.F90: New file. + * libgfortran/generated/_atanh_r4.F90: New file. + * libgfortran/generated/_atanh_r8.F90: New file. + * libgfortran/generated/_acosh_r10.F90: New file. + * libgfortran/generated/misc_specifics.F90: New file. + * libgfortran/generated/_aimag_c16.F90: New file. + * libgfortran/generated/_atanh_r10.F90: New file. + +2006-10-05 Danny Smith + + * acinclude.m4 (HAVE_ATTRIBUTE_ALIAS): Remove __USER_LABEL_PREFIX__ + from test. + * configure: Regenerate. + +2006-10-05 Steven G. Kargl + + * Makefile.am: Use $(M4) instead of m4. + * Makefile.in: Regenerated. + +2006-10-01 Francois-Xavier Coudert + + * libgfortran.h: Add prototype for internal_unpack_c16. + +2006-09-29 Francois-Xavier Coudert + + PR libfortran/18791 + * m4/specific.m4: Special-case cabs so that its return type is + real. Special-case conjg so that their suffices are _4, _8, _10 and + _16 instead of _c4, _c8, _c10 and _c16. + * intrinsics/f2c_specifics.F90: Special-case conjg functions so + that their suffices are _4 and _8 instead of _c4 and _c8. + * generated/_conjg_c4.F90: Regenerate. + * generated/_conjg_c8.F90: Regenerate. + * generated/_conjg_c10.F90: Regenerate. + * generated/_conjg_c16.F90: Regenerate. + * generated/_abs_c4.F90: Regenerate. + * generated/_abs_c8.F90: Regenerate. + * generated/_abs_c10.F90: Regenerate. + * generated/_abs_c16.F90: Regenerate. + +2006-09-29 Steven G. Kargl + + * intrinsics/cpu_time.c: Add cpu_time_10 and cpu_time_16 routines. + +2006-09-28 Francois-Xavier Coudert +D + * Makefile.am: Install libgfortranbegin inside compiler libraries + directory instead of system libraries directory. + * Makefile.in: Regenerate. + +2006-09-24 Francois-Xavier Coudert + + * Makefile.am: Remove dependency on gfortypes.h. + * Makefile.in: Regenerate. + +2006-09-22 Danny Smith + + PR libfortran/27964 + * configure.ac: Check for setmode() function. + * configure: Regenerate. + * config.h.in: Regenerate. + * io/unix.c (output_stream): Force stdout to binary mode. + (error_stream): Force stderr to binary mode. + +2006-09-15 Jerry DeLisle + + PR libfortran/29099 + * intrinsics/date_and_time.c (secnds): Fix case of zero time. + +2006-09-15 Jerry DeLisle + + PR libfortran/29053 + * io.h (gfc_unit): Add variable, strm_pos, to track + STREAM I/O file position. + * file_pos.c (st_rewind): Set strm_pos to beginning. + * open.c (new_unit): Initialize strm_pos. + * read.c (read_x): Bump strm_pos. + * inquire.c (inquire_via_unit): Return strm_pos value. + * transfer.c (read_block),(read_block_direct),(write_block) + (write_buf): Seek to strm_pos - 1. Update strm_pos when done. + (pre_position): Initialize strm_pos. + (data_transfer_init): Set strm_pos if DT_HAS_REC. + (finalize_transfer): Flush file, no need to update strm_pos. + +2006-09-10 Paul Thomas + + PR libfortran/28947 + * m4/matmul.m4: For the case where the second input argument is + transposed, ensure that the case with rank (a) == 1 is + correctly calculated. + * generated/matmul_r4.c: Regenerate. + * generated/matmul_r8.c: Regenerate. + * generated/matmul_r10.c: Regenerate. + * generated/matmul_r16.c: Regenerate. + * generated/matmul_c4.c: Regenerate. + * generated/matmul_c8.c: Regenerate. + * generated/matmul_c10.c: Regenerate. + * generated/matmul_c16.c: Regenerate. + * generated/matmul_i4.c: Regenerate. + * generated/matmul_i8.c: Regenerate. + * generated/matmul_i16.c: Regenerate. + +2006-08-27 Jerry DeLisle + + PR libfortran/28354 + * io/write.c: Check for special case of zero precision in format + and pre-round the real value. + +2006-08-15 Jerry DeLisle + + PR libfortran/25828 + * libgfortran.h: Rename GFC_LARGE_IO_INT to GFC_IO_INT. + * io/file_pos.c (st_backspace): Ignore if access=STREAM. + (st_rewind): Handle case of access=STREAM. + * io/open.c (access_opt): Add STREAM_ACCESS. + (edit_modes): Set current_record to zero only if not STREAM. + (new_unit): Initialize maxrec, recl, and last_record for STREAM. + * io/read.c (read_x): Advance file position for STREAM. + * io/io.h (enum unit_access): Align IOPARM flags with frontend. + Add ACCESS_STREAM. Add prototype for is_stream_io () function. + Use GFC_IO_INT. + * io/inquire.c (inquire_via_unit): Add text for access = "STREAM". + * io/unit.c (is_stream_io): New function to return true if access = + STREAM. + * io/transfer.c (file_mode): Add modes for unformatted stream and + formatted stream. (current_mode): Return appropriate file mode based + on access flags. + (read_block): Handle formatted stream reads. + (read_block_direct): Handle unformatted stream reads. + (write_block): Handle formatted stream writes. + (write_buf): Handle unformatted stream writes. + (unformatted_read): Fix up, use temporary for size. + (pre_position): Position file for STREAM access. + (data_transfer_init): Initialize for stream access, skip irrelevent + error checks. + (next_record_r),(next_record_w), and (next_record): Do nothing for + stream I/O. + (finalize_transfer): Flush when all done if stream I/O. + +2006-08-12 Francois-Xavier Coudert + + * intrinsics/bessel.c: Add prototypes for all functions. + +2006-08-05 Francois-Xavier Coudert + + * intrinsics/access.c (access_func): Remove export directive. + +2006-08-02 Thomas Koenig + + * Makefile.in: Regenerate using automake 1.9.6. + * aclocal.m4: Revert to previous version. + +2006-08-01 Thomas Koenig + + PR libfortran/28452 + * Makefile.am: Remove normalize.c. + * aclocal.m4: Regenerate using aclocal 1.9.3. + * Makefile.in: Regenerate using automake 1.9.3. + * libgfortran.h: #include . + Define GFC_REAL_*_DIGITS and GFC_REAL_*_RADIX. + Remove prototypes for normalize_r4_i4 and normalize_r8_i8. + * intrinsics/random.c (top level): Add prototypes for + random_r10, arandom_r10, random_r16 and arandom_r16. + (rnumber_4): New static function. + (rnumber_8): New static function. + (rnumber_10): New static function. + (rnumber_16): New static function. + (top level): Set to kiss_size to 12 if we have + REAL(KIND=16), to 8 otherwise. + Define KISS_DEFAULT_SEED_1, KISS_DEFAULT_SEED_2 and + KISS_DEFAULT_SEED_3. + (kiss_random_kernel): Take argument to differentiate + between different random number generators. + (random_r4): Add argument to call to kiss_random_kernel, + use rnumber_*. + (random_r8): Likewise. + (random_r10): New function. + (random_r16): New function. + (arandom_r4): Add argument to call to kiss_random_kernel, + use_rnumber_*. + (arandom_r8): Likewise. + (arandom_r10): New function. + (arandom_r16): New function. + * intrinsics/rand.c (rand): Use shift and mask. + * runtime/normalize.c: Remove. + +2006-07-30 Jerry DeLisle + + PR libfortran/28335 + * file_position.c (st_flush): Add clearer error when UNIT does not + exist. Add reference to standard in comment. + +2006-07-30 Jerry DeLisle + + PR libfortran/28335 + * close.c (st_close): Revert previous patch and add comment. + * file_position.c (st_flush): Revert previous patch and add comment. + +2006-07-30 Francois-Xavier Coudert + + * intrinsics/date_and_time.c: Add functions for GMTIME and LTIME. + * intrinsics/access.c: New file. + * intrinsics/chmod.c: New file. + * configure.ac: Add checks for , access, fork,execl + and wait. + * Makefile.am: Add new files intrinsics/access.c and + intrinsics/chmod.c. + * configure: Regenerate. + * config.h.in: Regenerate. + * Makefile.in: Regenerate. + +2006-07-30 Janne Blomqvist + + * io/transfer.c (transfer_array): Remove stride0 fix. + +2006-07-26 Francois-Xavier Coudert + + * configure.ac: Check for function clock. + * Makefile.am: Compile new file intrinsics/clock.c. + * intrinsics/clock.c: New file. + * Makefile.in: Regenerate. + * configure: Regenerate. + * config.h.in: Regenerate. + * intrinsics/stat.c: Rename the old stat_i?_sub functions to + helper functions stat_i?_sub_0, and use them for both STAT and + LSTAT. + +2006-07-25 Jerry DeLisle + + PR libfortran/28335 + * close.c (st_close): Add error when UNIT does not exist. + * file_position.c (st_flush): Add error when UNIT does not exist. + +2006-07-25 Paolo Bonzini + + PR build/26188 + * configure: Regenerate. + +2006-07-23 Jerry DeLisle + + PR libfortran/25289 + * libgfortran.h: Add conditional definition of GFC_LARGE_IO_INT type. + * io/io.h (st_parameter_dt): Define rec as type GFC_LARGE_IO_INT. + +2006-07-21 Jerry DeLisle + + PR libfortran/28339 + * io/transfer.c (next_record_w): Use next_array_record result to set + END_FILE. (write_block): Test for END_FILE before the next write occurs. + * io/unit.c (get_internal_unit): Initialize iunit->endfile for internal + unit. + +2006-07-19 Janne Blomqvist + + PR fortran/27919 + * m4/dotprodc.m4: Remove. + * m4/dotprodl.m4: Remove. + * m4/dotprod.m4: Remove. + * generated/dotprod_*.c: Remove. + * Makefile.am: Remove any references to dot_product + implementation. + * Makefile.in: Regenerated. + +2006-07-18 Paolo Bonzini + + * configure: Regenerate. + +2006-07-15 Steven G. Kargl + + * intrinsics/etime.c: Remove etime_ + * libtool-version: Bump from libgfortran.so.1 to libgfortran.so.2 + +2006-07-12 Francois-Xavier Coudert + + PR fortran/28163 + * intrinsics/string_intrinsics.c (copy_string): Remove function. + +2006-07-04 Francois-Xavier Coudert + + * intrinsics/date_and_time.c (itime0,idate0,itime_i4,itime_i8, + idate_i4,idate_i8): New functions. + +2006-07-03 Jerry DeLisle + + PR libfortran/27704 + * runtime/error.c (notify_std): Pass common flags into function. Use + flags to show locus of error or warning. + * libgfortran.h: Add enum try. Add prototype for notify_std. + * io/open.c (edit_modes): Allow status="old" and add extension to + allow status="scratch" + *io/list_read.c (nml_read_obj): Update call to notify_std. + *io/io.h: Remove enum try and prototype for notify_std. + *io/transfer.c (read_sf): Update call to notify_std. + *io/format.c (parse_format_list): Update call to notify_std. + +2006-06-25 Francois-Xavier Coudert + + * io/io.h: Move proto for unit_to_fd... + * libgfortran.h: ...here. + +2006-06-24 Francois-Xavier Coudert + + * intrinsics/ierrno.c: Don't include "io/io.h". + * intrinsics/sleep.c: Likewise. + * intrinsics/perror.c: Likewise. + * intrinsics/stat.c: Likewise. + * intrinsics/kill.c: Likewise. + * intrinsics/time.c: Likewise. + * intrinsics/fnum.c: Likewise. + * intrinsics/rename.c: Likewise. + * intrinsics/symlnk.c: Likewise. + * intrinsics/chdir.c: Likewise. + * intrinsics/link.c: Likewise. + * intrinsics/random.c: Don't include "io/io.h". Include . + * intrinsics/rand.c: Likewise. + +2006-06-24 Francois-Xavier Coudert + + PR fortran/28094 + * Makefile.am: Add _mod_r10.F90 and _mod_r16.F90. + * Makefile.in: Regenerate. + * generated/_mod_r10.F90: New file. + * generated/_mod_r16.F90: New file. + +2006-06-22 Francois-Xavier Coudert + + PR libfortran/26769 + * Makefile.am: Add r4 and r8 versions of reshape and transpose. + * Makefile.in: Regenerate. + * generated/reshape_r4.c: New file. + * generated/reshape_r8.c: New file. + * generated/transpose_r4.c: New file. + * generated/transpose_r8.c: New file. + +2006-06-20 Paul Thomas + + PR libfortran/28005 + * m4/matmul.m4: aystride = 1 does not uniquely detect the + presence of a temporary transpose; an array element in the + first dimension produces the same signature. Detect this + using the rank of a and add specific code. + * generated/matmul_r4.c: Regenerate. + * generated/matmul_r8.c: Regenerate. + * generated/matmul_r10.c: Regenerate. + * generated/matmul_r16.c: Regenerate. + * generated/matmul_c4.c: Regenerate. + * generated/matmul_c8.c: Regenerate. + * generated/matmul_c10.c: Regenerate. + * generated/matmul_c16.c: Regenerate. + * generated/matmul_i4.c: Regenerate. + * generated/matmul_i8.c: Regenerate. + * generated/matmul_i16.c: Regenerate. + +2006-06-18 John David Anglin + + PR libgomp/27254 + * io/unit.c (get_internal_unit): Initialize and lock thread mutex + for internal units. + +2006-06-06 Janne Blomqvist + + * m4/in_pack.m4: Add TODO comment about detecting temporaries, + remove test for stride 0, update copyright year. + * m4/transpose.m4: Remove test for stride 0, update copyright + year. + * m4/iforeach.m4: Likewise. + * m4/shape.m4: Likewise. + * m4/in_unpack.m4: Likewise. + * m4/reshape.m4: Likewise. + * m4/ifunction.m4: Likewise. + * m4/matmul.m4: Likewise. + * m4/matmull.m4: Likewise. + * intrinsics/etime.c: Likewise. + * intrinsics/transpose_generic.c: Likewise. + * intrinsics/spread_generic.c: Likewise. + * intrinsics/stat.c: Likewise. + * intrinsics/reshape_generic.c: Likewise. + * intrinsics/random.c: Likewise. + * generated/*: Regenerated from above changed m4 files. + +2006-05-29 Jerry DeLisle + + PR libfortran/27757 + * io/unix.c (fd_seek): Set active to zero. + +2006-05-29 Jerry DeLisle + + PR libfortran/27634 + * io/format.c (parse_format_list): Allow missing period in format only + if -std=legacy. + +2006-05-28 Thomas Koenig + + * intrinsics/string_intrinsics.c (compare_string): + Use memcmp instead of strncmp to avoid tripping over + CHAR(0) in a string. + +2006-05-27 Janne Blomqvist + + * io/io.h (find_or_create_unit): Correct export declaration. + +2006-05-27 Janne Blomqvist + + * intrinsics/abort.c (abort_): Remove. + +2006-05-26 Janne Blomqvist + + * configure.ac: Remove AC_FUNC_MMAP. + * configure: Regenerated. + * Makefile.in: Regenerated. + * config.h.in: Regenerated. + * aclocal.m4: Regenerated. + +2006-05-25 Francois-Xavier Coudert + + * intrinsics/associated.c (associated): Zero-sized arrays should + not be reported as ASSOCIATED. + +2006-05-24 Carlos O'Donell + + * Makefile.am: Add install-html target. Add install-html to .PHONY + * Makefile.in: Regenerate. + * aclocal.m4: Regenerate. + +2006-05-20 Jerry DeLisle + + PR libfortran/24459 + * io/list_read.c (nml_parse_qualifier): Leave loop spec end value + at default value unless -std=f95 or if an array section + is specified in namelist input. Warn if -pedantic. + * io/io.h (st_parameter_dt): Add expanded_read flag. + +2006-05-19 Jerry DeLisle + + PR libfortran/22423 + * io/transfer.c (read_block): Return NULL instead of nothing. + +2006-05-16 Jerry DeLisle + + PR libfortran/27575 + * io/transfer.c (read_block): Add check for end file condition. + (read_block_direct): Add check for end file condition. + +2006-05-05 Francois-Xavier Coudert + + PR libfortran/26985 + * m4/matmul.m4: Correct the condition for the memset call, + and remove the unneeded call to size0. + * generated/matmul_r4.c: Regenerate. + * generated/matmul_r8.c: Regenerate. + * generated/matmul_r10.c: Regenerate. + * generated/matmul_r16.c: Regenerate. + * generated/matmul_c4.c: Regenerate. + * generated/matmul_c8.c: Regenerate. + * generated/matmul_c10.c: Regenerate. + * generated/matmul_c16.c: Regenerate. + * generated/matmul_i4.c: Regenerate. + * generated/matmul_i8.c: Regenerate. + * generated/matmul_i16.c: Regenerate. + +2006-04-29 Jerry DeLisle + + PR libfortran/27360 + * io/list_read.c (read_logical): Free line_buffer and free saved. + +2006-04-28 Jerry DeLisle + + PR libfortran/27304 + * io/transfer.c (formatted_transfer_scalar): Generate error if data + descriptors are exhausted. + * io/format.c (next_format0): Fix comment. + +2006-04-22 Jerry DeLisle + + PR libfortran/20257 + * io/io.h: Add prototypes for get_internal_unit and free_internal_unit. + * io/unit.c (get_internal_unit): Initialize unit number, not zero. + (free_internal_unit): New function to consolidate freeing memory. + (get_unit): Initialize internal_unit_desc to NULL when unit is + external. + * io/unix.c (mem_close): Check for not NULL before freeing memory. + * io/transfer.c (read_block): Reset bytes_left and skip error if unit + is preconnected and default record length is reached. + (read_block_direct): Ditto. + (write_block): Ditto. + (write_buf): Ditto. + (data_transfer_init): Only flush if not internal unit. + (finalize_transfer): Ditto and delete code to free memory used by + internal units. + (st_read_done): Use new function - free_internal_unit. + (st_write_done): Use new function - free_internal unit. + +2006-04-22 Jakub Jelinek + + PR fortran/26769 + * Makefile.am (i_transpose_c): Add generated/transpose_r16.c. + (i_reshape_c): Add generated/reshape_r16.c. + * Makefile.in: Regenerated. + * generated/transpose_r16.c: Generated new file. + * generated/redhape_r16.c: Generated new file. + +2006-04-14 Jerry DeLisle + + PR libfortran/27138 + * io/list_read.c (eat_line): New function. + (parse_repeat): Use new function and free_saved. + (read_logical): Same. + (read_integer): Use new function. + (parse_real): Use nml_bad_return and new function. + (read_complex): Use new function and free_saved. + (read_real): Same. + +2006-04-12 Jerry DeLisle + + PR libfortran/26766 + * io/io.h: Add bit to identify associated unit as internal. + * io/unit.c (get_external_unit): Renamed the find_unit_1 function to + reflect the external unit functionality vs internal unit. + (get_internal_unit): New function to allocate and initialize an internal + unit structure. + (get_unit): Use get_internal_unit and get_external_unit. + (is_internal_unit): Revised to use new bit added in io.h. + * io/transfer.c (data_transfer_init): Fix line width. + (st_read_done): Free memory allocated for internal unit. + (st_write_done): Add test to only flush and truncate when not an + internal unit. Free memory allocated for internal unit. + +2006-04-11 Jakub Jelinek + + * io/io.h (st_parameter_dt): Revert 2005-12-10 change to + u.pad, fix comment. + (check_st_parameter_dt): New compile time assert. + +2006-04-10 Jakub Jelinek + + PR libfortran/24685 + * io/write.c (MIN_FIELD_WIDTH, STR, STR1): Define. + (output_float): Increase buffer sizes for IEEE quad and IBM extended + long double. + (write_real): Output REAL(16) as 1PG43.34E4 rather than 1PG40.31E4. + +2006-04-07 Jerry DeLisle + + PR libfortran/26890 + * io/io.h: Revert change to pad size made on 2006-03-30. + Add comment explaining dependency with fortran/trans-io.c. + +2006-04-03 Jerry DeLisle + + * io/write.c (output_float): Update condition to not error when + decimal precision in format specifier is zero. + +2006-04-01 Francois-Xavier Coudert + + * config/fpu-387.h: Use previously added SSE code in all + cases, as it really is the right thing to do. + +2006-03-30 Jerry DeLisle + + PR libfortran/26890 + * io/io.h: Add size_used to st_parameter_dt, adjust pad size. + *io/transfer.c (data_transfer_init): Initialize size_used to zero. + (read_sf): Use size_used. + (read_block): Likewise. + (read_block_direct): Likewise. + (write_block): Likewise. + (write_buf): Likewise and eliminate erroneous FAILURE return. + (finalize_transfer): Assign value of size_used to *dtp->size. + +2006-03-30 Francois-Xavier Coudert + + PR libfortran/26712 + * config/fpu-387.h: Add special case for handling of SSE + control bit on i386-darwin. + +2006-03-30 Thomas Koenig + + PR fortran/25031 + * runtime/memory.c (allocate_array): If stat is present and + the variable is already allocated, free the variable, do + the allocation and set stat. + (allocate_array_64): Likewise. Whitespace fix. + +2006-03-26 Jerry DeLisle + + PR libfortran/26880 + * io/file_pos.c (st_rewind): Clear read_bad flag. + +2006-03-25 Jerry DeLisle + + PR libfortran/26661 + * io/io.h: Add read_sf so it can be used by read_x. + * io/transfer.c (read_sf): Pass no_error flag to read_sf. Use it to + break out rather than error on EOF or EOR conditions. + (read_block): Update call to read_sf. + (read_block_direct): Ditto. + * io/read.c (read_x): Use the modified read_sf instead of read_block. + +2006-03-25 Thomas Koenig + + PR libfortran/26735 + * io/transfer.c (data_transfer_init): Set u_flags.convert + on an unopened unit if specified by environment variable + (via get_unformatted_convert) or by compile-time option. + +2006-03-25 Thomas Koenig + + PR fortran/26769 + * Makefile.am: Add transpose_r10.c and reshape_r10.c. + * aclocal.m4: Regenerate using aclocal 1.9.3. + * Makefile.in: Regenerate using automake 1.9.3. + * m4/iparm.m4 (rtype_ccode): If rtype_letter is `i', + evaluate to rtype_kind, otherwise to rtype_code. + * generated/transpose_r10.c: Add. + * generated/reshape_r10.c: Add. + +2006-03-22 Thomas Koenig + + PR fortran/19303 + * libgfortran.h (compile_options_t): Add record_marker. + * runtime/compile_options.c (set_record_marker): + New function. + * io/open.c: If we have four-byte record markers, use + GFC_INTEGER_4_HUGE as default record length. + * io/file_pos.c (unformatted_backspace): Handle + different size record markers. + * io/transfer.c (us_read): Likewise. + (us_write): Likewise. + (next_record_r): Likewise. + (write_us_marker): Likewise. + (next_record_w): Likewise. + +2006-03-20 Thomas Koenig + + PR fortran/20935 + * m4/iforeach.m4: Add SCALAR_FOREACH_FUNCTION macro. + * m4/ifunction.m4: Add SCALAR_ARRAY_FUNCTION macro. + * m4/minloc0.m4: Use SCALAR_FOREACH_FUNCTION. + * m4/minloc1.m4: Use SCALAR_ARRAY_FUNCTION. + * m4/maxloc0.m4: Use SCALAR_FOREACH_FUNCTION. + * m4/maxloc1.m4: Use SCALAR_ARRAY_FUNCTION. + * m4/minval.m4: Likewise. + * m4/maxval.m4: Likewise. + * m4/product.m4: Likewise. + * m4/sum.m4: Likewise. + * minloc0_16_i16.c : Regenerated. + * minloc0_16_i4.c : Regenerated. + * minloc0_16_i8.c : Regenerated. + * minloc0_16_r10.c : Regenerated. + * minloc0_16_r16.c : Regenerated. + * minloc0_16_r4.c : Regenerated. + * minloc0_16_r8.c : Regenerated. + * minloc0_4_i16.c : Regenerated. + * minloc0_4_i4.c : Regenerated. + * minloc0_4_i8.c : Regenerated. + * minloc0_4_r10.c : Regenerated. + * minloc0_4_r16.c : Regenerated. + * minloc0_4_r4.c : Regenerated. + * minloc0_4_r8.c : Regenerated. + * minloc0_8_i16.c : Regenerated. + * minloc0_8_i4.c : Regenerated. + * minloc0_8_i8.c : Regenerated. + * minloc0_8_r10.c : Regenerated. + * minloc0_8_r16.c : Regenerated. + * minloc0_8_r4.c : Regenerated. + * minloc0_8_r8.c : Regenerated. + * minloc1_16_i16.c : Regenerated. + * minloc1_16_i4.c : Regenerated. + * minloc1_16_i8.c : Regenerated. + * minloc1_16_r10.c : Regenerated. + * minloc1_16_r16.c : Regenerated. + * minloc1_16_r4.c : Regenerated. + * minloc1_16_r8.c : Regenerated. + * minloc1_4_i16.c : Regenerated. + * minloc1_4_i4.c : Regenerated. + * minloc1_4_i8.c : Regenerated. + * minloc1_4_r10.c : Regenerated. + * minloc1_4_r16.c : Regenerated. + * minloc1_4_r4.c : Regenerated. + * minloc1_4_r8.c : Regenerated. + * minloc1_8_i16.c : Regenerated. + * minloc1_8_i4.c : Regenerated. + * minloc1_8_i8.c : Regenerated. + * minloc1_8_r10.c : Regenerated. + * minloc1_8_r16.c : Regenerated. + * minloc1_8_r4.c : Regenerated. + * minloc1_8_r8.c : Regenerated. + * maxloc0_16_i16.c : Regenerated. + * maxloc0_16_i4.c : Regenerated. + * maxloc0_16_i8.c : Regenerated. + * maxloc0_16_r10.c : Regenerated. + * maxloc0_16_r16.c : Regenerated. + * maxloc0_16_r4.c : Regenerated. + * maxloc0_16_r8.c : Regenerated. + * maxloc0_4_i16.c : Regenerated. + * maxloc0_4_i4.c : Regenerated. + * maxloc0_4_i8.c : Regenerated. + * maxloc0_4_r10.c : Regenerated. + * maxloc0_4_r16.c : Regenerated. + * maxloc0_4_r4.c : Regenerated. + * maxloc0_4_r8.c : Regenerated. + * maxloc0_8_i16.c : Regenerated. + * maxloc0_8_i4.c : Regenerated. + * maxloc0_8_i8.c : Regenerated. + * maxloc0_8_r10.c : Regenerated. + * maxloc0_8_r16.c : Regenerated. + * maxloc0_8_r4.c : Regenerated. + * maxloc0_8_r8.c : Regenerated. + * maxloc1_16_i16.c : Regenerated. + * maxloc1_16_i4.c : Regenerated. + * maxloc1_16_i8.c : Regenerated. + * maxloc1_16_r10.c : Regenerated. + * maxloc1_16_r16.c : Regenerated. + * maxloc1_16_r4.c : Regenerated. + * maxloc1_16_r8.c : Regenerated. + * maxloc1_4_i16.c : Regenerated. + * maxloc1_4_i4.c : Regenerated. + * maxloc1_4_i8.c : Regenerated. + * maxloc1_4_r10.c : Regenerated. + * maxloc1_4_r16.c : Regenerated. + * maxloc1_4_r4.c : Regenerated. + * maxloc1_4_r8.c : Regenerated. + * maxloc1_8_i16.c : Regenerated. + * maxloc1_8_i4.c : Regenerated. + * maxloc1_8_i8.c : Regenerated. + * maxloc1_8_r10.c : Regenerated. + * maxloc1_8_r16.c : Regenerated. + * maxloc1_8_r4.c : Regenerated. + * maxloc1_8_r8.c : Regenerated. + * maxval_i16.c : Regenerated. + * maxval_i4.c : Regenerated. + * maxval_i8.c : Regenerated. + * maxval_r10.c : Regenerated. + * maxval_r16.c : Regenerated. + * maxval_r4.c : Regenerated. + * maxval_r8.c : Regenerated. + * minval_i16.c : Regenerated. + * minval_i4.c : Regenerated. + * minval_i8.c : Regenerated. + * minval_r10.c : Regenerated. + * minval_r16.c : Regenerated. + * minval_r4.c : Regenerated. + * minval_r8.c : Regenerated. + * sum_c10.c : Regenerated. + * sum_c16.c : Regenerated. + * sum_c4.c : Regenerated. + * sum_c8.c : Regenerated. + * sum_i16.c : Regenerated. + * sum_i4.c : Regenerated. + * sum_i8.c : Regenerated. + * sum_r10.c : Regenerated. + * sum_r16.c : Regenerated. + * sum_r4.c : Regenerated. + * sum_r8.c : Regenerated. + * product_c10.c : Regenerated. + * product_c16.c : Regenerated. + * product_c4.c : Regenerated. + * product_c8.c : Regenerated. + * product_i16.c : Regenerated. + * product_i4.c : Regenerated. + * product_i8.c : Regenerated. + * product_r10.c : Regenerated. + * product_r16.c : Regenerated. + * product_r4.c : Regenerated. + * product_r8.c : Regenerated. + +2006-03-17 Jerry DeLisle + + PR libfortran/26509 + * libgfortran.h: Add ERROR_DIRECT_EOR. + * runtime/error.c (translate_error): Add translation for new error. + * io/transfer.c (write_buf): Add check for EOR when mode is + direct access. + +2006-03-13 Paul Thomas + + PR fortran/25378 + * libgfortran/m4/minloc1.m4: Set the initial position to zero and + modify the condition for updating it, to implement the F2003 + requirement for all(mask).eq.false. + * libgfortran/m4/maxloc1.m4: The same. + * libgfortran/m4/iforeach.m4: The same. + * libgfortran/m4/minloc0.m4: The same. + * libgfortran/m4/maxloc0.m4: The same. + * libgfortran/generated/maxloc0_16_i16.c: Regenerated, together + with 41 others. + * libgfortran/generated/minloc0_16_i16.c: Regenerated, together + with 41 others. + +2006-03-09 Jerry DeLisle + + PR libfortran/26499 + * io/file_pos (st_rewind): Flush always. + * io/unix.c (fd_truncate): Return SUCCESS rather than FAILURE for + special files like /dev/null. + * io/transfer.c (st_write_done): Remove broken logic that + prevented calling fd_truncate. + +2006-03-05 Jerry DeLisle + + PR libfortran/26554 + * io/list_read.c (read_logical): Return the value if not in namelist + mode. + +2006-03-03 Thomas Koenig + + PR fortran/25031 + * runtime/memory.c: Adjust copyright years. + (allocate_array): New function. + (allocate64_array): New function. + * libgfortran.h (error_codes): Add ERROR_ALLOCATION. + +2006-02-28 Jerry DeLisle + + PR libfortran/26136 + * io/io.h: Add flag for reading from line_buffer. + * io/list_read.c (l_push_char): New function to save namelist + input when reading logicals. + (free_line): New function to free line_buffer memory. + (next_char): Added feature to read from line_buffer. + (read_logical): Use new functions to test for '=' after reading a + logical value, checking for possible variable name. + (namelist_read): Use free_line when all done. + +2006-02-27 Jerry DeLisle + + PR libfortran/26464 + * io/file_pos.c (st_backspace): Flush and truncate file + when in AFTER_ENDFILE condition. + * io/transfer.c (st_read_done): Remove flush, no longer needed. + +2006-02-24 Jerry DeLisle + + PR libfortran/26423 + * io/unix.c (fd_seek): Revert change from 25949. + (fd_read): Same. + (fd_write): Same. + +2006-02-19 Francois-Xavier Coudert + + * io/open.c (edit_modes): Correct abusive copy-pasting. + +2006-02-16 Francois-Xavier Coudert + + PR libfortran/24903 + * m4/dotprodc.m4: Use __builtin_conj instead of assigning real + and imaginary parts separately. + * generated/dotprod_c4.c: Regenerated. + * generated/dotprod_c8.c: Regenerated. + * generated/dotprod_c10.c: Regenerated. + * generated/dotprod_c16.c: Regenerated. + +2006-02-12 Janne Blomqvist + + PR libfortran/25949 + * io/io.h: Add set function pointer to struct stream. + * io/unix.c (fd_seek): Only update offset, don't seek. + (fd_sset): New function. + (fd_read): Call lseek directly if necessary. + (fd_write): Likewise. + (fd_open): Set pointer to fd_sset. + (mem_set): New function. + (open_internal): Set pointer to mem_set. + * io/transfer.c (write_block_direct): Rename to write_buf, add + error return, non-pointer length argument. + (unformatted_write): Update to use write_buf. + (us_write): Simplify by using swrite instead of salloc_w. + (write_us_marker): New function. + (new_record_w): Use sset instead of memset, use write_us_marker, + simplify by using swrite instead of salloc_w. + +2006-02-08 Francois-Xavier Coudert + + PR libfortran/25425 + * libgfortran.h: Add pedantic field to compile_options struct. + * io/write.c (calculate_G_format): Depending on the standard, + choose E or F format for list-directed output of 0.0. + * runtime/error.c (notify_std): Make warning and error dependent + on pedanticity. + * runtime/compile_options.c (set_std): Use new pedantic argument. + +2006-02-07 Dale Ranta + + PR fortran/25577 + * intrinsics/mvbits.c: Shift '(TYPE)1' type when building 'lenmask'. + +2006-02-07 Rainer Emrich + + * intrinsics/c99_functions.c: Work around incompatible + declarations of cabs{,f,l} on pre-C99 IRIX systems. + +2005-02-06 Thomas Koenig + + PR libfortran/23815 + * runtime/environ.c (init_unformatted): Add GFORTRAN_CONVERT_UNIT + environment variable. + (top level): Add defines, type and static variables for + GFORTRAN_CONVERT_UNIT handling. + (search_unit): New function. + (match_word): New function. + (match_integer): New function. + (next_token): New function. + (push_token): New function. + (mark_single): New function. + (mark_range): New funciton. + (do_parse): New function. + (init_unformatted): New function. + (get_unformatted_convert): New function. + * runtime/compile_options.c: Add set_convert(). + * libgfortran.h: Add convert to compile_options_t. + * io/open.c (st_open): Call get_unformatted_convert to get + unit default; if CONVERT_NONE is returned, check for + the presence of a CONVERT specifier and use it. + As default, use compile_options.convert. + * io/io.h (top level): Add CONVERT_NONE to unit_convert, to signal + "nothing has been set". + (top level): Add prototype for get_unformatted_convert. + +2006-02-06 Francois-Xavier Coudert + + PR libfortran/24685 + * io/write.c (write_real): Widen the default format for real(10) + variables output. + +2006-01-24 Jerry DeLisle + + PR libfortran/25835 + * io/transfer.c (st_read_done): Flush buffers when read is done. + +2006-01-17 Jerry DeLisle + + PR libfortran/25697 + * io/transfer.c (us_read): Detect end of file condition from previous + operations and bail out (no need to pre-position). + +2006-01-17 Jerry DeLisle + + PR libfortran/25631 + * io/transfer.c (formatted_transfer_scalar): Adjust pending_spaces and + skips so that TL works correctly when no bytes_used yet. + +2006-01-16 Roger Sayle + + * configure.ac (CFLAGS): Update to include -std=gnu99 so that + the configure tests will be run with the same environment as + used to compile the libgfortran source code. + * configure: Regenerate. + +2006-01-12 Roger Sayle + + * intrinsics/c99_functions.c: Add function prototypes to avoid + warnings from -Wstrict-prototypes -Wmissing-prototypes. On Tru64 + work around a brain-dead libm by redirecting calls to cabs{,f,l} + to a local __gfc_cabs{,f,l}. + +2006-01-07 Janne Blomqvist + + * configure.ac: Remove check for sys/mman.h. + * configure: Regenerated. + * Makefile.in: Regenerated. + * config.h.in: Regenerated. + * aclocal.m4: Regenerated. + +2006-01-05 Jerry DeLisle + + PR libfortran/25598 + * io/file_pos.c (unformatted_backspace): Assure the new file position + to seek is not less than zero. + (st_backspace): Set unit bytes_left to zero. + * io/transfer.c (next_record_r): Fix line lengths, no functional change. + +2006-01-02 Paolo Bonzini + + PR target/25259 + * configure.ac: Use GCC_HEADER_STDINT. + * libgfortran.h: Include gstdint.h. + * aclocal.m4: Regenerate. + * configure: Regenerate. + +2006-01-01 Steven G. Kargl + + * ChangeLog: Split into years ... + * ChangeLog-2002: here. + * ChangeLog-2003: here. + * ChangeLog-2004: here. + * ChangeLog-2005: here. + + +Copyright (C) 2006 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/libgfortran/ChangeLog-2007 b/libgfortran/ChangeLog-2007 new file mode 100644 index 000000000..11f9df093 --- /dev/null +++ b/libgfortran/ChangeLog-2007 @@ -0,0 +1,2487 @@ +2007-12-27 Thomas Koenig + + PR libfortran/22423 + * intrinsics/pack_generic.c (pack): Change type of mask argument + to gfc_array_l1 * in prototype and function. + (pack_char): Likewise. + * intrinsics/unpack_generic.c (unpack1): Likewise. + (unpack1_char): Likewise. + (unpack0): Likewise. + (unpack0_char): Likewise. + +2007-12-27 Thomas Koenig + + PR libfortran/34594 + * runtime/error.c: If there was a previous error, don't + mask it with another error mesage, EOF or EOR condition. + +2007-12-25 Jerry DeLisle + + PR libfortran/34560 + * io/transfer.c (read_sf): Check if readlen was less than the requested + number of bytes to read and if so, generate error. + +2007-12-25 Daniel Franke + + PR fortran/34533 + * intrinsics/cpu_time.c: Moved code commonly usable for CPU_TIME, + DTIME and ETIME to ... + * intrinsics/time_1.h: ... here. + * intrinsics/dtime.c: New file. + * intrinsics/etime.c: Newly implemented using the common + time-aquisition function from time_1.h. + * gfortran.map (_gfortran_dtime, _gfortran_dtime_sub): New. + * Makefile.am: Added new file. + * Makefile.in: Regenerated. + * configure: Regenerated. + +2007-12-25 Thomas Koenig + + PR libfortran/34566 + * m4/matmull.m4: Multiply xstride and ystride by correct kind. + * generated/matmul_l4.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + * generated/matmul_l16.c: Regenerated. + +2007-12-19 Tobias Burnus + + PR fortran/34530 + * io/list_read.c (eat_line): Move up in the file. + (eat_separator): In namelist mode, skip over comment lines. + +2007-12-16 Jerry DeLisle + + PR fortran/34427 + * io/list_read.c (read_real): Handle intervening line ends and spaces. + (get_name): Don't push separators to saved_string. + (eat_separator): If in namelist mode eat spaces and line ends as well. + +2007-12-13 Thomas Koenig + + PR libfortran/34370 + PR libfortran/34323 + PR libfortran/34405 + * io/io.h: Add previous_nonadvancing_write to gfc_unit. + Add prototype for finish_last_advance_record. + * io/file_pos.c (st_backspace): Generate error if backspace is + attempted for direct access or unformatted stream. + If there are bytes left from a previous ADVANCE="no", write + them out before performing the backspace. + (st_endfile): Generate error if endfile is attempted for + direct access. + If there are bytes left from a previous ADVANCE="no", write + them out before performing the endfile. + (st_rewind): Generate error if rewind is attempted for + direct access. + * unit.c (close_unit_1): Move functionality to write + previously written bytes to... + (finish_last_advance_record): ... here. + * transfer.c (data_transfer_init): If reading, reset + previous_nonadvancing_write. + (finalize_transfer): Set the previous_noadvancing_write + flag if we are writing and ADVANCE="no" was specified. + Only call next_record() if advance="no" wasn't specified. + +2007-12-13 Tobias Burnus + + PR fortran/34427 + * io/list_read.c (read_real): Fix unwinding for namelists. + +2007-12-10 Jerry DeLisle + + PR libfortran/34411 + * io/read.c (convert_real, read_l, read_decimal, read_radix, read_f): + Call next_record after bad read or overflow error. + +2007-12-09 Tobias Burnus + + PR fortran/34404 + * io/list_read.c (parse_real): Remove superfluous "goto bad;". + +2007-12-08 Tobias Burnus + + PR fortran/34319 + * io/list_read.c (parse_real, read_real): Support NaN/Infinity. + +2007-12-02 Jerry DeLisle + Thomas Koenig + + PR libfortran/33985 + * io/transfer.c (read_block, read_block_direct, write_block, write_buf): + Don't seek if file position is already there for STREAM I/O. + (finalize_transfer): For STREAM I/O don't flush unless the file position + has moved past the start position before the transfer. + +2007-12-01 Francois-Xavier Coudert + + * intrinsic/stat.c (stat_i4_sub_0, stat_i8_sub_0): Mark parameter + with unused attribute. + * intrinsics/system_clock.c (system_clock_4, system_clock_8): + Remove unused variable. + * intrinsics/umask.c: Include unistd.h. + +2007-11-30 Jerry DeLisle + + PR libfortran/34291 + * io/list_read.c (read_character): When reading an unquoted string, + return if special characters that could signify the end of the namelist + read are encountered. + +2007-11-29 Steven G. Kargl + + PR libfortran/33583 + * libgfortran/gfortran.map: Add tgammaf, tgamma, lgamma, and lgammaf. + * gfortran.dg/gamma_5.f90: Remove xfail. + +2007-11-16 Francois-Xavier Coudert + + PR libfortran/33583 + PR libfortran/33698 + * intrinsics/c99_functions.c (tgamma, tgammaf, lgamma, lgammaf): + New fallback functions. + * c99_protos.h (tgamma, tgammaf, lgamma, lgammaf): New prototypes. + * configure.ac: Add checks for tgamma, tgammaf, tgammal, lgamma, + lgammaf and lgammal. + * config.h.in: Regenerate. + * configure: Regenerate. + +2007-11-08 Francois-Xavier Coudert + + * mk-kinds-h.sh: Change sed syntax. + +2007-11-06 Jerry DeLisle + + PR libfortran/33985 + * io/transfer.c (finalize_transfer): Revert previous patch. + +2007-11-03 Jerry DeLisle + + PR libfortran/33985 + * io/transfer.c (finalize_transfer): Do not flush for + unformatted STREAM I/O. + +2007-10-27 Tobias Burnus + + * mk-kinds-h.sh: Change LANG=C to LC_ALL=C. + +2007-10-26 Tobias Burnus + + * mk-kinds-h.sh: Add "LANG=C". + +2007-10-26 Francois-Xavier Coudert + + * libgfortran.h (GFC_REAL_*_HUGE, GFC_REAL_*_DIGITS, + GFC_REAL_*_RADIX): Remove. + * mk-kinds-h.sh: Define GFC_REAL_*_HUGE, GFC_REAL_*_DIGITS and + GFC_REAL_*_RADIX. Don't define GFC_REAL_LARGEST_FORMAT and + GFC_REAL_LARGEST. + +2007-10-19 Ben Elliston + + * intrinsics/signal.c (alarm_sub_i4): Mark conditionally unused + parameters with __attribute__ ((unused)). + (alarm_sub_i8): Likewise. + (alarm_sub_int_i4): Likewise. + (alarm_sub_int_i8): Likewise. + +2007-10-18 Francois-Xavier Coudert + Jerry DeLisle + + PR libfortran/33795 + * libgfortran.h: Add unbuffered_preconnected. + * io/unix.c (output_stream): Set stream unbuffered flag if + options.unbuffered_preconnected has been set. + (error_stream): Ditto. + * runtime/environ.c (variable_table): Add to environment variable table + the entry: GFORTRAN_UNBUFFERED_PRECONNECTED. + +2007-10-18 Francois-Xavier Coudert + + PR libfortran/32021 + * runtime/backtrace.c (local_strcasestr): Protect by appropriate + macros. + * runtime/main.c (cleanup): Cast argument to free. + * intrinsics/spread_generic.c (spread_internal): Match runtime_error + arguments and format. + * intrinsics/signal.c (alarm_sub_int_i4, alarm_sub_int_i8): Cast + pointers to avoid warnings. + +2007-10-18 Ben Elliston + + * runtime/environ.c (init_choice): Remove unused function. + (show_choice): Likewise. + (choice): Remove. + (FP_ROUND_NEAREST, FP_ROUND_UP, FP_ROUND_DOWN, FP_ROUND_ZERO): + Remove. + (precision, signal_choices): Remove. + +2007-10-15 Christopher D. Rickett + + PR fortran/32600 + * libgfortran/intrinsics/iso_c_binding.c: Remove c_associated_1 + and c_associated_2. + * libgfortran/intrinsics/iso_c_binding.h: Ditto. + * libgfortran/gfortran.map: Ditto. + +2007-10-15 Jerry DeLisle + + PR libfortran/33055 + * io/inquire.c (inquire_via_unit): If inquiring by unit, check for + an error condition from the IOSTAT variable and set EXIST to false if + there was a bad unit number. + +2007-10-14 Jerry DeLisle + + PR libfortran/33672 + * io/list_read.c (nml_parse_qualifier): Add character specific error + messages. Check for proper form of sub-string qualifiers. Return the + parsed_rank flag indicating a non-zero rank qualifier. + (nml_get_obj_data): Count the instances of non-zero rank qualifiers. + Issue an error if more that one non-zero rank qualifier is found. + +2007-10-04 Jerry DeLisle + + PR libfortran/33253 + * io/list_read.c (read_character): Use line_buffer to scan ahead for + object name or string when no delimiter is found. + +2007-10-04 Francois-Xavier Coudert + + PR libfortran/32021 + * runtime/environ.c (init_mem, show_mem, init_round, show_round, + init_precision, show_precision, init_signal, show_signal): Remove. + (variable_table): Remove GFORTRAN_MEM_INIT, GFORTRAN_MEM_CHECK, + GFORTRAN_SIGHUP, GFORTRAN_SIGINT, GFORTRAN_FPU_ROUND and + GFORTRAN_FPU_PRECISION. + * libgfortran.h (options_t): Remove mem_check, fpu_round, + fpu_precision, sighup, sigint, allocate_init_flag and + allocate_init_value. + +2007-10-02 Jerry DeLisle + + PR libfortran/33253 + * io/list_read.c (read_character): Use DELIM_APOSTROPHE and DELIM_QUOTE + and quote value in check of first character in string. + +2007-10-02 Francois-Xavier Coudert + + PR fortran/33469 + * io/write.c (write_real): Widen the default formats. + +2007-09-28 Jerry DeLisle + + PR libfortran/33400 + * io/list_read.c (next_char): Interpret encountering the end of file the + first time as an end of line. Subsequent reads give EOF error. + +2007-09-27 Jerry DeLisle + + PR libfortran/33421 + * io/list_read.c (read_character): Revert r128057. + +2007-09-21 Bernhard Fischer + + PR fortran/31546 + * (configure.ac): Add --enable-intermodule for onestep build. + * (Makefile.am): Handle onestep build. + * (configure, Makefile.in): Regenerate. + +2007-09-21 Francois-Xavier Coudert + + PR libfortran/26253 + * intrinsics/c99_functions.c (scalbn): Use ldexp if appopriate. + +2007-09-21 Francois-Xavier Coudert + + PR libfortran/23272 + * io/unix.c (id_from_handle, id_from_path, id_from_fd): New + functions. + (compare_file_filename, find_file, find_file0): Use the new + functions above. + +2007-09-21 Francois-Xavier Coudert + + * acinclude.m4 (LIBGFOR_TARGET_ILP32): Remove test. + * configure.ac: Don't call LIBGFOR_TARGET_ILP32. + * configure: Regenerate. + * config.h.in: Regenerate. + +2007-09-15 Francois-Xavier Coudert + + PR libfortran/21185 + * runtime/compile_options.c (set_options): Fix typo. + * runtime/main.c (store_exe_path): If getcwd is not available, + don't use it. + * intrinsics/getcwd.c: Same thing here. + * io/unix.c (fallback_access): New fallback function for access. + (fix_fd): Don't use dup if it's not available. + * configure.ac: Check for dup and getcwd. + * configure: Regenerate. + * config.h.in: Regenerate. + +2007-09-12 Francois-Xavier Coudert + + * io/io.h: Include libgfortran.h first. + +2007-09-11 Francois-Xavier Coudert + + PR libfortran/33386 + * runtime/select.c (select_string): Initialize default_jump. + +2007-09-07 Jerry DeLisle + + PR libfortran/33307 + * io/filepos.c (st_backspace): Don't truncate when already at the end + of the file. + +2007-09-07 Uros Bizjak + + * config/fpu-387.h: Include cpuid.h. + (set_fpu): Use __get_cpuid to check for SSE. + +2007-09-06 Thomas Koenig + + PR fortran/33298 + * intrinsics/spread_generic.c(spread_internal): Enable + bounds checking by comparing extents if the bounds_check + option has been set. If any extent is <=0, return early. + +2007-09-06 David Edelsohn + + * libgfortran.h: Include config.h first. + * io/io.h (struct stream): Rename truncate to trunc. + * io/unix.c (fd_open): Same. + (open_internal): Same. + +2007-09-05 Jerry DeLisle + + PR libfortran/33253 + * io/write.c (nml_write_obj): Set the delimiter correctly before + calling write_character. (namelist_write): Clean up the code a little + and add comments to clarify what its doing. + +2007-09-04 Jerry DeLisle + + PR libfortran/33225 + * io/write.c (stdbool.h): Add include. (sign_t): Move typedef to + new file write_float.def. Include write_float.def. + (extract_real): Delete. (calculate_sign): Delete. + (calculate_exp): Delete. (calculate_G_format): Delete. + (output_float): Delete. (write_float): Delete. + * io/write_float.def (calculate_sign): Added. + (output_float): Refactored to be independent of kind and added to this + file for inclusion. (write_infnan): New function to write "Infinite" + or "NaN" depending on flags passed, independent of kind. + (CALCULATE_EXP): New macro to build kind specific functions. Use it. + (OUTPUT_FLOAT_FMT_G): New macro, likewise. Use it. + (DTOA, DTOAL): Macros to implement "decimal to ascii". + (WRITE_FLOAT): New macro for kind specific write_float functions. + (write_float): Revised function to determine kind and use WRITE_FLOAT + to implement kind specific output. + +2007-09-03 Jerry DeLisle + + PR libfortran/33253 + * io/list_read.c (read_character): Use DELIM_APOSTROPHE and + DELIM_QUOTE in check of first character in string. + +2007-09-03 Francois-Xavier Coudert + + PR fortran/31675 + * libgfortran.h: Include gcc/fortran/libgfortran.h. + Remove M_PI, GFC_MAX_DIMENSIONS, GFC_DTYPE_*, GFC_NUM_RANK_BITS, + error_codes, GFC_STD_*, GFC_FPE_* and unit_convert. + * runtime/environ.c (variable_table): Use GFC_*_UNIT_NUMBER instead + of hardcoded constants. + (do_parse, init_unformatted): Use GFC_CONVERT_* macros instead of + CONVERT_*. + * runtime/string.c (find_option): Use LIBERROR_BAD_OPTION instead + of ERROR_BAD_OPTION. + * runtime/error.c (translate_error, generate_error): Use + LIBERROR_* macros instead of ERROR_*. + * io/file_pos.c (formatted_backspace, unformatted_backspace, + st_backspace, st_rewind, st_flush): Rename macros. + * io/open.c (convert_opt, edit_modes, new_unit, already_open, + st_open): Likewise. + * io/close.c (st_close): Likewise. + * io/list_read.c (next_char, convert_integer, parse_repeat, + read_logical, read_integer, read_character, parse_real, + check_type, list_formatted_read_scalar, namelist_read, + nml_err_ret): Likewise. + * io/read.c (convert_real, read_l, read_decimal, read_radix, + read_f): Likewise. + * io/inquire.c (inquire_via_unit): Likewise. + * io/unit.c (get_internal_unit): Likewise. + * io/transfer.c (read_sf, read_block, read_block_direct, + write_block, write_buf, unformatted_read, unformatted_write, + formatted_transfer_scalar, us_read, us_write, data_transfer_init, + skip_record, next_record_r, write_us_marker, next_record_w_unf, + next_record_w, finalize_transfer, st_read, st_write_done): + Likewise. + * io/format.c (format_error): Likewise. + +2007-08-31 Francois-Xavier Coudert + + * m4/minloc1.m4: Update copyright year and ajust headers order. + * m4/maxloc1.m4: Likewise. + * m4/in_pack.m4: Likewise. + * m4/sum.m4: Likewise. + * m4/fraction.m4: Likewise. + * m4/all.m4: Likewise. + * m4/set_exponent.m4: Likewise. + * m4/transpose.m4: Likewise. + * m4/eoshift1.m4: Likewise. + * m4/spacing.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * m4/minval.m4: Likewise. + * m4/count.m4: Likewise. + * m4/maxval.m4: Likewise. + * m4/exponent.m4: Likewise. + * m4/shape.m4: Likewise. + * m4/head.m4: Likewise. + * m4/cshift1.m4: Likewise. + * m4/minloc0.m4: Likewise. + * m4/nearest.m4: Likewise. + * m4/maxloc0.m4: Likewise. + * m4/pow.m4: Likewise. + * m4/in_unpack.m4: Likewise. + * m4/matmull.m4: Likewise. + * m4/product.m4: Likewise. + * m4/reshape.m4: Likewise. + * m4/any.m4: Likewise. + * m4/rrspacing.m4: Likewise. + * m4/matmul.m4: Likewise. + * runtime/backtrace.c: Likewise. + * runtime/environ.c: Likewise. + * runtime/in_pack_generic.c: Likewise. + * runtime/compile_options.c: Likewise. + * runtime/in_unpack_generic.c: Likewise. + * runtime/main.c: Likewise. + * runtime/stop.c: Likewise. + * runtime/string.c: Likewise. + * runtime/memory.c: Likewise. + * runtime/error.c: Likewise. + * runtime/pause.c: Likewise. + * intrinsics/ierrno.c: Likewise. + * intrinsics/system_clock.c: Likewise. + * intrinsics/cshift0.c: Likewise. + * intrinsics/unlink.c: Likewise. + * intrinsics/ctime.c: Likewise. + * intrinsics/etime.c: Likewise. + * intrinsics/cpu_time.c: Likewise. + * intrinsics/malloc.c: Likewise. + * intrinsics/hostnm.c: Likewise. + * intrinsics/sleep.c: Likewise. + * intrinsics/exit.c: Likewise. + * intrinsics/perror.c: Likewise. + * intrinsics/transpose_generic.c: Likewise. + * intrinsics/pack_generic.c: Likewise. + * intrinsics/spread_generic.c: Likewise. + * intrinsics/stat.c: Likewise. + * intrinsics/string_intrinsics.c: Likewise. + * intrinsics/getcwd.c: Likewise. + * intrinsics/date_and_time.c: Likewise. + * intrinsics/unpack_generic.c: Likewise. + * intrinsics/move_alloc.c: Likewise. + * intrinsics/getlog.c: Likewise. + * intrinsics/eoshift0.c: Likewise. + * intrinsics/eoshift2.c: Likewise. + * intrinsics/reshape_generic.c: Likewise. + * intrinsics/system.c: Likewise. + * intrinsics/iso_c_binding.c: Likewise. + * intrinsics/env.c: Likewise. + * intrinsics/kill.c: Likewise. + * intrinsics/reshape_packed.c: Likewise. + * intrinsics/time.c: Likewise. + * intrinsics/gerror.c: Likewise. + * intrinsics/access.c: Likewise. + * intrinsics/fnum.c: Likewise. + * intrinsics/abort.c: Likewise. + * intrinsics/rename.c: Likewise. + * intrinsics/signal.c: Likewise. + * intrinsics/symlnk.c: Likewise. + * intrinsics/random.c: Likewise. + * intrinsics/umask.c: Likewise. + * intrinsics/getXid.c: Likewise. + * intrinsics/rand.c: Likewise. + * intrinsics/chdir.c: Likewise. + * intrinsics/chmod.c: Likewise. + * intrinsics/clock.c: Likewise. + * intrinsics/args.c: Likewise. + * intrinsics/link.c: Likewise. + * c99_protos.h: Likewise. + * config/fpu-387.h: Likewise. + * config/fpu-aix.h: Likewise. + * config/fpu-sysv.h: Likewise. + * config/fpu-generic.h: Likewise. + * config/fpu-glibc.h: Likewise. + * io/file_pos.c: Likewise. + * io/open.c: Likewise. + * io/size_from_kind.c: Likewise. + * io/close.c: Likewise. + * io/list_read.c: Likewise. + * io/read.c: Likewise. + * io/inquire.c: Likewise. + * io/unit.c: Likewise. + * io/unix.c: Likewise. + * io/transfer.c: Likewise. + * io/intrinsics.c: Likewise. + * io/format.c: Likewise. + * io/lock.c: Likewise. + * io/write.c: Likewise. + * io/write_float.def: Likewise. + * fmain.c: Likewise. + * generated/minval_r8.c: Regenerate. + * generated/minloc1_16_r16.c: Regenerate. + * generated/maxloc1_4_r8.c: Regenerate. + * generated/sum_i8.c: Regenerate. + * generated/eoshift3_4.c: Regenerate. + * generated/transpose_c8.c: Regenerate. + * generated/any_l16.c: Regenerate. + * generated/eoshift1_8.c: Regenerate. + * generated/pow_r8_i8.c: Regenerate. + * generated/reshape_r16.c: Regenerate. + * generated/pow_i4_i16.c: Regenerate. + * generated/maxval_i2.c: Regenerate. + * generated/product_r4.c: Regenerate. + * generated/maxloc1_8_i4.c: Regenerate. + * generated/exponent_r16.c: Regenerate. + * generated/maxloc0_4_r4.c: Regenerate. + * generated/fraction_r16.c: Regenerate. + * generated/in_unpack_i8.c: Regenerate. + * generated/matmul_r8.c: Regenerate. + * generated/product_i2.c: Regenerate. + * generated/fraction_r4.c: Regenerate. + * generated/minloc0_4_r16.c: Regenerate. + * generated/reshape_c4.c: Regenerate. + * generated/minloc0_4_i1.c: Regenerate. + * generated/maxloc0_4_r16.c: Regenerate. + * generated/maxloc0_4_i2.c: Regenerate. + * generated/minloc1_8_r16.c: Regenerate. + * generated/maxloc1_8_r16.c: Regenerate. + * generated/set_exponent_r8.c: Regenerate. + * generated/in_unpack_i16.c: Regenerate. + * generated/transpose_c16.c: Regenerate. + * generated/maxloc0_8_i8.c: Regenerate. + * generated/pow_c4_i8.c: Regenerate. + * generated/sum_r16.c: Regenerate. + * generated/sum_i1.c: Regenerate. + * generated/minloc1_4_r8.c: Regenerate. + * generated/transpose_r10.c: Regenerate. + * generated/pow_i8_i4.c: Regenerate. + * generated/maxloc1_16_r16.c: Regenerate. + * generated/minloc1_16_i4.c: Regenerate. + * generated/maxloc1_16_i4.c: Regenerate. + * generated/minloc0_16_i8.c: Regenerate. + * generated/maxloc0_16_i8.c: Regenerate. + * generated/nearest_r8.c: Regenerate. + * generated/spacing_r16.c: Regenerate. + * generated/transpose_i8.c: Regenerate. + * generated/count_16_l16.c: Regenerate. + * generated/maxval_r16.c: Regenerate. + * generated/count_8_l8.c: Regenerate. + * generated/product_c10.c: Regenerate. + * generated/minloc1_8_i4.c: Regenerate. + * generated/minloc0_16_i16.c: Regenerate. + * generated/matmul_r16.c: Regenerate. + * generated/eoshift1_16.c: Regenerate. + * generated/minloc0_4_r4.c: Regenerate. + * generated/pow_c16_i16.c: Regenerate. + * generated/set_exponent_r10.c: Regenerate. + * generated/pow_i16_i16.c: Regenerate. + * generated/product_c4.c: Regenerate. + * generated/sum_r4.c: Regenerate. + * generated/pow_c16_i4.c: Regenerate. + * generated/rrspacing_r10.c: Regenerate. + * generated/in_pack_c16.c: Regenerate. + * generated/minloc0_4_i2.c: Regenerate. + * generated/maxloc0_8_i1.c: Regenerate. + * generated/reshape_i4.c: Regenerate. + * generated/minloc0_8_i8.c: Regenerate. + * generated/matmul_c8.c: Regenerate. + * generated/spacing_r4.c: Regenerate. + * generated/in_pack_c4.c: Regenerate. + * generated/all_l16.c: Regenerate. + * generated/minloc1_16_r10.c: Regenerate. + * generated/sum_i2.c: Regenerate. + * generated/minloc0_16_i1.c: Regenerate. + * generated/reshape_c16.c: Regenerate. + * generated/maxloc0_16_i1.c: Regenerate. + * generated/maxloc1_8_r8.c: Regenerate. + * generated/minval_i16.c: Regenerate. + * generated/reshape_r10.c: Regenerate. + * generated/exponent_r10.c: Regenerate. + * generated/maxval_i4.c: Regenerate. + * generated/any_l4.c: Regenerate. + * generated/minval_i8.c: Regenerate. + * generated/maxloc1_4_i8.c: Regenerate. + * generated/fraction_r10.c: Regenerate. + * generated/maxloc0_16_i16.c: Regenerate. + * generated/shape_i4.c: Regenerate. + * generated/pow_r16_i8.c: Regenerate. + * generated/maxloc0_8_r4.c: Regenerate. + * generated/rrspacing_r8.c: Regenerate. + * generated/pow_c10_i4.c: Regenerate. + * generated/minloc1_4_i16.c: Regenerate. + * generated/minloc0_4_r10.c: Regenerate. + * generated/maxloc1_4_i16.c: Regenerate. + * generated/minloc0_8_i16.c: Regenerate. + * generated/maxloc0_4_r10.c: Regenerate. + * generated/maxloc0_8_i16.c: Regenerate. + * generated/minloc1_8_r10.c: Regenerate. + * generated/product_i4.c: Regenerate. + * generated/minloc0_16_r4.c: Regenerate. + * generated/sum_c16.c: Regenerate. + * generated/maxloc1_8_r10.c: Regenerate. + * generated/maxloc0_16_r4.c: Regenerate. + * generated/transpose_c10.c: Regenerate. + * generated/minloc1_16_r8.c: Regenerate. + * generated/minloc0_8_i1.c: Regenerate. + * generated/maxloc0_4_i4.c: Regenerate. + * generated/transpose_r4.c: Regenerate. + * generated/maxloc1_16_r8.c: Regenerate. + * generated/pow_i16_i8.c: Regenerate. + * generated/cshift1_4.c: Regenerate. + * generated/maxloc0_8_i2.c: Regenerate. + * generated/sum_r10.c: Regenerate. + * generated/nearest_r16.c: Regenerate. + * generated/sum_c4.c: Regenerate. + * generated/maxloc1_16_r10.c: Regenerate. + * generated/count_4_l16.c: Regenerate. + * generated/pow_c8_i8.c: Regenerate. + * generated/matmul_i8.c: Regenerate. + * generated/in_pack_i4.c: Regenerate. + * generated/pow_i4_i8.c: Regenerate. + * generated/minloc0_16_i2.c: Regenerate. + * generated/minloc1_8_r8.c: Regenerate. + * generated/maxloc0_16_i2.c: Regenerate. + * generated/exponent_r4.c: Regenerate. + * generated/spacing_r10.c: Regenerate. + * generated/matmul_c16.c: Regenerate. + * generated/pow_c4_i16.c: Regenerate. + * generated/maxval_r10.c: Regenerate. + * generated/count_4_l4.c: Regenerate. + * generated/shape_i16.c: Regenerate. + * generated/minval_i1.c: Regenerate. + * generated/maxloc1_4_i1.c: Regenerate. + * generated/matmul_r10.c: Regenerate. + * generated/minloc1_4_i8.c: Regenerate. + * generated/pow_r10_i8.c: Regenerate. + * generated/minloc0_8_r4.c: Regenerate. + * generated/in_unpack_c4.c: Regenerate. + * generated/matmul_l4.c: Regenerate. + * generated/product_i16.c: Regenerate. + * generated/minloc0_16_r16.c: Regenerate. + * generated/reshape_r8.c: Regenerate. + * generated/pow_r10_i16.c: Regenerate. + * generated/all_l4.c: Regenerate. + * generated/in_pack_c10.c: Regenerate. + * generated/minloc0_4_i4.c: Regenerate. + * generated/minloc0_8_i2.c: Regenerate. + * generated/matmul_i1.c: Regenerate. + * generated/reshape_c10.c: Regenerate. + * generated/minval_r4.c: Regenerate. + * generated/maxloc1_4_r4.c: Regenerate. + * generated/pow_r8_i16.c: Regenerate. + * generated/sum_i4.c: Regenerate. + * generated/maxval_r8.c: Regenerate. + * generated/count_16_l8.c: Regenerate. + * generated/transpose_c4.c: Regenerate. + * generated/eoshift1_4.c: Regenerate. + * generated/eoshift3_8.c: Regenerate. + * generated/minval_r16.c: Regenerate. + * generated/minloc1_4_i1.c: Regenerate. + * generated/minval_i2.c: Regenerate. + * generated/maxloc1_4_i2.c: Regenerate. + * generated/pow_i8_i16.c: Regenerate. + * generated/product_r8.c: Regenerate. + * generated/maxloc1_8_i8.c: Regenerate. + * generated/maxloc0_4_r8.c: Regenerate. + * generated/maxloc0_16_r16.c: Regenerate. + * generated/in_unpack_i4.c: Regenerate. + * generated/matmul_r4.c: Regenerate. + * generated/sum_c10.c: Regenerate. + * generated/minloc1_4_r16.c: Regenerate. + * generated/fraction_r8.c: Regenerate. + * generated/maxloc1_4_r16.c: Regenerate. + * generated/set_exponent_r4.c: Regenerate. + * generated/minloc0_8_r16.c: Regenerate. + * generated/in_unpack_c16.c: Regenerate. + * generated/reshape_c8.c: Regenerate. + * generated/maxloc0_8_r16.c: Regenerate. + * generated/nearest_r10.c: Regenerate. + * generated/maxloc0_8_i4.c: Regenerate. + * generated/pow_c4_i4.c: Regenerate. + * generated/matmul_i2.c: Regenerate. + * generated/minloc1_4_r4.c: Regenerate. + * generated/transpose_i16.c: Regenerate. + * generated/matmul_c10.c: Regenerate. + * generated/minloc0_16_i4.c: Regenerate. + * generated/maxloc0_16_i4.c: Regenerate. + * generated/pow_i8_i8.c: Regenerate. + * generated/nearest_r4.c: Regenerate. + * generated/minloc1_16_i8.c: Regenerate. + * generated/maxloc1_16_i8.c: Regenerate. + * generated/transpose_i4.c: Regenerate. + * generated/count_8_l4.c: Regenerate. + * generated/minloc1_4_i2.c: Regenerate. + * generated/matmul_l16.c: Regenerate. + * generated/maxloc1_8_i1.c: Regenerate. + * generated/minloc0_16_r10.c: Regenerate. + * generated/minloc1_8_i8.c: Regenerate. + * generated/minloc0_4_r8.c: Regenerate. + * generated/product_r16.c: Regenerate. + * generated/product_c8.c: Regenerate. + * generated/pow_r16_i16.c: Regenerate. + * generated/sum_r8.c: Regenerate. + * generated/pow_c16_i8.c: Regenerate. + * generated/in_pack_i16.c: Regenerate. + * generated/minloc0_8_i4.c: Regenerate. + * generated/matmul_c4.c: Regenerate. + * generated/minloc1_16_i16.c: Regenerate. + * generated/reshape_i8.c: Regenerate. + * generated/spacing_r8.c: Regenerate. + * generated/in_pack_c8.c: Regenerate. + * generated/maxloc1_8_r4.c: Regenerate. + * generated/minloc1_16_i1.c: Regenerate. + * generated/maxloc1_16_i1.c: Regenerate. + * generated/reshape_i16.c: Regenerate. + * generated/minval_r10.c: Regenerate. + * generated/pow_r4_i8.c: Regenerate. + * generated/minloc1_8_i1.c: Regenerate. + * generated/minval_i4.c: Regenerate. + * generated/maxloc1_4_i4.c: Regenerate. + * generated/maxloc1_8_i2.c: Regenerate. + * generated/maxval_i8.c: Regenerate. + * generated/eoshift3_16.c: Regenerate. + * generated/any_l8.c: Regenerate. + * generated/maxloc0_16_r10.c: Regenerate. + * generated/rrspacing_r4.c: Regenerate. + * generated/shape_i8.c: Regenerate. + * generated/maxloc0_8_r8.c: Regenerate. + * generated/minloc0_4_i16.c: Regenerate. + * generated/maxloc0_4_i16.c: Regenerate. + * generated/minloc1_4_r10.c: Regenerate. + * generated/minloc1_8_i16.c: Regenerate. + * generated/pow_c10_i8.c: Regenerate. + * generated/maxloc1_4_r10.c: Regenerate. + * generated/maxloc1_8_i16.c: Regenerate. + * generated/in_unpack_c10.c: Regenerate. + * generated/minloc0_8_r10.c: Regenerate. + * generated/maxloc0_8_r10.c: Regenerate. + * generated/minloc1_16_r4.c: Regenerate. + * generated/maxloc1_16_r4.c: Regenerate. + * generated/minloc0_16_r8.c: Regenerate. + * generated/pow_i16_i4.c: Regenerate. + * generated/product_i8.c: Regenerate. + * generated/maxloc0_16_r8.c: Regenerate. + * generated/sum_i16.c: Regenerate. + * generated/maxloc0_4_i8.c: Regenerate. + * generated/transpose_r8.c: Regenerate. + * generated/cshift1_8.c: Regenerate. + * generated/maxloc1_16_i16.c: Regenerate. + * generated/matmul_i4.c: Regenerate. + * generated/pow_c8_i4.c: Regenerate. + * generated/pow_i4_i4.c: Regenerate. + * generated/minloc1_8_r4.c: Regenerate. + * generated/sum_c8.c: Regenerate. + * generated/count_8_l16.c: Regenerate. + * generated/minloc1_16_i2.c: Regenerate. + * generated/maxloc1_16_i2.c: Regenerate. + * generated/in_pack_i8.c: Regenerate. + * generated/transpose_r16.c: Regenerate. + * generated/maxval_i16.c: Regenerate. + * generated/exponent_r8.c: Regenerate. + * generated/matmul_i16.c: Regenerate. + * generated/count_4_l8.c: Regenerate. + * generated/pow_c8_i16.c: Regenerate. + * generated/maxval_i1.c: Regenerate. + * generated/minloc1_4_i4.c: Regenerate. + * generated/minloc1_8_i2.c: Regenerate. + * generated/pow_c10_i16.c: Regenerate. + * generated/product_c16.c: Regenerate. + * generated/reshape_r4.c: Regenerate. + * generated/in_unpack_c8.c: Regenerate. + * generated/minloc0_8_r8.c: Regenerate. + * generated/matmul_l8.c: Regenerate. + * generated/product_r10.c: Regenerate. + * generated/set_exponent_r16.c: Regenerate. + * generated/cshift1_16.c: Regenerate. + * generated/product_i1.c: Regenerate. + * generated/all_l8.c: Regenerate. + * generated/maxloc0_4_i1.c: Regenerate. + * generated/rrspacing_r16.c: Regenerate. + * generated/minloc0_4_i8.c: Regenerate. + * generated/pow_r4_i16.c: Regenerate. + * generated/count_16_l4.c: Regenerate. + * generated/maxval_r4.c: Regenerate. + +2007-08-30 Jerry DeLisle + + PR libfortran/33225 + * io/write.c: Revert changes from patch of 2007-08-27. + * io/write_float.def: Remove file, reverting addition. + +2007-08-29 Francois-Xavier Coudert + + * runtime/memory.c (internal_realloc, allocate, allocate_array, + deallocate): Remove functions. + * gfortran.map (_gfortran_allocate, _gfortran_allocate_array, + _gfortran_deallocate, _gfortran_internal_realloc): Remove symbols. + * libgfortran.h (error_codes): Add comment. + +2007-08-28 Jerry DeLisle + + PR libfortran/33055 + Revert previous patch. + +2007-08-27 Jerry DeLisle + + * io/write.c (stdbool.h): Add include. (sign_t): Move typedef to + new file write_float.def. Include write_float.def. + (extract_real): Delete. (calculate_sign): Delete. + (calculate_exp): Delete. (calculate_G_format): Delete. + (output_float): Delete. (write_float): Delete. + * io/write_float.def (calculate_sign): Added. + (output_float): Refactored to be independent of kind and added to this + file for inclusion. (write_infnan): New function to write "Infinite" + or "NaN" depending on flags passed, independent of kind. + (CALCULATE_EXP): New macro to build kind specific functions. Use it. + (OUTPUT_FLOAT_FMT_G): New macro, likewise. Use it. + (DTOA, DTOAL): Macros to implement "decimal to ascii". + (WRITE_FLOAT): New macro for kind specific write_float functions. + (write_float): Revised function to determine kind and use WRITE_FLOAT + to implement kind specific output. + +2007-08-26 Jerry DeLisle + + PR libfortran/33055 + * io/inquire.c (inquire_via_unit): If inquiring by unit, check for + an error condition from the IOSTAT variable and set EXIST to false if + there was a bad unit number. + +2007-08-24 Thomas Koenig + + PR fortran/32972 + * libgfortran.h: Remove GFOR_POINTER_L8_TO_L4 macro. + Add GFOR_POINTER_TO_L1 macro. + * m4/iforeach.m4(`m'name`'rtype_qual`_'atype_code): + Change argument 'mask' to gfc_array_l1. Adjust prototype. + Change mask pointer to GFC_LOGICAL_1. Multiply strides + by kind of mask + * m4/ifunction.m4: Likewise. + * intrinsics/pack_generic.c(pack_internal): Likewise. + * intrinsics/unpack_generic.c(unpack_internal): Likewise. + * m4/matmull.m4: Switch to GFC_LOGICAL_1. Multiply strides by + kind of logical arguments a and b. + * generated/matmul_l16.c: Regenerated. + * generated/matmul_l4.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2007-08-23 Francois-Xavier Coudert + + PR libfortran/23138 + * acinclude.m4 (LIBGFOR_CHECK_MINGW_SNPRINTF): New check. + * configure.ac: Use LIBGFOR_CHECK_MINGW_SNPRINTF. + * libgfortran.h: If HAVE_MINGW_SNPRINTF is true, use __mingw_snprintf + instead of snprintf. + * config.h.in: Regenerate. + * configure: Regenerate. + +2007-08-22 Bernhard Fischer + + * libgfortran/Makefile.am (AM_CPPFLAGS): Commentary typo fix. + +2007-08-17 Francois-Xavier Coudert + + PR fortran/33079 + * intrinsics/string_intrinsics.c (string_trim, string_minmax): Fix + the zero-length result case. + +2007-08-15 Francois-Xavier Coudert + + PR fortran/33077 + * intrinsics/random.c (random_seed_i8): Fix code logic. + +2007-08-13 Danny Smith + + * acinclude.m4 (GTHREAD_USE_WEAK) Define to 0 for mingw32. + * configure: Regenerate. + +2007-08-12 Francois-Xavier Coudert + + PR fortran/30964 + PR fortran/33054 + * intrinsics/random.c (random_seed): Rename into random_seed_i4. + (random_seed_i8): New function. + * gfortran.map (GFORTRAN_1.0): Remove _gfortran_random_seed, + add _gfortran_random_seed_i4 and _gfortran_random_seed_i8. + * libgfortran.h (iexport_proto): Replace random_seed by + random_seed_i4 and random_seed_i8. + * runtime/main.c (init): Call the new random_seed_i4. + +2007-08-11 Francois-Xavier Coudert + Tobias Burnus + + PR fortran/31189 + * runtime/backtrace.c (show_backtrace): Skip _gfortrani_handler + when displaying backtrace. + * runtime/compile_options.c: Include . + (handler): New function. + (set_options): Set signal handlers for backtrace. + * libgfortran.h (handler): Add prototype. + +2007-08-11 Francois-Xavier Coudert + + * intrinsics/string_intrinsics.c (compare_string): Return an int. + * libgfortran.h (compare_string): Likewise. + +2007-08-10 Francois-Xavier Coudert + + PR fortran/31270 + * runtime/error.c (runtime_error_at): Add a variable number of + arguments. + * libgfortran.h (runtime_error_at): Update prototype. + +2007-08-10 Francois-Xavier Coudert + + PR fortran/32933 + * intrinsics/associated.c: Change return type of associated into + a C int. + +2007-08-10 Jerry DeLisle + + PR libfortran/33039 + * io/list_read.c (find_nml_name): Check for a space after a namelist + name match. + +2007-08-09 Tobias Burnus + + PR fortran/32987 + * io/format.c (next_char): Treat '\t' as ' ' in format specification. + +2007-08-06 Francois-Xavier Coudert + + PR fortran/30947 + * intrinsics/signal.c: Create specific versions of alarm_sub and + alarm_sub_int according to the integer kind of the last argument. + * gfortran.map (GFORTRAN_1.0): Remove _gfortran_alarm_sub and + _gfortran_alarm_sub_int, add _gfortran_alarm_sub_i4, + _gfortran_alarm_sub_i8, _gfortran_alarm_sub_int_i4 and + _gfortran_alarm_sub_int_i8. + +2007-08-06 Francois-Xavier Coudert + + PR fortran/29828 + * intrinsics/string_intrinsics.c (string_minmax): New function + and prototype. + * gfortran.map (GFORTRAN_1.0): Add _gfortran_string_minmax + +2007-08-05 Francois-Xavier Coudert + + PR fortran/31202 + * intrinsics/c99_functions.c (roundl): Provide fallback + implementation for systems without ceill. + * c99_protos.h (roundl): Define prototype in all cases. + +2007-08-03 Thomas Koenig + + PR libfortran/32977 + * io/unix.c: If there is no vsnprintf, use vsprintf and issue + a fatal error when a buffer overrun occurs. + +2007-08-03 Francois-Xavier Coudert + + PR fortran/31202 + * intrinsics/c99_functions.c (roundl,lroundf,lround,lroundl, + llroundf,llround,llroundl): New functions. + * c99_protos.h (roundl,lroundf,lround,lroundl,llroundf,llround, + llroundl): New prototypes. + * configure.ac: Check for lroundf, lround, lroundl, llroundf, + llround and llroundl. + * configure: Regenerate. + * Makefile.in: Regenerate. + * config.h.in: Regenerate. + +2007-07-30 Francois-Xavier Coudert + + * libgfortran.h: Include . + +2007-07-29 Thomas Koenig + + PR libfortran/32858 + PR libfortran/30814 + * configure.ac: Added checks for presence of stdio.h and + stdarg.h. Test presence of vsnprintf(). + * configure: Regenerated. + * config.h.in: Regenerated. + * libgfortran.h: Include . Add printf attribute to + prototype of runtime_error. Remove prototype for st_sprintf. + Add prototype for st_vprintf. + * runtime/main.c (store_exec_path): Replace st_sprintf by sprintf. + * runtime/error.c (st_sprintf): Remove. + (runtime_error): Rewrite as a variadic function. Call + st_vprintf(). + * intrinsics/pack_generic.c: Output extents of LHS and RHS for + bounds error. + * io/open.c (new_unit): Replace st_sprintf by sprintf. + * io/list_read.c (convert_integer): Likewise. + (parse_repeat): Likewise. + (read_logical): Likewise. + (read_character): Likewise. + (parse_real): Likewise. + (read_real): Likewise. + (check_type): Likewise. + (nml_parse_qualifyer): Likewise. + (nml_read_obj): Likewise. + (nml_get_ojb_data): Likewise. + * io/unix.c (init_error_stream): Remove. + (tempfile): Replace st_sprintf by sprintf. + (st_vprintf): New function. + (st_printf): Rewrite to call st_vprintf. + * io/transfer.c (require_type): Replace st_sprintf by sprintf. + * io/format.c (format_error): Likewise. + * io/write.c (nml_write_obj): Likewise. + +2007-07-27 Janne Blomqvist + + * io/transfer.c (st_set_nml_var_dim): Use index_type instead of + GFC_INTEGER_4 for array descriptor triplets. + +2007-07-27 Francois-Xavier Coudert + + * io/unix.c (stream_ttyname): Mark argument as potentialy unused. + +2007-07-27 Francois-Xavier Coudert + + PR fortran/32035 + * runtime/select.c (select_string): Adjust prototype and function + so that the return value is an integer, not a pointer. + +2007-07-24 Tobias Burnus + + * libgfortran.h: Add bounds_check to compile_options_t. + +2007-07-24 Thomas Koenig + + PR fortran/30814 + * libgfortran.h: Add bounds_check to compile_options_t. + * runtime/compile_options.c (set_options): Add handling + of compile_options.bounds_check. + * intrinsics/pack_generic.c (pack_internal): Also determine + the number of elements if compile_options.bounds_check is + true. Raise runtime error if a different array shape is + detected. + +2007-07-23 Christopher D. Rickett + + PR fortran/32600 + * intrinsics/iso_c_binding.c (c_funloc): Remove. + * intrinsics/iso_c_binding.h: Remove c_funloc. + * gfortran.map: Ditto. + +2007-07-22 Jerry DeLisle + + * io/read.c (convert_real): Generate error only on EINVAL. + +2007-07-21 Christopher D. Rickett + + PR fortran/32627 + * libgfortran/intrinsics/iso_c_generated_procs.c: Add c_f_pointer + for character/string arguments. + * libgfortran/intrinsic/iso_c_binding.c (c_f_pointer_u0): Allow + the optional SHAPE arg to be any valid integer kind. + * libgfortran/gfortran.map: Add c_f_pointer_s0. + * libgfortran/mk-kinds-h.sh: Save smallest integer kind as default + character kind. + * libgfortran/intrinsics/iso_c_generated_procs.c: Add versions of + c_f_pointer for complex and logical types. + * libgfortran/gfortran.map: Add c_f_pointer versions for logical + and complex types. + +2007-07-19 Christopher D. Rickett + + PR fortran/32600 + * libgfortran/intrinsics/iso_c_binding.c: Remove C_LOC. + * libgfortran/intrinsics/iso_c_binding.h: Ditto. + * libgfortran/gfortran.map: Ditto. + +2007-07-15 Jerry DeLisle + Francois-Xavier Coudert + + PR fortran/32611 + * runtime/compile_options.c (set_std): Remove. + (set_options): New function. + (init_compile_options): Add initialization for -fsign-zero option. + * gfortran.map (GFORTRAN_1.0): Rename _gfortran_set_std into + _gfortran_set_options. + * libgfortran.h (compile_options_t): Add sign_zero field. + * io/write.c (output_float): Use the sign bit of the value to determine + if a negative sign should be emitted for zero values. Do not emit the + negative sign for zero if -fno-sign-zero was set during compile. + +2007-07-14 Jerry DeLisle + + PR libgfortran/32752 + * io/unix.c (unix_stream): Move buffer pointer adjacent to + small_buffer. + * io/transfer.c (formatted_transfer_scalar): If stream I/O, set + bytes_used to zero. Fix off by one error in calculation of pos and + skips. Eliminate duplicate pending_spaces check. + +2007-07-15 Francois-Xavier Coudert + + PR fortran/32357 + * intrinsics/mvbits.c: Change prototype so that FROMPOS, LEN and + TOPOS arguments are C int. + +2007-07-09 Jerry DeLisle + + PR libgfortran/32702 + * io/unix.c (unix_stream): Restore buffer pointer and small_buffer. + (fd_alloc): If the number of bytes needed is greater than the default + BUFFER_SIZE, allocate a new buffer large enough. Free the old buffer + if necessary. (fd_sfree): Restore use of buffer pointer. + (fd_close): Likewise. (fd_open): Likewise. + (init_error_stream): Likewise. + +2007-07-09 Thomas Koenig + + PR libfortran/32336 + * m4/matmul.m4: When the dimension of b is incorrect, + raise a runtime error instead of a failed assertion. + * generated/matmul_i1.c: Regenerated. + * generated/matmul_i2.c: Regenerated. + * generated/matmul_i4.c: Regenerated. + * generated/matmul_i8.c: Regenerated. + * generated/matmul_i16.c: Regenerated. + * generated/matmul_r4.c: Regenerated. + * generated/matmul_r8.c: Regenerated. + * generated/matmul_r10.c: Regenerated. + * generated/matmul_r16.c: Regenerated. + +2007-07-08 Jerry DeLisle + + PR libgfortran/32678 + * io/transfer.c (formatted_transfer_scalar): Don't allow + pending_spaces to go negative. + +2007-07-08 Thomas Koenig + + PR libfortran/32217 + * intrinsics/unpack_generic.c: If the destination array is + empty, return early. + +2007-07-05 H.J. Lu + + * aclocal.m4: Regenerated. + +2007-07-04 David Edelsohn + + * configure.ac: SUBST CFLAGS. + * configure: Regenerate. + +2007-07-03 Janne Blomqvist + + * libgfortran.h: Mark internal_malloc_size as a malloc function. + * runtime/memory.c (internal_realloc_size): Remove. + (internal_realloc): Call realloc directly instead of + internal_realloc_size. + (allocate_size): Remove. + (allocate): Call malloc directly instead of allocate_size, mark as + malloc function. + +2007-07-02 Steven G. Kargl + + Restore collateral damage from ISO C Binding merge. + +2007-06-29 Jerry DeLisle + + PR libgfortran/32456 + * io/unit.c (filename_from_unit): Don't use find_unit, instead search + for unit directly. + +2007-07-02 Steven G. Kargl + + * Makefile.in: Regenerated with automake 1.9.6. + +2007-07-02 Steven G. Kargl + + * Makefile.in: Remove extraneous kill.lo rule. + +2007-07-02 Janne Blomqvist + + PR fortran/32239 + * generated/pow_r*_i4.c: Removed. + +2007-07-01 Christopher D. Rickett + + * Makefile.in: Add support for iso_c_generated_procs.c and + iso_c_binding.c. + * Makefile.am: Ditto. + * intrinsics/iso_c_generated_procs.c: New file containing helper + functions. + * intrinsics/iso_c_binding.c: Ditto. + * intrinsics/iso_c_binding.h: New file + * gfortran.map: Include the __iso_c_binding_c_* functions. + * libgfortran.h: define GFC_NUM_RANK_BITS. + +2007-07-01 Janne Blomqvist + + PR fortran/32239 + * Makefile.am: Don't generate real**int4 pow functions. + * gfortran.map: Remove real**int4 pow symbols. + * Makefile.in: Regenerated. + +2007-07-01 Jerry DeLisle + + PR libgfortran/32554 + * io/write.c (output_float): Set edigits to a fixed size, avoiding + variation in field width calculation and eliminate buffer overrun. + +2007-07-01 Janne Blomqvist + + * runtime/memory.c (internal_realloc): Use index_type for size + argument instead of GFC_INTEGER_4. + (allocate_array): Likewise. + (allocate): Likewise, add ifdef around unnecessary check. + (internal_reallo64): Remove. + (allocate_array64): Remove. + (allocate64): Remove. + * gfortran.map: Remove symbols for 64-bit allocation functions. + +2007-06-29 Jerry DeLisle + + PR libgfortran/32456 + * io/unit.c (filename_from_unit): Don't use find_unit, instead search + for unit directly. + +2007-06-24 Adam Nemet + + PR libfortran/32495 + * runtime/backtrace.c (local_strcasestr): Rename from strcasestr. + (show_backtrace): Rename strcasestr to local_strcasestr. + +2007-06-24 Jerry DeLisle + + PR libgfortran/32456 + * runtime/error.c (show_locus): Update to emit the unit number + and file name involved with the error. Use new function + filename_from_unit. + * libgfortran.h (filename_from_unit): Declare new function. + * io/unit.c (init_units): Set the unit file name for stdin, stdout, + and stderr for use later in error reporting. + (filename_from_unit): Add this new function. + +2007-06-24 Jerry DeLisle + + PR libgfortran/32446 + * io/write.c (output_float): Calculate ndigits correctly for large + numbered formats that must pad zeros before the decimal point. + +2007-06-15 Rainer Orth + + PR libfortran/32345 + * runtime/backtrace.c (show_backtrace): Only use snprintf if + available. + +2007-06-10 Jerry DeLisle + + PR libgfortran/32235 + * io/transfer.c (st_read): Remove test for end of file condition. + (next_record_r): Add test for end of file condition. + +2007-06-02 Paolo Bonzini + + * configure: Regenerate. + +2007-05-28 Tobias Burnus + + PR fortran/32124 + * runtime/memory.c (allocate_size): Use ERROR_ALLOCATION. + (allocate,allocate64): Use stat variable if present. + +2007-05-27 Janne Blomqvist + + * runtime/string.c (compare0): Use gfc_charlen_type instead of + int. + (fstrlen): Likewise. + (find_option): Likewise. + (fstrcpy): Use gfc_charlen_type instead of int, return length. + (cf_strcpy): Likewise. + * libgfortran.h: Change string prototypes to use gfc_charlen_type. + * io/open.c (new_unit): Use snprintf if available. + * io/list_read.c (nml_touch_nodes): Use memcpy instead of + strcpy/strcat. + (nml_read_obj): Likewise. + * io/transfer.c (st_set_nml_var): Likewise. + * io/write.c (output_float): Use snprintf if available. + (nml_write_obj) Use memcpy instead of strcpy/strcat. + +2007-05-26 Janne Blomqvist + + * io/unix.c (unix_stream): Rearrange struct members, remove + small_buffer. + (int_stream): New struct. + (fd_alloc): Always use existing buffer, never reallocate. + (fd_sfree): Remove check for buffer != small_buffer. + (fd_close): Likewise. + (mem_alloc_r_at): Change to use int_stream. + (mem_alloc_w_at): Likewise. + (mem_read): Likewise. + (mem_write): Likewise. + (mem_set): Likewise. + (mem_truncate): Likewise. + (mem_close): Likewise. + (mem_sfree): Likewise. + (empty_internal_buffer): Likewise. + (open_internal): Likewise. + +2007-05-25 Jerry DeLisle + + * io/transfer.c (unformatted_read): Use size from front end + eliminating use of size_from_real_kind. + (unformatted_write): Ditto. + +2007-05-23 Steve Ellcey + + * Makefile.in: Regenerate. + * configure: Regenerate. + * aclocal.m4: Regenerate. + +2007-05-22 Tobias Burnus + + * libgfortran.h: Mark stop_numeric as noreturn. + +2007-05-22 Tobias Burnus + + PR libgfortran/31295 + * intrinsics/eoshift0.c (eoshift0): Silence uninitialized warning. + * intrinsics/eoshift2.c (eoshift2): Ditto. + +2007-05-18 Jerry DeLisle + + PR libfortran/31964 + * intrinsics/ishftc.c (ishftc4, ishftc8, ishftc16): Fix mask to handle + shift of bit-size number of bits. + +2007-05-17 Tobias Burnus + + PR fortran/31917 + * runtime/environ.c (mark_range): Fix setting default convert unit. + +2007-05-15 Jerry DeLisle + + PR libfortran/31922 + * intrinsics/string_intrinsics.c (string_trim): Set result to null if + string length is zero. + +2007-05-15 Tobias Burnus + + PR libfortran/31915 + * io/transfer.c (unformatted_read): Use proper size for real(10). + (unformatted_write): Ditto. + +2007-05-14 Francois-Xavier Coudert + + PR fortran/30723 + * runtime/memory.c (internal_malloc, internal_malloc64, + internal_free): Remove. + * runtime/error.c (os_error): Export function. + * intrinsics/move_alloc.c: Include stdlib.h. + (move_alloc): Call free instead of internal_free. + (move_alloc_c): Wrap long lines. + * libgfortran.h (os_error): Export prototype. + (internal_free): Remove prototype. + * gfortran.map (GFORTRAN_1.0): Remove _gfortran_internal_free, + _gfortran_internal_malloc and _gfortran_internal_malloc64. + Add _gfortran_os_error. + +2007-05-09 Jerry DeLisle + + PR libfortran/31880 + * io/unix.c (fd_alloc_r_at): Fix calculation of physical offset. + +2007-05-07 Francois-Xavier Coudert + + PR libfortran/31607 + * intrinsics/system.c (system_sub): Call flush_all_units. + * io/io.h (flush_all_units): Move prototype to libgfortran.h. + * libgfortran.h (flush_all_units): Add prototype. + +2007-05-06 Jerry DeLisle + + PR libfortran/31201 + * runtime/error.c (runtime_error_at): New function. + (generate_error): Export this function. + * gfortran.map: Add _gfortran_generate_error and + _gfortran_runtime_error_at. + * libgfortran.h: Add comment to reference error codes in front end. + (library_start): Locate prototype with library_end macro and add + a new comment. Add prototype for runtime_error_at. Export prototype + for generate_error. + * io/lock.c (library_start): Fix check for error condition. + * io/transfer.c (data_transfer_init): Add library check. + +2007-05-04 Daniel Franke + + PR fortran/22359 + * io/intrinsics.c (fseek_sub): New. + * io/unix.c (fd_fseek): Change logical and physical offsets only + if seek succeeds. + * gfortran.map (fseek_sub): New. + +2007-05-04 Francois-Xavier Coudert + + PR libfortran/31210 + * io/transfer.c (transfer_character): Avoid passing a NULL + pointer as source to the transfer routines, if the string length + is zero. + +2007-04-28 Jerry DeLisle + + PR libfortran/31501 + * io/list_read.c (next_char): Fix whitespace. + * io/io.h: Remove prototypes and define macros for is_array_io, + is_stream_io, and is_internal_unit. + * io/unit.c (is_array_io), (is_internal_unit), (is_stream_io): Delete + these functions. + * io/transfer.c (read_sf): Change handling of internal_unit to make a + single call to salloc_r and use memcpy to transfer the data. + +2007-04-27 Jerry DeLisle + + PR libfortran/31532 + * io/file_pos.c (st_backspace): Set flags.position for end of file + condition and use new function update_position. + (st_endfile): Use new function update_position. + * io/io.h: Add prototype for new function. + * io/inquire.c (inquire_via_unit): If not direct access, set NEXTREC + to zero. + * io/unit.c (update_position): New function to update position info + used by inquire. + * io/transfer.c (next_record): Fix typo and use new function. + +2007-04-25 Francois-Xavier Coudert + + PR libfortran/31299 + * intrinsics/getlog.c: Use getpwuid and geteuid instead of + getlogin if they are available. + * configure.ac: Add checks for getpwuid and geteuid. + * configure: Regenerate. + * config.h.in: Regenerate. + +2007-04-25 Janne Blomqvist + + * configure: Regenerate using autoconf 2.59. + * Makefile.in: Likewise. + * config.h.in: Likewise. + +2007-04-24 Janne Blomqvist + + PR libfortran/27740 + * configure.ac: New test to determine if symbol versioning is + supported. + * Makefile.am: Use result of above test to add appropriate linker + flags. + * gfortran.map: New file. + * configure: Regenerated. + * Makefile.in: Regenerated. + * config.h.in: Regenerated. + +2007-04-23 Thomas Koenig + + PR fortran/31618 + * io/transfer.c (read_block_direct): Instead of calling us_read, + set dtp->u.p.current_unit->current_record = 0 so that pre_position + will read the record marker. + (data_transfer_init): For different error conditions, call + generate_error, then return. + +2007-04-19 Francois-Xavier Coudert + + * runtime/main.c (please_free_exe_path_when_done): New variable. + (store_exe_path): Initialize character buffer, and mark whether + exe_path should be free'd by the library destructor function. + (cleanup): Only free exe_path if needed. + +2007-04-18 Francois-Xavier Coudert + Tobias Burnus + + PR libfortran/31286 + PR libfortran/31296 + * intrinsics/cshift0.c (cshift0): Initialize sstride[0] and rstride[0]. + * intrinsics/unpack_generic.c (unpack0, unpack0_char): Zero the + array structures we pass to unpack_internal. + +2007-04-14 Jerry DeLisle + + * io/open.c (test_endfile): Revert changes for 31052, restoring this + function. + +2007-04-14 Steve Ellcey + + * Makefile.am: Add -I .. to ACLOCAL_AMFLAGS. Add libgfortran_la_LINK. + * Makefile.in: Regenerate. + +2007-04-11 Kai Tietz + + * configure: Regenerate. + +2007-04-06 Francois-Xavier Coudert + + * intrinsics/cpu_time.c: Don't include headers already included + by libgfortran.h. Protect inclusion of sys/times.h. + * configure.ac: Remove unneeded checks for finit, stdio.h, + stddef.h, math.h and sys/params.h. + * config/fpu-aix.h: Don't include headers already included by + libgfortran.h. + * config/fpu-sysv.h: Likewise. + * io/write.c: Likewise. + * m4/minloc1.m4: Likewise. + * m4/maxloc1.m4: Likewise. + * m4/fraction.m4: Likewise. + * m4/set_exponent.m4: Likewise. + * m4/spacing.m4: Likewise. + * m4/minval.m4: Likewise. + * m4/maxval.m4: Likewise. + * m4/exponent.m4: Likewise. + * m4/nearest.m4: Likewise. + * m4/minloc0.m4: Likewise. + * m4/maxloc0.m4: Likewise. + * m4/rrspacing.m4: Likewise. + * runtime/main.c: Likewise. + * runtime/error.c: Likewise. + * intrinsics/system_clock.c: Likewise. + * intrinsics/etime.c: Likewise. + * intrinsics/stat.c: Likewise. + * intrinsics/date_and_time.c: Likewise. + * intrinsics/env.c: Likewise. + * intrinsics/kill.c: Likewise. + * intrinsics/getXid.c: Likewise. + * intrinsics/chmod.c: Likewise. + * intrinsics/args.c: Likewise. + * intrinsics/c99_functions.c: Likewise. + * generated/minval_r8.c: Regenerate. + * generated/maxloc1_4_r8.c: Regenerate. + * generated/minloc1_16_r16.c: Regenerate. + * generated/maxval_i2.c: Regenerate. + * generated/maxloc1_8_i4.c: Regenerate. + * generated/exponent_r16.c: Regenerate. + * generated/maxloc0_4_r4.c: Regenerate. + * generated/fraction_r16.c: Regenerate. + * generated/fraction_r4.c: Regenerate. + * generated/minloc0_4_r16.c: Regenerate. + * generated/minloc0_4_i1.c: Regenerate. + * generated/maxloc0_4_r16.c: Regenerate. + * generated/maxloc0_4_i2.c: Regenerate. + * generated/minloc1_8_r16.c: Regenerate. + * generated/maxloc1_8_r16.c: Regenerate. + * generated/set_exponent_r8.c: Regenerate. + * generated/maxloc0_8_i8.c: Regenerate. + * generated/minloc1_4_r8.c: Regenerate. + * generated/maxloc1_16_r16.c: Regenerate. + * generated/minloc1_16_i4.c: Regenerate. + * generated/maxloc1_16_i4.c: Regenerate. + * generated/minloc0_16_i8.c: Regenerate. + * generated/maxloc0_16_i8.c: Regenerate. + * generated/nearest_r8.c: Regenerate. + * generated/spacing_r16.c: Regenerate. + * generated/maxval_r16.c: Regenerate. + * generated/minloc1_8_i4.c: Regenerate. + * generated/minloc0_16_i16.c: Regenerate. + * generated/minloc0_4_r4.c: Regenerate. + * generated/set_exponent_r10.c: Regenerate. + * generated/rrspacing_r10.c: Regenerate. + * generated/minloc0_4_i2.c: Regenerate. + * generated/maxloc0_8_i1.c: Regenerate. + * generated/minloc0_8_i8.c: Regenerate. + * generated/spacing_r4.c: Regenerate. + * generated/minloc1_16_r10.c: Regenerate. + * generated/minloc0_16_i1.c: Regenerate. + * generated/maxloc0_16_i1.c: Regenerate. + * generated/maxloc1_8_r8.c: Regenerate. + * generated/minval_i16.c: Regenerate. + * generated/exponent_r10.c: Regenerate. + * generated/maxval_i4.c: Regenerate. + * generated/minval_i8.c: Regenerate. + * generated/maxloc1_4_i8.c: Regenerate. + * generated/fraction_r10.c: Regenerate. + * generated/maxloc0_16_i16.c: Regenerate. + * generated/maxloc0_8_r4.c: Regenerate. + * generated/rrspacing_r8.c: Regenerate. + * generated/minloc1_4_i16.c: Regenerate. + * generated/minloc0_4_r10.c: Regenerate. + * generated/maxloc1_4_i16.c: Regenerate. + * generated/minloc0_8_i16.c: Regenerate. + * generated/maxloc0_4_r10.c: Regenerate. + * generated/maxloc0_8_i16.c: Regenerate. + * generated/minloc1_8_r10.c: Regenerate. + * generated/minloc0_16_r4.c: Regenerate. + * generated/maxloc1_8_r10.c: Regenerate. + * generated/maxloc0_16_r4.c: Regenerate. + * generated/minloc1_16_r8.c: Regenerate. + * generated/minloc0_8_i1.c: Regenerate. + * generated/maxloc0_4_i4.c: Regenerate. + * generated/maxloc1_16_r8.c: Regenerate. + * generated/maxloc0_8_i2.c: Regenerate. + * generated/nearest_r16.c: Regenerate. + * generated/maxloc1_16_r10.c: Regenerate. + * generated/minloc0_16_i2.c: Regenerate. + * generated/minloc1_8_r8.c: Regenerate. + * generated/maxloc0_16_i2.c: Regenerate. + * generated/exponent_r4.c: Regenerate. + * generated/spacing_r10.c: Regenerate. + * generated/maxval_r10.c: Regenerate. + * generated/minval_i1.c: Regenerate. + * generated/maxloc1_4_i1.c: Regenerate. + * generated/minloc1_4_i8.c: Regenerate. + * generated/minloc0_8_r4.c: Regenerate. + * generated/minloc0_16_r16.c: Regenerate. + * generated/minloc0_4_i4.c: Regenerate. + * generated/minloc0_8_i2.c: Regenerate. + * generated/minval_r4.c: Regenerate. + * generated/maxloc1_4_r4.c: Regenerate. + * generated/maxval_r8.c: Regenerate. + * generated/minval_r16.c: Regenerate. + * generated/minloc1_4_i1.c: Regenerate. + * generated/minval_i2.c: Regenerate. + * generated/maxloc1_4_i2.c: Regenerate. + * generated/maxloc1_8_i8.c: Regenerate. + * generated/maxloc0_4_r8.c: Regenerate. + * generated/maxloc0_16_r16.c: Regenerate. + * generated/minloc1_4_r16.c: Regenerate. + * generated/fraction_r8.c: Regenerate. + * generated/maxloc1_4_r16.c: Regenerate. + * generated/set_exponent_r4.c: Regenerate. + * generated/minloc0_8_r16.c: Regenerate. + * generated/maxloc0_8_r16.c: Regenerate. + * generated/nearest_r10.c: Regenerate. + * generated/maxloc0_8_i4.c: Regenerate. + * generated/minloc1_4_r4.c: Regenerate. + * generated/minloc0_16_i4.c: Regenerate. + * generated/maxloc0_16_i4.c: Regenerate. + * generated/nearest_r4.c: Regenerate. + * generated/minloc1_16_i8.c: Regenerate. + * generated/maxloc1_16_i8.c: Regenerate. + * generated/minloc1_4_i2.c: Regenerate. + * generated/maxloc1_8_i1.c: Regenerate. + * generated/minloc0_16_r10.c: Regenerate. + * generated/minloc1_8_i8.c: Regenerate. + * generated/minloc0_4_r8.c: Regenerate. + * generated/minloc0_8_i4.c: Regenerate. + * generated/minloc1_16_i16.c: Regenerate. + * generated/spacing_r8.c: Regenerate. + * generated/maxloc1_8_r4.c: Regenerate. + * generated/minloc1_16_i1.c: Regenerate. + * generated/maxloc1_16_i1.c: Regenerate. + * generated/minval_r10.c: Regenerate. + * generated/minval_i4.c: Regenerate. + * generated/minloc1_8_i1.c: Regenerate. + * generated/maxloc1_4_i4.c: Regenerate. + * generated/maxloc1_8_i2.c: Regenerate. + * generated/maxval_i8.c: Regenerate. + * generated/maxloc0_16_r10.c: Regenerate. + * generated/rrspacing_r4.c: Regenerate. + * generated/minloc0_4_i16.c: Regenerate. + * generated/maxloc0_8_r8.c: Regenerate. + * generated/maxloc0_4_i16.c: Regenerate. + * generated/minloc1_4_r10.c: Regenerate. + * generated/minloc1_8_i16.c: Regenerate. + * generated/maxloc1_4_r10.c: Regenerate. + * generated/minloc0_8_r10.c: Regenerate. + * generated/maxloc1_8_i16.c: Regenerate. + * generated/maxloc0_8_r10.c: Regenerate. + * generated/minloc1_16_r4.c: Regenerate. + * generated/maxloc1_16_r4.c: Regenerate. + * generated/minloc0_16_r8.c: Regenerate. + * generated/maxloc0_16_r8.c: Regenerate. + * generated/maxloc0_4_i8.c: Regenerate. + * generated/maxloc1_16_i16.c: Regenerate. + * generated/minloc1_8_r4.c: Regenerate. + * generated/minloc1_16_i2.c: Regenerate. + * generated/maxloc1_16_i2.c: Regenerate. + * generated/maxval_i16.c: Regenerate. + * generated/exponent_r8.c: Regenerate. + * generated/minloc1_4_i4.c: Regenerate. + * generated/maxval_i1.c: Regenerate. + * generated/minloc1_8_i2.c: Regenerate. + * generated/minloc0_8_r8.c: Regenerate. + * generated/set_exponent_r16.c: Regenerate. + * generated/maxloc0_4_i1.c: Regenerate. + * generated/rrspacing_r16.c: Regenerate. + * generated/minloc0_4_i8.c: Regenerate. + * generated/maxval_r4.c: Regenerate. + * configure: Regenerate. + * config.h.in: Regenerate. + +2007-04-06 Jerry DeLisle + + PR libfortran/31395 + * io/format.c (parse_format_list): Fix parsing. + +2007-04-03 Francois-Xavier Coudert + + PR fortran/31304 + intrinsics/string_intrinsics.c (string_repeat): Remove. + +2007-04-01 Jerry DeLisle + + PR libfortran/31052 + * io/open.c (test_endfile): Delete this function. + (edit_modes): Delete call to test_endfile. + (new_unit): Likewise. + * io/io.h: Delete prototype for test_endfile. + * io/transfer.c (next_record_r): Remove use of test_endfile. + (st_read): Add test for end file condition and adjust status. + +2007-04-01 Jerry DeLisle + + PR libfortran/31366 + * io/transfer.c (read_block_direct): Do not generate error when reading + past EOF on a short record that is less than the RECL= specified. + +2007-04-01 Jerry DeLisle + + PR libfortran/31207 + * io/unit.c (close_unit_1): If there are bytes previously written from + ADVANCE="no", move to the end before closing. + +2007-03-31 Francois-Xavier Coudert + + PR libfortran/31335 + * intrinsics/stat.c: Only provide STAT and FSTAT library routines + if stat() and fstat() library functions are available. When lstat() + is not available, use stat() instead. + * configure.ac: Add checks for stat, fstat and lstat. + * configure: Regenerate. + * config.h.in: Regenerate. + +2007-03-27 Jerry DeLisle + + PR libfortran/31052 + * io/transfer.c (next_record_r): Do not call test_endfile if in + namelist mode. + +2007-03-25 Jerry DeLisle + + PR libfortran/31199 + * io/io.h: Add saved_pos to gfc_unit structure. + * io/open.c (new_unit): Initialize saved_pos. + * io/transfer.c (data_transfer_init): Set max_pos to value in + saved_pos. + (next_record_w): Fix whitespace. + (finalze_transfer): Calculate max_pos for ADVANCE="no" and save it for + later use. If not ADVANCE="no" set saved_pos to zero. + +2007-03-25 Thomas Koenig + + PR libfortran/31196 + * intrinsics/reshape_generic.c (reshape_internal): Increment + correct variable. + +2007-03-22 Jerry DeLisle + + PR libfortran/31052 + * file_pos.c: Update Copyright year. + * io/open.c (test_endfile): Restore test_endfile to fix SPEC + regression. Update Copyright year. + * io/io.h: Same. + * io/unix.c (is_special): Add missing type for this function. + Update Copyright year. + * io/transfer.c (next_record_r): Restore test_endfile. + (st_read): Fix whitespace. Update Copyright year + +2007-03-20 Francois-Xavier Coudert + + * configure.ac: Add missing check for gettimeofday. + * config.h.in: Renegerate. + * configure: Regenerate. + +2007-03-18 Jerry DeLisle + + PR libfortran/31052 + * io/file_position (st_rewind): Fix comments. Remove use of + test_endfile. Don't seek if already at 0 position. Use new is_special + function to set endfile state. + * io/open.c (test_endfile): Delete this function. + * io/io.h: Delete prototype for test_endfile. Add prototype + for is_special. + * io/unix.c (is_special): New function. Fix whitespace. + * io/transfer.c (next_record_r): Remove use of test_endfile. + +2007-03-16 David Edelsohn + + * runtime/main.c: Include "config.h" first. + +2007-03-15 Jerry DeLisle + + PR libfortran/31099 + * io/file_pos.c (st_rewind): Don't set bytes_left to zero. + +2007-03-15 Francois-Xavier Coudert + + * runtime/backtrace.c: New file. + * runtime/environ.c (variable_table): New GFORTRAN_ERROR_BACKTRACE + environment variable. + * runtime/compile_options.c (set_std): Add new argument. + * runtime/main.c (store_exe_path, full_exe_path): New functions. + * runtime/error.c (sys_exit): Add call to show_backtrace. + * libgfortran.h (options_t): New backtrace field. + (store_exe_path, full_exe_path, show_backtrace): New prototypes. + * configure.ac: Add checks for execinfo.h, execvp, pipe, dup2, + close, fdopen, strcasestr, getrlimit, backtrace, backtrace_symbols + and getppid. + * Makefile.am: Add runtime/backtrace.c. + * fmain.c (main): Add call to store_exe_path. + * Makefile.in: Renegerate. + * config.h.in: Renegerate. + * configure: Regenerate. + +2007-03-14 Jerry DeLisle + + PR libfortran/31051 + * io/transfer.c (formatted_transfer_scalar): Adjust position for + pending spaces when in writing mode. Clean up some formatting. + +2007-03-14 Thomas Koenig + + PR libfortran/30690 + * all.m4: Quote everything, except for m4 macros. + * any.m4: Likewise. + * count.m4: Likewise. + * cshift1.m4: Likewise. + * eoshift1.m4: Likewise. + * eoshift3.m4: Likewise. + * exponent.m4: Likewise. + * fraction.m4: Likewise. + * in_pack.m4: Likewise. + * in_unpack.m4: Likewise. + * matmul.m4: Likewise. + * matmull.m4: Likewise. + * nearest.m4: Likewise. + * pow.m4: Likewise. + * product.m4: Likewise. + * reshape.m4: Likewise. + * rrspacing.m4: Likewise. + * set_exponent.m4: Likewise. + * shape.m4: Likewise. + * spacing.m4: Likewise. + * transpose.m4: Likewise. + +2007-03-14 Jakub Jelinek + + * io/unix.c (regular_file): For ACTION_UNSPECIFIED retry with + O_RDONLY even if errno is EROFS. + +2007-03-09 Jerry DeLisle + + PR libfortran/31099 + * io/open.c (new_unit): Initialize bytes_left and recl_subrecord. + * io/transfer.c (next_record_w): Set bytes left to record length for + sequential unformatted I/O. + (next_record_r): Ditto. + (read_block_direct): Fix test for exceeding bytes_left. + +2007-03-08 Daniel Franke + + PR fortran/30947 + * intrinsics/signal.c (alarm_sub_int): Avoid SEGFAULT with + integer arguments. + +2007-03-04 Thomas Koenig + + PR libfortran/30981 + * m4/pow_m4: Use appropriate unsigned int type for u. + * generated/pow_c10_i16.c: Regenerated. + * generated/pow_c10_i4.c: Regenerated. + * generated/pow_c10_i8.c: Regenerated. + * generated/pow_c16_i16.c: Regenerated. + * generated/pow_c16_i4.c: Regenerated. + * generated/pow_c16_i8.c: Regenerated. + * generated/pow_c4_i16.c: Regenerated. + * generated/pow_c4_i4.c: Regenerated. + * generated/pow_c4_i8.c: Regenerated. + * generated/pow_c8_i16.c: Regenerated. + * generated/pow_c8_i4.c: Regenerated. + * generated/pow_c8_i8.c: Regenerated. + * generated/pow_i16_i16.c: Regenerated. + * generated/pow_i16_i4.c: Regenerated. + * generated/pow_i16_i8.c: Regenerated. + * generated/pow_i4_i16.c: Regenerated. + * generated/pow_i4_i4.c: Regenerated. + * generated/pow_i4_i8.c: Regenerated. + * generated/pow_i8_i16.c: Regenerated. + * generated/pow_i8_i4.c: Regenerated. + * generated/pow_i8_i8.c: Regenerated. + * generated/pow_r10_i16.c: Regenerated. + * generated/pow_r10_i4.c: Regenerated. + * generated/pow_r10_i8.c: Regenerated. + * generated/pow_r16_i16.c: Regenerated. + * generated/pow_r16_i4.c: Regenerated. + * generated/pow_r16_i8.c: Regenerated. + * generated/pow_r4_i16.c: Regenerated. + * generated/pow_r4_i4.c: Regenerated. + * generated/pow_r4_i8.c: Regenerated. + * generated/pow_r8_i16.c: Regenerated. + * generated/pow_r8_i4.c: Regenerated. + * generated/pow_r8_i8.c: Regenerated. + +2007-03-03 Francois-Xavier Coudert + + PR libfortran/31001 + * intrinsics/pack_generic.c (pack_internal): Add special checks + for zero-sized arrays. + +2007-03-01 Brooks Moses + + * Makefile.am: Add dummy install-pdf target. + * Makefile.in: Regenerate + +2007-02-24 Jerry DeLisle + + PR libfortran/30918 + * io/listread.c (namelist_read): Eat comment line. + +2007-02-22 Jerry DeLisle + + PR libfortran/30910 + * io/write.c (output_float): Add condition of format F only for + special case rounding with zero precision. + +2007-02-19 Thomas Koenig + + PR libfortran/30533 + PR libfortran/30765 + * Makefile.am: Add $(srcdir) too all files in generated/. + (i_maxloc0_c): Add maxloc0_4_i1.c, maxloc0_8_i1.c, + maxloc0_16_i1.c, maxloc0_4_i2.c, maxloc0_8_i2.c and + maxloc0_16_i2.c. + (i_maxloc1_c): Add maxloc1_4_i1.c, maxloc1_8_i1.c, + maxloc1_16_i1.c, maxloc1_4_i2.c, maxloc1_8_i2.c and + maxloc1_16_i2.c. + (i_maxval_c): Add maxval_i1.c and maxval_i2.c. + (i_minloc0_c): Add minloc0_4_i1.c, minloc0_8_i1.c, + minloc0_16_i1.c, minloc0_4_i2.c, minloc0_8_i2.c and + minloc0_16_i2.c. + (i_minloc_1.c): Add minloc1_4_i1.c, minloc1_8_i1.c, + minloc1_16_i1.c, minloc1_4_i2.c, minloc1_8_i2.c and + minloc1_16_i2.c. + (i_minval_c): Add minval_i1.c and minval_i2.c. + (i_sum_c): Add sum_i1.c and sum_i2.c. + (i_product_c): Add product_i1.c and product_i2.c. + (i_matmul_c): Add matmul_i1.c and matmul_i2.c. + (gfor_built_specific_src): Remove $(srcdir) from target. + (gfor_bulit_specific2_src): Likewise. + Makefile.in: Regenerated. + libgfortran.h: Add GFC_INTEGER_1_HUGE and GFC_INTEGER_2_HUGE. + Add gfc_array_i1 and gfc_array_i2. + * generated/matmul_i1.c: New file. + * generated/matmul_i2.c: New file. + * generated/maxloc0_16_i1.c: New file. + * generated/maxloc0_16_i2.c: New file. + * generated/maxloc0_4_i1.c: New file. + * generated/maxloc0_4_i2.c: New file. + * generated/maxloc0_8_i1.c: New file. + * generated/maxloc0_8_i2.c: New file. + * generated/maxloc1_16_i1.c: New file. + * generated/maxloc1_16_i2.c: New file. + * generated/maxloc1_4_i1.c: New file. + * generated/maxloc1_4_i2.c: New file. + * generated/maxloc1_8_i1.c: New file. + * generated/maxloc1_8_i2.c: New file. + * generated/maxval_i1.c: New file. + * generated/maxval_i2.c: New file. + * generated/minloc0_16_i1.c: New file. + * generated/minloc0_16_i2.c: New file. + * generated/minloc0_4_i1.c: New file. + * generated/minloc0_4_i2.c: New file. + * generated/minloc0_8_i1.c: New file. + * generated/minloc0_8_i2.c: New file. + * generated/minloc1_16_i1.c: New file. + * generated/minloc1_16_i2.c: New file. + * generated/minloc1_4_i1.c: New file. + * generated/minloc1_4_i2.c: New file. + * generated/minloc1_8_i1.c: New file. + * generated/minloc1_8_i2.c: New file. + * generated/minval_i1.c: New file. + * generated/minval_i2.c: New file. + * generated/product_i1.c: New file. + * generated/product_i2.c: New file. + * generated/sum_i1.c: New file. + * generated/sum_i2.c: New file. + +2007-02-16 Francois-Xavier Coudert + + * runtime/memory.c (deallocate): Correct comment. + +2007-02-10 Thomas Koenig + + * Makefile.am: Use $(M4) instead of m4. + * Makefile.in: Regenerate. + +2007-02-10 Thomas Koenig + + * Makefile.am: Remove $(srcdir) from assorted targets + in maintainer mode. + * Makefile.in: Regenerate. + +2007-02-09 Thomas Koenig + Tobias Burnus + + PR fortran/30512 + * m4/iparm.m4: Use HUGE-1 for most negative integer. + * generated/maxloc1_8_i4.c: Regenerate. + * generated/maxloc0_8_i8.c: Regenerate. + * generated/maxloc1_16_i4.c: Regenerate. + * generated/maxloc0_16_i8.c: Regenerate. + * generated/maxval_i4.c: Regenerate. + * generated/maxloc1_4_i8.c: Regenerate. + * generated/maxloc0_16_i16.c: Regenerate. + * generated/maxloc1_4_i16.c: Regenerate. + * generated/maxloc0_8_i16.c: Regenerate. + * generated/maxloc0_4_i4.c: Regenerate. + * generated/maxloc1_8_i8.c: Regenerate. + * generated/maxloc0_8_i4.c: Regenerate. + * generated/maxloc0_16_i4.c: Regenerate. + * generated/maxloc1_16_i8.c: Regenerate. + * generated/maxloc1_4_i4.c: Regenerate. + * generated/maxval_i8.c: Regenerate. + * generated/maxloc0_4_i16.c: Regenerate. + * generated/maxloc1_8_i16.c: Regenerate. + * generated/maxloc0_4_i8.c: Regenerate. + * generated/maxloc1_16_i16.c: Regenerate. + * generated/maxval_i16.c: Regenerate. + +2007-02-04 Francois-Xavier Coudert + + PR fortran/30611 + * intrinsics/string_intrinsics.c (string_repeat): Don't check + if ncopies is negative. + +2007-02-04 Francois-Xavier Coudert + + PR libfortran/30007 + * libgfortran.h: Do not prefix symbol name with + __USER_LABEL_PREFIX__ when used in __attribute__((__alias__(...))). + +2007-02-02 Paul Thomas + + PR fortran/30284 + PR fortran/30626 + * io/transfer.c (init_loop_spec, next_array_record): Change to + lbound rather than unity base. + +2007-01-21 Francois-Xavier Coudert + + * runtime/error.c: Include sys/time.h before sys/resource.h. + +2007-01-21 Thomas Koenig + + PR libfortran/30525 + * intrinsics/string_intrinsics.c(compare_string): Make + sure that comparisons are done unsigned. + +2007-01-21 Tobias Burnus + + PR libfortran/30015 + * intrinsics/date_and_time.c (date_and_time): Fix case where time + can go backwards. + * configure.ac: Remove AC_TRY_RUN test for timezone in + gettimeofday. + * acinclude.m4: Ditto. + * configure: Regenerate. + * config.h.in: Regenerate. + +2007-01-20 Francois-Xavier Coudert + + * m4/misc_specifics.m4: Add _gfortran prefix to specific names. + * m4/specific2.m4: Likewise. + * m4/specific.m4: Likewise. + * intrinsics/f2c_specifics.F90: Likewise. + * intrinsics/selected_int_kind.f90: Add _gfortran prefix. + * intrinsics/selected_real_kind.f90: Likewise. + * intrinsics/dprod_r8.f90: Likewise. + * Makefile.am: Add -fallow-leading-underscore to the + gfor_specific_src files, as well as selected_real_kind.F90 + and selected_int_kind.F90 + * Makefile.in: Regenerate. + * generated/_sqrt_c8.F90: Regenerate. + * generated/_sign_r16.F90: Regenerate. + * generated/_log_c16.F90: Regenerate. + * generated/_sin_c10.F90: Regenerate. + * generated/_tanh_r4.F90: Regenerate. + * generated/_tanh_r8.F90: Regenerate. + * generated/_log10_r10.F90: Regenerate. + * generated/_aimag_c4.F90: Regenerate. + * generated/_sign_r4.F90: Regenerate. + * generated/_aimag_c8.F90: Regenerate. + * generated/_sign_r8.F90: Regenerate. + * generated/_mod_i4.F90: Regenerate. + * generated/_cos_r16.F90: Regenerate. + * generated/_aint_r10.F90: Regenerate. + * generated/_mod_i8.F90: Regenerate. + * generated/_abs_i16.F90: Regenerate. + * generated/_sqrt_c10.F90: Regenerate. + * generated/_atan2_r4.F90: Regenerate. + * generated/_cos_c4.F90: Regenerate. + * generated/_atan_r16.F90: Regenerate. + * generated/_tanh_r10.F90: Regenerate. + * generated/_atan2_r8.F90: Regenerate. + * generated/_cos_c8.F90: Regenerate. + * generated/_exp_r4.F90: Regenerate. + * generated/_log_r10.F90: Regenerate. + * generated/_exp_r8.F90: Regenerate. + * generated/_abs_r4.F90: Regenerate. + * generated/_abs_r8.F90: Regenerate. + * generated/_sin_r16.F90: Regenerate. + * generated/_tan_r4.F90: Regenerate. + * generated/_tan_r8.F90: Regenerate. + * generated/_sign_i4.F90: Regenerate. + * generated/_sign_i8.F90: Regenerate. + * generated/_exp_c16.F90: Regenerate. + * generated/_sqrt_r16.F90: Regenerate. + * generated/_conjg_c4.F90: Regenerate. + * generated/_conjg_c8.F90: Regenerate. + * generated/_dim_r16.F90: Regenerate. + * generated/_mod_r10.F90: Regenerate. + * generated/_abs_c10.F90: Regenerate. + * generated/_conjg_c16.F90: Regenerate. + * generated/_tan_r16.F90: Regenerate. + * generated/_asinh_r10.F90: Regenerate. + * generated/_abs_i4.F90: Regenerate. + * generated/_abs_i8.F90: Regenerate. + * generated/_acos_r10.F90: Regenerate. + * generated/_exp_r10.F90: Regenerate. + * generated/_acosh_r16.F90: Regenerate. + * generated/_atan2_r16.F90: Regenerate. + * generated/_cos_c16.F90: Regenerate. + * generated/_mod_i16.F90: Regenerate. + * generated/_asin_r4.F90: Regenerate. + * generated/_anint_r16.F90: Regenerate. + * generated/_asin_r8.F90: Regenerate. + * generated/_aimag_c10.F90: Regenerate. + * generated/_exp_c4.F90: Regenerate. + * generated/_sinh_r10.F90: Regenerate. + * generated/_exp_c8.F90: Regenerate. + * generated/_log10_r4.F90: Regenerate. + * generated/_log10_r8.F90: Regenerate. + * generated/_abs_c4.F90: Regenerate. + * generated/_abs_r16.F90: Regenerate. + * generated/_abs_c8.F90: Regenerate. + * generated/_asin_r10.F90: Regenerate. + * generated/_sign_r10.F90: Regenerate. + * generated/_atanh_r16.F90: Regenerate. + * generated/_log_c10.F90: Regenerate. + * generated/_cosh_r16.F90: Regenerate. + * generated/_sin_c16.F90: Regenerate. + * generated/_cos_r10.F90: Regenerate. + * generated/_log10_r16.F90: Regenerate. + * generated/_aint_r16.F90: Regenerate. + * generated/_acos_r4.F90: Regenerate. + * generated/_acos_r8.F90: Regenerate. + * generated/_sqrt_c16.F90: Regenerate. + * generated/_acosh_r4.F90: Regenerate. + * generated/_atan_r10.F90: Regenerate. + * generated/_acosh_r8.F90: Regenerate. + * generated/_sign_i16.F90: Regenerate. + * generated/_tanh_r16.F90: Regenerate. + * generated/_log_r4.F90: Regenerate. + * generated/_log_r8.F90: Regenerate. + * generated/_sin_r4.F90: Regenerate. + * generated/_sin_r8.F90: Regenerate. + * generated/_log_r16.F90: Regenerate. + * generated/_sin_r10.F90: Regenerate. + * generated/_sqrt_r4.F90: Regenerate. + * generated/_exp_c10.F90: Regenerate. + * generated/_sqrt_r8.F90: Regenerate. + * generated/_asinh_r4.F90: Regenerate. + * generated/_sqrt_r10.F90: Regenerate. + * generated/_asinh_r8.F90: Regenerate. + * generated/_dim_r4.F90: Regenerate. + * generated/_dim_r8.F90: Regenerate. + * generated/_dim_r10.F90: Regenerate. + * generated/_cosh_r4.F90: Regenerate. + * generated/_conjg_c10.F90: Regenerate. + * generated/_tan_r10.F90: Regenerate. + * generated/_cosh_r8.F90: Regenerate. + * generated/_mod_r16.F90: Regenerate. + * generated/_abs_c16.F90: Regenerate. + * generated/_cos_r4.F90: Regenerate. + * generated/_asinh_r16.F90: Regenerate. + * generated/_cos_r8.F90: Regenerate. + * generated/_atanh_r4.F90: Regenerate. + * generated/_atanh_r8.F90: Regenerate. + * generated/_acos_r16.F90: Regenerate. + * generated/_anint_r4.F90: Regenerate. + * generated/_acosh_r10.F90: Regenerate. + * generated/_anint_r8.F90: Regenerate. + * generated/_exp_r16.F90: Regenerate. + * generated/_mod_r4.F90: Regenerate. + * generated/_cos_c10.F90: Regenerate. + * generated/_atan2_r10.F90: Regenerate. + * generated/_dim_i16.F90: Regenerate. + * generated/_mod_r8.F90: Regenerate. + * generated/_anint_r10.F90: Regenerate. + * generated/_aint_r4.F90: Regenerate. + * generated/_aint_r8.F90: Regenerate. + * generated/_dim_i4.F90: Regenerate. + * generated/_sinh_r4.F90: Regenerate. + * generated/_log_c4.F90: Regenerate. + * generated/_dim_i8.F90: Regenerate. + * generated/_sinh_r8.F90: Regenerate. + * generated/_log_c8.F90: Regenerate. + * generated/_sin_c4.F90: Regenerate. + * generated/_sin_c8.F90: Regenerate. + * generated/misc_specifics.F90: Regenerate. + * generated/_abs_r10.F90: Regenerate. + * generated/_aimag_c16.F90: Regenerate. + * generated/_atan_r4.F90: Regenerate. + * generated/_sinh_r16.F90: Regenerate. + * generated/_atan_r8.F90: Regenerate. + * generated/_atanh_r10.F90: Regenerate. + * generated/_cosh_r10.F90: Regenerate. + * generated/_sqrt_c4.F90: Regenerate. + * generated/_asin_r16.F90: Regenerate. + +2007-01-19 Francois-Xavier Coudert + + PR libfortran/26893 + * acinclude.m4 (LIBGFOR_WORKING_GFORTRAN): New check. + * configure.ac: Add call to LIBGFOR_WORKING_GFORTRAN. + * configure: Regenerate. + * config.h.in: Regenerate because it was forgottent in the last + commit. + +2007-01-18 Francois-Xavier Coudert + Tobias Burnus + + PR libfortran/29649 + * runtime/environ.c (variable_table): New GFORTRAN_ERROR_DUMPCORE + environment variable. + * runtime/compile_options.c (set_std): Add new argument. + * runtime/error.c (sys_exit): Move from io/unix.c. Add coredump + functionality. + * libgfortran.h (options_t): New dump_core and backtrace members. + (sys_exit): Move prototype. + * io/unix.c (sys_exit): Move to runtime/error.c. + * configure.ac: Add check for getrlimit. + * configure: Regenerate. + +2007-01-17 Tom Tromey + + PR libfortran/27107: + * aclocal.m4, configure, Makefile.in: Rebuilt. + * configure.ac: Enable automake dependency tracking. Update + minimum automake version. + +2007-01-17 Francois-Xavier Coudert + + PR libfortran/27107 + * runtime/environ.c: Don't include io/io.h. + * runtime/string.c: Don't include io/io.h. + (compare0): Add cast to avoid warning. + * runtime/error.c: Don't include io/io.h. + (st_printf): Move to io/unix.c. + * intrinsics/flush.c: Delete, contents moved to io/intrinsics.c. + * intrinsics/fget.c: Likewise. + * intrinsics/ftell.c: Likewise. + * intrinsics/tty.c: Likewise. + * libgfortran.h (DEFAULT_RECL, notification_std, + get_unformatted_convert, IOPARM_*, st_parameter_common, unit_convert, + DEFAULT_TEMPDIR): New declarations. + * io/io.h (DEFAULT_RECL, notification_std, get_unformatted_convert, + IOPARM_*, st_parameter_common, unit_convert, DEFAULT_TEMPDIR): + Move to libgfortran.h. + * io/unix.c: Add io/unix.h content. + (st_printf): New function. + * io/intrinsics.c: New file. + * io/unix.h: Remove, contents moved into unix.c. + * libtool-version: Update library version to 3.0.0. + * configure.ac: Update library version to 0.3. + * Makefile.am (intrinsics/fget.c, intrinsics/flush.c, + intrinsics/ftell.c, intrinsics/tty.c, libgfortran.h): Remove targets. + * Makefile.in: Regenerate. + * configure: Regenerate. + +2007-01-12 Jerry DeLisle + + PR libfortran/30435 + * io/list_read.c (finish_separator): Don't call next_record. + (list_formatted_read_scalar): Clean up some comments and whitespace. + (nml_read_obj): Whitespace fix. + +2007-01-05 Jerry DeLisle + + PR libfortran/30162 + * io/unix.c (fd_flush): Don't seek if file is not seekable, defined as + s->file_length == -1. + (fd_alloc_w_at): Do not adjust file_length if file is not seekable. + (fd_seek): If not seekable, just return success. + (fd_truncate): If not seekable, no need to truncate. Return failure + if seek fails and the stream is not a pipe. + (fd_to_stream): Make test for non-seekable file more robust. + +2007-01-01 Steven G. Kargl + + * ChangeLog: Copied to ... + * ChangeLog-2006: here. + + +Copyright (C) 2007 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/libgfortran/ChangeLog-2008 b/libgfortran/ChangeLog-2008 new file mode 100644 index 000000000..6b3139995 --- /dev/null +++ b/libgfortran/ChangeLog-2008 @@ -0,0 +1,2532 @@ +2008-12-29 John David Anglin + + PR fortran/31832 + * acinclude.m4 (LIBGFOR_CHECK_FOR_BROKEN_POWF): New autoconf check for + broken powf. + * configure.ac (LIBGFOR_CHECK_FOR_BROKEN_POWF): Use it. + * intrinsics/c99_functions.c: Use internal powf implementation if + HAVE_BROKEN_POWF is defined. + * configure: Rebuilt. + * config.h.in: Rebuilt. + +2008-12-22 Jerry DeLisle + + PR libfortran/37472 + * io/write_float.def (output_float_FMT_G_): Modify calculation of temp + to avoid sensitivity to round-off. + +2008-12-21 Jerry DeLisle + + PR libfortran/38398 + * io/io.h (st_parameter_dt): Add new bit to keep track of when to + suppress blanks for g0 formatting. + * io/transfer.c (formatted_transfer_scalar): Always call write_real_g0 + for g0 formatting. + * io.c (write.c): Do not use ES formatting and use new bit to suppress + blanks. + * io/write_float.def (output_float): Adjust the location of setting the + width so that it can be adjusted when suppressing blanks. Set number of + blanks to zero when dtp->u.p.g0_no_blanks is set. Do some minor code + clean-up and add some white space for readability. + +2008-12-18 Ralf Wildenhues + + * configure: Regenerate. + +2008-12-13 Jerry DeLisle + + PR libfortran/38504 + io/write.c (write_decimal): Skip extra sign '-' at beginning of string + returned by gfc_itoa. + +2008-12-08 Jerry DeLisle + + PR libfortran/38430 + * io/transfer.c (data_transfer_init): Move constraint check for REC= + and STREAM access into condition for other REC= constraints to simplify. + Comment out this constraint to avoid breaking compatibility with 4.3 + until later. Added a TODO for above comment and this one. + Fix test for max pos. + +2008-12-06 Jerry DeLisle + + PR libfortran/38291 + * io/transfer.c (data_transfer_init): Add fbuf_flush inadvertently + ommitted. Add check for invalid use of REC= with ACCESS="stream". Fix + comment. + +2008-12-06 Adam Nemet + + * runtime/main.c (store_exe_path): Don't crash if argv0 is NULL. + +2008-12-05 Jerry DeLisle + + PR libfortran/38291 + * io/transfer.c (data_transfer_init): Add checks for POS= valid range. + Add check for unit opened with ACCESS="stream". Flush and seek if + current stream position does not match. Check ENDFILE on read. + +2008-12-04 Jerry DeLisle + + PR fortran/38285 + * write_float.def (WRITE_FLOAT): Zero the float value for special case + only if scale_factor = 0. + +2008-11-23 Thomas Koenig + + PR libfortran/38234 + * intrinsics/reshape_generic.c (reshape_internal): + Source can be larger than shape. + * m4/reshape.m4: Likewise. + * generated/reshape_c10.c Regenerated. + * generated/reshape_c16.c Regenerated. + * generated/reshape_c4.c Regenerated. + * generated/reshape_c8.c Regenerated. + * generated/reshape_i16.c Regenerated. + * generated/reshape_i4.c Regenerated. + * generated/reshape_i8.c Regenerated. + * generated/reshape_r10.c Regenerated. + * generated/reshape_r16.c Regenerated. + * generated/reshape_r4.c Regenerated. + * generated/reshape_r8.c Regenerated. + +2008-11-22 Danny Smith + + * libgfortran.h (__mingw_snprintf): Declare with gnu_printf + format attribute. + + +2008-11-22 Thomas Koenig + + PR libfortran/38225 + * intrinsics/reshape_generic.c (reshape_internal): + Use all dimensions of source for bounds checking. + * m4/reshape.m4: Likewise. + * generated/reshape_c10.c Regenerated. + * generated/reshape_c16.c Regenerated. + * generated/reshape_c4.c Regenerated. + * generated/reshape_c8.c Regenerated. + * generated/reshape_i16.c Regenerated. + * generated/reshape_i4.c Regenerated. + * generated/reshape_i8.c Regenerated. + * generated/reshape_r10.c Regenerated. + * generated/reshape_r16.c Regenerated. + * generated/reshape_r4.c Regenerated. + * generated/reshape_r8.c Regenerated. + +2008-11-22 Jakub Jelinek + + PR libfortran/37839 + * io/io.h (IOPARM_INQUIRE_HAS_ROUND, IOPARM_INQUIRE_HAS_SIGN, + IOPARM_INQUIRE_HAS_PENDING): Adjust values. + (st_parameter_inquire): Reorder and fix types of round, sign and + pending fields. + (st_parameter_43, st_parameter_44): Removed. + (st_parameter_dt): Put back struct definition directly to u.p + declaration. Change type of u.p.size_used from gfc_offset to + GFC_IO_INT. Decrease back size of u.pad to 16 pointers and + 32 ints. Put id, pos, asynchronous, blank, decimal, delim, + pad, round and sign fields after the union. + * io/inquire.c (inquire_via_unit, inquire_via_filename): Only read + flags2 if it is defined. + * io/transfer.c (read_sf, read_block_form, write_block): Cast + additions to size_used to GFC_IO_INT instead of gfc_offset. + (data_transfer_init): Clear whole u.p struct. Adjust + for moving id, pos, asynchronous, blank, decimal, delim, pad, + round and sign fields from u.p directly into st_parameter_dt. + (finalize_transfer): Don't cast size_used to GFC_IO_INT. + * io/file_pos.c (st_endfile): Clear whole u.p struct. + +2008-11-20 Jerry DeLisle + + PR libfortran/37472 + * io/write_float.def (output_float_FMT_G_): Adjust conversion of + G format specification to F format. + +2008-11-18 Thomas Koenig + + PR libfortran/38135 + * m4/reshape.m4: Correct bounds checking when PAD is present. + Treat PAD as if it were SOURCE when SOURCE is empty. + * intrinsics/reshape_generic.c: Likewise. + * generated/reshape_c10.c Regenerated. + * generated/reshape_c16.c Regenerated. + * generated/reshape_c4.c Regenerated. + * generated/reshape_c8.c Regenerated. + * generated/reshape_i16.c Regenerated. + * generated/reshape_i4.c Regenerated. + * generated/reshape_i8.c Regenerated. + * generated/reshape_r10.c Regenerated. + * generated/reshape_r16.c Regenerated. + * generated/reshape_r4.c Regenerated. + * generated/reshape_r8.c Regenerated. + +2008-11-16 Jerry DeLisle + + PR libfortran/38097 + * io/read.c (read_f): Initialize exponent. Fix comment. Set loop + conditions for BZ/BN. + * io/unit.c (get_internal_unit): Initialize flags.blank. + * io/transfer.c (data_transfer_init): Fix whitespace. + +2008-11-15 Jerry DeLisle + + PR libfortran/37294 + * io/write.c (namelist_write_newline): Use array loop specification to + advance to next internal array unit record. (namelist_write): Adjust to + accomodate the internal array unit behavior. + +2008-11-01 Dennis Wassel + + PR fortran/37159 + * intrinsics/random.c: Added comment to adapt check.c, should + kiss_size change. + Few cosmetic changes to existing comments. + +2008-10-22 Jerry DeLisle + + PR libfortran/37707 + * io/list_read.c (read_character): Remove code to look ahead in namelist + reads to descriminate non-delimited strings from namelist objects. + * io/write.c (namelist_write): Delimit character strings with quote or + apostrophe, defaulting to quote. + +2008-10-21 Thomas Koenig + + PR libfortran/34670 + * intrinsics/transpose_generic.c: Implement bounds checking. + * m4/transpose.m4: Likewise. + * generated/transpose_c8.c: Regenerated. + * generated/transpose_c16.c: Regenerated. + * generated/transpose_r10.c: Regenerated. + * generated/transpose_i8.c: Regenerated. + * generated/transpose_c10.c: Regenerated. + * generated/transpose_r4.c: Regenerated. + * generated/transpose_c4.c: Regenerated. + * generated/transpose_i16.c: Regenerated. + * generated/transpose_i4.c: Regenerated. + * generated/transpose_r8.c: Regenerated. + * generated/transpose_r16.c: Regenerated. + +2008-10-19 Jerry DeLisle + + * io/file_pos.c (unformatted_backspace): Normal case is + GFC_CONVERT_NATIVE. + * io/transfer.c (read_sf): Mark paths leading to generate_error() + as unlikely. + (readl_block_form): Likewise. + (read_block_direct): Likewise. + (write_block): Likewise. + (write_buf): Likewise. + (us_read): Likewise. Normal case is GFC_CONVERT_NATIVE. + (next_record_w_unf): Mark paths leading to generate_error() + as unlikely. + +2008-10-16 Thomas Koenig + + PR libfortran/34670 + * generated/spread_r4.c: Regenerated. + +2008-10-15 Thomas Koenig + + PR libfortran/34670 + * intrinsics/reshape_generic.c: Add bounds checking. + * m4/reshape.m4: Likewise. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_i4.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/spread_r4.c: Regenerated. + +2008-10-13 Jerry DeLisle + + PR libfortran/37753 + * io/transfer.c (unformatted_read): CONVERT_NATIVE + is the usual case. Check for kind==1 for non-byte-reversing + operation. + (unformatted_write): Likewise. + +2008-10-08 Jerry DeLisle + Steve Ellcey + + * configure: Regenerate for new libtool. + * Makefile.in: Ditto. + +2008-09-25 Jerry DeLisle + + * runtime/compile_options.c (init_compile_options): + Sync flags with front end. + +2008-09-22 Jerry DeLisle + H. J. Lu + + * mk-sik-inc.sh: Make -Wunused-variable proof. + * mk-srk-inc.sh: Make -Wunused-variable proof. + +2008-09-10 Tobias Burnus + + * mk-kinds-h.sh: Make -Wunused-variable proof. + +2008-09-07 Thomas Koenig + + PR fortran/37203 + * intrinsics/reshape_generic.c: Add checking on + out-of-bounds and duplicate values of order argument. + * m4/reshape.m4: Likewise. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_i4.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + +2008-09-06 Tobias Burnus + + * libgfortran.h (likely,unlikely): New makros. + (runtime_warning_at,__mingw_snprintf): Add __attribute__(format()). + * m4/spread.m4 (spread_'rtype_code`): Use unlikely for bounds_check. + * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Ditto. + * m4/matmull.m4 (matmul_'rtype_code`): Ditto. + * m4/ifunction_logical.m4 (name`'rtype_qual`_'atype_code): Ditto. + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Ditto. + * m4/matmul.m4 (matmul_'rtype_code`): Ditto. + + * generated/minval_r8.c: Regenerated. + * generated/spread_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/spread_i8.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/any_l2.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/all_l1.c: Regenerated. + * generated/matmul_r8.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/spread_i1.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/matmul_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/all_l2.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/spread_c10.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/spread_r4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/matmul_c8.c: Regenerated. + * generated/all_l16.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/spread_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/count_4_l.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/count_8_l.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/matmul_i8.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/spread_c4.c: Regenerated. + * generated/matmul_c16.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/matmul_r10.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/matmul_l4.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/matmul_i1.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/spread_i16.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/spread_i4.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/matmul_r4.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/count_1_l.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/matmul_i2.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/matmul_c10.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/matmul_l16.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/sum_r8.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/matmul_c4.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/spread_r8.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/spread_r16.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/count_16_l.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/count_2_l.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/matmul_i4.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/spread_c8.c: Regenerated. + * generated/matmul_i16.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/any_l1.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/spread_c16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + +2008-09-01 Jerry DeLisle + + PR libfortran/37301 + PR libfortran/37228 + * io/io.h (write_real_g0): Declare new function to handle g0.d format. + * io/transfer.c (formatted_transfer_scalar): Use new function. + * io/format.c (parse_format_list): Enable g0.d. + * io/write.c (write_a_char4): Delete unused var. + (set_fnode_default): New function to set the default fnode w, d, and e + factored from write_real. (write_real): Use new factored function. + (write_real_g0): New function that sets d to that passed by g0.d format + specifier and set format to ES. Default values for w and e are used + from the new function, set_fnode_default. + +2008-09-01 Jerry DeLisle + + * runtime/error.c: Fix cast for printf. + +2008-08-30 Jerry DeLisle + + PR libfortran/36895 + * io/write.c (namelist_write_newline): New function to correctly mark + next records in both external and internal units. + (nml_write_obj): Use new function. + (namelist_write: Use new function. + +2008-08-19 Tobias Burnus + + PR libfortran/35863 + * io/write.c (write_a_char4): Add missing variable declaration + in HAVE_CRLF block. + +2008-08-15 Jerry DeLisle + + PR libfortran/35863 + * intrinsics/selected_char_kind.c: Enable iso_10646. + * io/read.c (typedef uchar): New type. + (read_utf8): New function to read a single UTF-8 encoded character. + (read_utf8_char1): New function to read UTF-8 into a KIND=1 string. + (read_default_char1): New functio to read default into KIND=1 string. + (read_utf8_char4): New function to read UTF-8 into a KIND=4 string. + (read_default_char4): New function to read UTF-8 into a KIND=4 string. + (read_a): Modify to use the new functions. + (read_a_char4): Modify to use the new functions. + * io/write.c (error.h): Add include. (typedef uchar): New type. + (write_default_char4): New function to default write KIND=4 string. + (write_utf8_char4): New function to UTF-8 write KIND=4 string. + (write_a_char4): Modify to use new functions. + (write_character): Modify to use new functions. + +2008-08-14 H.J. Lu + + PR libfortran/37123 + * intrinsics/cshift0.c (cshift0): Fix 2 typos. + +2008-08-14 Thomas Koenig + + PR libfortran/36886 + * Makefile.am: Added $(i_cshift0_c). + Added $(i_cshift0_c) to gfor_built_specific_src. + Add rule to build from cshift0.m4. + * Makefile.in: Regenerated. + * libgfortran.h: Addedd prototypes for cshift0_i1, + cshift0_i2, cshift0_i4, cshift0_i8, cshift0_i16, + cshift0_r4, cshift0_r8, cshift0_r10, cshift0_r16, + cshift0_c4, cshift0_c8, cshift0_c10, cshift0_c16. + Define Macros GFC_UNALIGNED_C4 and GFC_UNALIGNED_C8. + * intrinsics/cshift0.c: Remove helper functions for + the innter shift loop. + (cshift0): Call specific functions depending on type + of array argument. Only call specific functions for + correct alignment for other types. + * m4/cshift0.m4: New file. + * generated/cshift0_i1.c: New file. + * generated/cshift0_i2.c: New file. + * generated/cshift0_i4.c: New file. + * generated/cshift0_i8:.c New file. + * generated/cshift0_i16.c: New file. + * generated/cshift0_r4.c: New file. + * generated/cshift0_r8.c: New file. + * generated/cshift0_r10.c: New file. + * generated/cshift0_r16.c: New file. + * generated/cshift0_c4.c: New file. + * generated/cshift0_c8.c: New file. + * generated/cshift0_c10.c: New file. + * generated/cshift0_c16.c: New file. + +2008-07-27 Tobias Burnus + + PR fortran/36132 + PR fortran/29952 + PR fortran/36909 + * runtime/error.c: New function runtime_error_at. + * gfortran.map: Ditto. + * libgfortran.h: Ditto. + +2008-07-22 Jerry DeLisle + + PR fortran/36582 + * io/list_read.c: If variable rank is zero, do not adjust the found + namelist object pointer. + +2008-07-22 Daniel Kraft + + PR fortran/29835 + * io/format.c (struct format_data): New member error_element. + (unexpected_element): Added '%c' to message. + (next_char): Keep track of last parsed character in fmt->error_element. + (format_error): If the message is unexpected_element, output the + offending character, too. + +2008-07-22 Thomas Koenig + + PR libfortran/36890 + * io/file_pos.c: Declare READ_CHUNK as signed to avoid + signed/unsigned comparison warning in formatted_backspace. + +2008-07-21 Thomas Koenig + + PR libfortran/36773 + * intrinsics/cshift0.c (cshift0): Return early if size of array + is zero. + * intrinsics/eoshift0.c (eoshift0): Return early if size of + return array is zero. + * intrinsics/eoshift2.c (eoshift2): Likewise. + * m4/eoshift1.m4 (eoshift1): Return early if size of array + is zero. + * m4/eoshift3.m4 (eoshift3): Likewise. + * m4/eoshift2.m4 (eoshift2): Return early if size of return + array is zero. + * m4/eoshift4.m4 (eoshift2): Return early if size of return + array is zero. + * generated/cshift1_16.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/eoshift1_16.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + +2008-07-20 Jerry DeLisle + + PR fortran/36857 + * io/write_float.def: Comment out locale dependent code and fix general + comments. + +2008-07-07 Thomas Koenig + + PR fortran/36341 + PR fortran/34670 + * m4/matmul.m4: Add bounds checking. + * m4/matmull.m4: Likewise. + * generated/matmul_c10.c: Regenerated. + * generated/matmul_c16.c: Regenerated. + * generated/matmul_c4.c: Regenerated. + * generated/matmul_c8.c: Regenerated. + * generated/matmul_i1.c: Regenerated. + * generated/matmul_i16.c: Regenerated. + * generated/matmul_i2.c: Regenerated. + * generated/matmul_i4.c: Regenerated. + * generated/matmul_i8.c: Regenerated. + * generated/matmul_l16.c: Regenerated. + * generated/matmul_l4.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + * generated/matmul_r10.c: Regenerated. + * generated/matmul_r16.c: Regenerated. + * generated/matmul_r4.c: Regenerated. + * generated/matmul_r8.c: Regenerated. + +2008-07-07 Ralf Wildenhues + + * acinclude.m4 (LIBGFOR_CHECK_GTHR_DEFAULT): Fix configure cache + variable name. + * configure: Regenerate. + +2008-07-01 Jerry DeLisle + + PR fortran/36676 + * io/list_read.c (find_nml_name): Use eat_separator instead of eat_line. + +2008-06-28 Jerry DeLisle + + PR fortran/36657 + * io/list_read.c (read_character): Check for '!' along with separators. + (find_nml_name): Likewise and eat the comment if found. + +2008-06-17 Ralf Wildenhues + + * configure: Regenerate. + +2008-06-16 Jerry DeLisle + + PR fortran/36546 + * io/list_read.c (eat_separator): Add tab character to condition + for looping past whitespace. + +2008-06-14 Jerry DeLisle + + PR fortran/36515 + * libgfortran.h (compile_options_t): Add int range_check to structure. + * runtime/compile_options.c (set_options): Add range_check option. + (init_compile_options): Likewise. + *io/read.c (read_decimal): Change overflow checks to include + range_check. + +2008-06-13 Jerry DeLisle + + PR fortran/36538 + * io/list_read.c (namelist_read): Add eat_separator to eliminate leading + tabs. + +2008-06-13 Jerry DeLisle + + PR fortran/35863 + * libgfortran.h: Change l8_to_l4_offset to big_endian and add endian_off. + * runtime/main.c: Fix error in comment. Change l8_to_l4_offset to + big_endian. (determine_endianness): Add endian_off and set its value + according to big_endian. + * gfortran.map: Add symbol for new _gfortran_transfer_character_wide. + * io/io.h: Add prototype declarations for new functions. + * io/list_read.c (list_formatted_read_scalar): Modify to handle kind=4. + (list_formatted_read): Calculate stride based on kind for character type + and use it when calling list_formatted_read_scalar. + * io/inquire.c (inquire_via_unit): Change l8_to_l4_offset to big_endian. + * io/open.c (st_open): Change l8_to_l4_offset to big_endian. + * io/read.c (read_a_char4): New function to handle formatted read. + * io/write.c: Define GFC_CHAR4(x) to improve readability of code. + (write_a_char4): New function to handle formatted write. + (write_character): Modify to accept the kind parameter and adjust for + endianess of the machine. (list_formatted_write): Calculate the stride + resulting from the kind and adjust the list_formatted_write_scalar call + accordingly. (nml_write_obj): Adjust calls to write_character. + (namelist_write): Likewise. + * io/transfer.c (formatted_transfer_scaler): Rename 'len' argument to + 'kind' argument to better describe what it is. Add calls to new + functions for kind == 4. (formatted_transfer): Modify to handle the case + of type character and kind equals 4 to pass in the kind to the transfer + routines. (transfer_character_wide): Add this new function. + (transfer_array): Don't set kind to the character string length. Adjust + strides bases on character kind. + (unformatted_read): Adjust size based on kind for character types. + (unformatted_write): Likewise. (data_transfer_init): Change + l8_to_l4_offset to big_endian. + io/fbuf.c (fbuf_seek): Add cast to eliminate warning. + +2008-06-13 Tobias Burnus + + * configure.ac (AM_CFLAGS): Remove -Werror again. + * configure: Regenerate. + +2008-06-13 Tobias Burnus + + PR libgfortran/36518 + * configure.ac (AM_CFLAGS): Add -Werror. + * configure: Regenerate. + * m4/ifunction_logical.m4: Cast "n" to "(int)". + * generated/any_l16.c: Regenerate. + * generated/any_l2.c: Regenerate. + * generated/all_l1.c: Regenerate. + * generated/all_l2.c: Regenerate. + * generated/all_l16.c: Regenerate. + * generated/any_l4.c: Regenerate. + * generated/count_4_l.c: Regenerate. + * generated/count_8_l.c: Regenerate. + * generated/all_l4.c: Regenerate. + * generated/count_1_l.c: Regenerate. + * generated/count_16_l.c: Regenerate. + * generated/any_l8.c: Regenerate. + * generated/count_2_l.c: Regenerate. + * generated/any_l1.c: Regenerate. + * generated/all_l8.c: Regenerate. + +2008-06-13 Tobias Burnus + + PR fortran/36495 + * configure.ac (AM_FCFLAGS): Add "-Werror -fimplicit-none". + * configure: (generated) ditto. + * intrinsics/dprod_r8.f90: Add "implicit none". + +2008-06-07 Jerry DeLisle + + PR libfortran/36420 + PR libfortran/36421 + PR libfortran/36422 + * io/io.h: Add prototype for write_real. + * io/transfer.c (formatted_transfer_scalar): For FMT_G and width zero, + use write_real. + * io/format.c: Add zero width error message. (parse_format_list): Use + error message for FMT_A if followed by FMT_ZERO. Use zero width error + message for FMT_G if mode is READ or if -std=f95 or f2003. (fmormat0): + Fix typo in comment. + * io/write.c(write_a): Set wlen to len if FMT_G and length is zero. + (write_l): Add wlen variable and use it if FMT_G and width is zero. + (write_decimal): If FMT_G, set m to -1 to flag processor dependent + formatting. (write_real): Remove static declaration. + +2008-05-28 Francois-Xavier Coudert + + PR fortran/36319 + * intrinsics/string_intrinsics_inc.c (string_index): Return + correct value for zero-length substring. + * intrinsics/cshift0.c: Add _char4 variant. + * intrinsics/eoshift0.c (eoshift0): Allow filler to be a pattern + wider than a single byte. Add _char4 variant and use above + functionality. + * intrinsics/eoshift2.c (eoshift2): Likewise. + * m4/eoshift1.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * m4/cshift1.m4: Add _char4 variants. + * gfortran.map (GFORTRAN_1.1): Add _gfortran_cshift0_1_char4, + _gfortran_cshift0_2_char4, _gfortran_cshift0_4_char4, + _gfortran_cshift0_8_char4, _gfortran_cshift1_16_char4, + _gfortran_cshift1_4_char4, _gfortran_cshift1_8_char4, + _gfortran_eoshift0_1_char4, _gfortran_eoshift0_2_char4, + _gfortran_eoshift0_4_char4, _gfortran_eoshift0_8_char4, + _gfortran_eoshift1_16_char4, _gfortran_eoshift1_4_char4, + _gfortran_eoshift1_8_char4, _gfortran_eoshift2_1_char4, + _gfortran_eoshift2_2_char4, _gfortran_eoshift2_4_char4, + _gfortran_eoshift2_8_char4, _gfortran_eoshift3_16_char4, + _gfortran_eoshift3_4_char4 and _gfortran_eoshift3_8_char4. + * generated/eoshift3_4.c: Regenerate. + * generated/eoshift1_8.c: Regenerate. + * generated/eoshift1_16.c: Regenerate. + * generated/cshift1_4.c: Regenerate. + * generated/eoshift1_4.c: Regenerate. + * generated/eoshift3_8.c: Regenerate. + * generated/eoshift3_16.c: Regenerate. + * generated/cshift1_8.c: Regenerate. + * generated/cshift1_16.c: Regenerate. + +2008-05-25 Tobias Burnus + + PR fortran/32600 + * intrinsics/iso_c_binding.c (c_f_procpointer): Remove. + * intrinsics/iso_c_binding.h (c_f_procpointer): Remove. + * gfortran.map (c_f_procpointer): Remove. + +2008-05-22 Thomas Koenig + + PR libgfortran/36302 + * gfortran.map (GFORTRAN_1.1): Add _gfortran_eoshift0_16, + _gfortran_eoshift0_16_char, _gfortran_eoshift2_16, + _gfortran_eoshift2_16_char,_gfortran_cshift0_16, + _gfortran_cshift0_16_char. Sort alphabetically. + * intrinsics/eoshift0.c: Add function for kind=16 integer. + * intrinsics/eoshift2.c: Likewise. + * intrinsics/cshift0.c: Likewise. + +2008-05-18 Thomas Koenig + + * m4/in_pack.m4 (internal_pack_'rtype_code`): Destination + pointer is restrict. + * m4/transpose.m4 (transpose_'rtype_code`): Likewise. + * m4/pack.m4 (pack_'rtype_code`): Likewise. + * m4/spread.m4 (spread_'rtype_code`): Likewise. + (spread_scalar_'rtype_code`): Likewise. + * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise. + * m4/eoshift1.m4 (eoshift1): Likewise. + * m4/eoshift3.m4 (eoshift3): Likewise. + * m4/in_unpack.m4 (internal_unpack_'rtype_ccode`): Likewise. + * m4/unpack.m4 (unpack0_'rtype_code`): Likewise. + (unpack1_'rtype_code`): Likewise. + * intrinsics/pack_generic.c (pack_generic.c): Likewise. + * intrinsics/unpack_generic.c (unpack_internal): Likewise. + * intrinsics/eoshift0.c (eoshift0): Likewise. + * intrinsics/eoshift2.c (eoshift2): Likewise. + * intrinsics/reshape_generic.c (reshape_internal): Likewise. + * intrinsics/reshape_packed.c (reshape_packed): Likewise. + * generated/eoshift1_16.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + * generated/in_pack_c10.c: Regenerated. + * generated/in_pack_c16.c: Regenerated. + * generated/in_pack_c4.c: Regenerated. + * generated/in_pack_c8.c: Regenerated. + * generated/in_pack_i1.c: Regenerated. + * generated/in_pack_i16.c: Regenerated. + * generated/in_pack_i2.c: Regenerated. + * generated/in_pack_i4.c: Regenerated. + * generated/in_pack_i8.c: Regenerated. + * generated/in_pack_r10.c: Regenerated. + * generated/in_pack_r16.c: Regenerated. + * generated/in_pack_r4.c: Regenerated. + * generated/in_pack_r8.c: Regenerated. + * generated/in_unpack_c10.c: Regenerated. + * generated/in_unpack_c16.c: Regenerated. + * generated/in_unpack_c4.c: Regenerated. + * generated/in_unpack_c8.c: Regenerated. + * generated/in_unpack_i1.c: Regenerated. + * generated/in_unpack_i16.c: Regenerated. + * generated/in_unpack_i2.c: Regenerated. + * generated/in_unpack_i4.c: Regenerated. + * generated/in_unpack_i8.c: Regenerated. + * generated/in_unpack_r10.c: Regenerated. + * generated/in_unpack_r16.c: Regenerated. + * generated/in_unpack_r4.c: Regenerated. + * generated/in_unpack_r8.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/pack_c10.c: Regenerated. + * generated/pack_c16.c: Regenerated. + * generated/pack_c4.c: Regenerated. + * generated/pack_c8.c: Regenerated. + * generated/pack_i1.c: Regenerated. + * generated/pack_i16.c: Regenerated. + * generated/pack_i2.c: Regenerated. + * generated/pack_i4.c: Regenerated. + * generated/pack_i8.c: Regenerated. + * generated/pack_r10.c: Regenerated. + * generated/pack_r16.c: Regenerated. + * generated/pack_r4.c: Regenerated. + * generated/pack_r8.c: Regenerated. + * generated/spread_c10.c: Regenerated. + * generated/spread_c16.c: Regenerated. + * generated/spread_c4.c: Regenerated. + * generated/spread_c8.c: Regenerated. + * generated/spread_i1.c: Regenerated. + * generated/spread_i16.c: Regenerated. + * generated/spread_i2.c: Regenerated. + * generated/spread_i4.c: Regenerated. + * generated/spread_i8.c: Regenerated. + * generated/spread_r10.c: Regenerated. + * generated/spread_r16.c: Regenerated. + * generated/spread_r4.c: Regenerated. + * generated/spread_r8.c: Regenerated. + * generated/transpose_c10.c: Regenerated. + * generated/transpose_c16.c: Regenerated. + * generated/transpose_c4.c: Regenerated. + * generated/transpose_c8.c: Regenerated. + * generated/transpose_i16.c: Regenerated. + * generated/transpose_i4.c: Regenerated. + * generated/transpose_i8.c: Regenerated. + * generated/transpose_r10.c: Regenerated. + * generated/transpose_r16.c: Regenerated. + * generated/transpose_r4.c: Regenerated. + * generated/transpose_r8.c: Regenerated. + * generated/unpack_c10.c: Regenerated. + * generated/unpack_c16.c: Regenerated. + * generated/unpack_c4.c: Regenerated. + * generated/unpack_c8.c: Regenerated. + * generated/unpack_i1.c: Regenerated. + * generated/unpack_i16.c: Regenerated. + * generated/unpack_i2.c: Regenerated. + * generated/unpack_i4.c: Regenerated. + * generated/unpack_i8.c: Regenerated. + * generated/unpack_r10.c: Regenerated. + * generated/unpack_r16.c: Regenerated. + * generated/unpack_r4.c: Regenerated. + * generated/unpack_r8.c: Regenerated. + +2008-05-18 Francois-Xavier Coudert + + * runtime/select.c: Moved content to select_inc.c. Include it. + Add macros for different character types. + * runtime/select_inc.c: New file. + * runtime/convert_char.c: New file. + * intrinsics/pack_generic.c (pack_char4, pack_s_char4): New + functions. + * intrinsics/transpose_generic.c (transpose_char4): New function. + * intrinsics/spread_generic.c (spread_char4, spread_char4_scalar): + New functions. + * intrinsics/unpack_generic.c (unpack1_char4, unpack0_char4): + New functions. + * intrinsics/reshape_generic.c (reshape_char): Use + gfc_charlen_type as type for length variables. + (reshape_char4): New function. + * gfortran.map (GFORTRAN_1.1): Add _gfortran_select_string_char4, + _gfortran_convert_char1_to_char4, _gfortran_convert_char4_to_char1, + _gfortran_transpose_char4, _gfortran_spread_char4, + _gfortran_spread_char4_scalar, _gfortran_reshape_char4, + _gfortran_pack_char4, _gfortran_pack_s_char4, + _gfortran_unpack0_char4 and _gfortran_unpack1_char4. + * Makefile.am: Add runtime/convert_char.c. + * Makefile.in: Regenerate. + +2008-05-17 Thomas Koenig + + * io/list_read.c (list_formatted_read_scalar): Declare + type as volatile to shut up compiler warning. + +2008-05-16 Janne Blomqvist + + PR libfortran/25561 + * io/io.h (struct fbuf): Change pointer to position offset. + * io/fbuf.c (fbuf_init): Reduce default size of buffer, ptr=>pos + changes. + (fbuf_reset): ptr=>pos changes. + (fbuf_alloc): If the request doesn't fit, don't waste memory by + keeping flushed bytes. ptr=>pos changes. + (fbuf_flush): ptr=>pos changes. + (fbuf_seek): Don't seek past the left tab limit, don't update active + byte count. + * io/open.c (new_unit): If RECL has been specified, used that as + initial buffer size. + +2008-05-16 Janne Blomqvist + + PR libfortran/35632 + * io/open.c (new_unit): Set stream position to correct value. + +2008-05-15 Janne Blomqvist + + PR libfortran/25561 + * Makefile.am: Add fbuf.c to gfor_io_src. + * Makefile.in: Regenerate. + * io/io.h (read_block): Remove. + (struct stream): Remove alloc_r_at function pointer. + (salloc_r): Remove. + (salloc_r_at): Remove. + (salloc_w_at): Remove. + (salloc_w): Remove offset argument. + (struct fbuf): New struct for format buffer. + (struct gfc_unit): Add fbuf. + (read_block_form): New prototype. + (fbuf_init): Likewise. + (fbuf_destroy): Likewise. + (fbuf_reset): Likewise. + (fbuf_alloc): Likewise. + (fbuf_flush): Likewise. + (fbuf_seek): Likewise. + * io/file_pos.c (formatted_backspace): Change to use sread. + (unformatted_backspace): Likewise. + (st_backspace): Flush format buffer. + (st_rewind): Likewise. + * io/list_read.c (next_char): Likewise. + (nml_query): Tidying, flush format buffer. + * io/open.c (new_unit): Init format buffer. + * io/read.c (read_l): Change to use read_block_form. + (read_a): Likewise. + (read_decimal): Likewise. + (read_radix): Likewise. + (read_f): Likewise. + (read_x): Empty reads also for stream I/O. + * io/transfer.c (read_sf): Change to use sread. + (read_block): Rename to read_block_form, change prototype, use sread. + (read_block_direct): Don't seek stream files. + (write_block): Change to use fbuf if external file, don't seek stream + files. + (write_buf): Don't seek stream files. + (formatted_transfer_scalar): Use fbuf for external files. + (us_read): Change to use sread. + (pre_position): Do nothing for stream I/O. + (data_transfer_init): Flush fbuf when switching from write to read, if + POS is specified, seek stream file to correct offset. + (skip_record): Change to use sread. + (min_off): New function. + (next_record_r): Change to use sread. + (next_record_w): Change to use sset/sseek, flush fbuf. + (finalize_transfer): Flush fbuf. + * io/unit.c (init_units): Init fbuf for stdout, stderr. + (close_unit_1): Destroy fbuf. + (finish_last_advance_record): Flush fbuf, no need to seek. + * io/unix.c (fd_alloc_r_at): Remove unused where argument. + (fd_alloc_w_at): Likewise. + (fd_read): Remove third argument to fd_alloc_r_at. + (fd_write): Remove third argument to fd_alloc_w_at. + (fd_sset): Likewise. + (fd_open): Don't set alloc_r_at. + (mem_alloc_r_at): Remove unused where argument. + (mem_alloc_w_at): Likewise. + (mem_read): Don't incorrectly return previous errno, remove unused + third argument to alloc function. + (mem_write): Likewise. + (mem_set): Likewise. + (open_internal): Don't set alloc_r_at pointer. + * io/fbuf.c: New file. + +2008-05-14 Francois-Xavier Coudert + + * libgfortran.h (gfc_char4_t): New type. + (GFC_SIZE_OF_CHAR_KIND): New macro. + (compare_string): Adjust prototype. + (compare_string_char4): New prototype. + * gfortran.map (GFORTRAN_1.1): Add _gfortran_adjustl_char4, + _gfortran_adjustr_char4, _gfortran_compare_string_char4, + _gfortran_concat_string_char4, _gfortran_string_index_char4, + _gfortran_string_len_trim_char4, _gfortran_string_minmax_char4, + _gfortran_string_scan_char4, _gfortran_string_trim_char4 and + _gfortran_string_verify_char4. + * intrinsics/string_intrinsics_inc.c: New file from content of + string_intrinsics.c with types replaced by macros. + * intrinsics/string_intrinsics.c: Move content to + string_intrinsics_inc.c. + +2008-05-11 Jerry DeLisle + + PR libfortran/36202 + * io/list_read (eat_separator): Handle the CR-LF case correctly. + +2008-05-09 Julian Brown + + * Makefile.am (LTLDFLAGS): New. + (libgfortran_la_LDFLAGS): Use above. + * Makefile.in: Regenerate. + +2008-05-05 Jerry DeLisle + + PR libfortran/36131 + * io/transfer.c (formatted_transfer_scalar): Revert patch for PR34974. + (next_record_w): Likewise. + +2008-05-04 Thomas Koenig + + PR libfortran/35995 + * m4/ifunction_logical.m4: If the extent of "array" + is less than zero, set it to zero. Use an explicit + flag for breaking out of the main loop to avoid, because + the data pointer for "array" may be NULL for an empty + array. + * m4/ifunction.m4: Likewise. + * generated/all_l1.c: Regenerated. + * generated/all_l16.c: Regenerated. + * generated/all_l2.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l1.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/any_l2.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_16_l.c: Regenerated. + * generated/count_1_l.c: Regenerated. + * generated/count_2_l.c: Regenerated. + * generated/count_4_l.c: Regenerated. + * generated/count_8_l.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2008-05-04 Thomas Koenig + + PR libfortran/35990 + * intrinsics/pack_generic.c: Really commit. + +2008-05-04 Thomas Koenig + + PR libfortran/35990 + * intrinsics/pack_generic.c: If an extent of the source + array is less then zero, set it to zero. Set the source + pointer to NULL if the source size is zero. Set the total + number of elements to zero if the vector has an extent + less or equal to zero. + * m4/pack.m4: Set the source pointer to NULL if the + source array is zero-sized. Set the total number of + elemements to zero if the vector has an extent less or + equal to zero. + * generated/pack_i1.c: Regenerated. + * generated/pack_i2.c: Regenerated. + * generated/pack_i4.c: Regenerated. + * generated/pack_i8.c: Regenerated. + * generated/pack_i16.c: Regenerated. + * generated/pack_r4.c: Regenerated. + * generated/pack_r8.c: Regenerated. + * generated/pack_r10.c: Regenerated. + * generated/pack_r16.c: Regenerated. + * generated/pack_c4.c: Regenerated. + * generated/pack_c8.c: Regenerated. + * generated/pack_c10.c: Regenerated. + * generated/pack_c16.c: Regenerated. + +2008-05-01 Jerry DeLisle + + PR libfortran/36094 + * runtime/error.c (show_locus): Provide modified error message when + filename has not yet been associated with a unit number. + * io/open.c (encoding_opt[]): Comment out "utf-8" option and add TODO. + +2008-04-30 Francois-Xavier Coudert + + * intrinsics/selected_char_kind.c: New file. + * gfortran.map (GFORTRAN_1.1): Add _gfortran_selected_char_kind. + * Makefile.am: Add intrinsics/selected_char_kind.c. + * Makefile.in: Regenerate. + +2008-04-30 Thomas Koenig + + PR libfortran/35993 + * ifunction.m4 (SCALAR_ARRAY_FUNCTION): Use correct + implementation for multi-dimensional return arrays when + the mask is .false. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2008-04-25 Thomas Koenig + + PR libfortran/35960 + * m4/reshape.m4: Fix typo in last commit. + * generated/reshape_i4.c: Regererated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + +2008-04-24 Francois-Xavier Coudert + + * intrinsics/time_1.h (__time_1): Remove unused variable. + +2008-04-23 Thomas Koenig + + PR libfortran/35988 + * m4/matmul.m4: Only issue a runtime error if extents are + non-zero. + * generated/matmul_i1.c: Regenerated. + * generated/matmul_i2.c: Regenerated. + * generated/matmul_i4.c: Regenerated. + * generated/matmul_i8.c: Regenerated. + * generated/matmul_i16.c: Regenerated. + * generated/matmul_r4.c: Regenerated. + * generated/matmul_r8.c: Regenerated. + * generated/matmul_r10.c: Regenerated. + * generated/matmul_r16.c: Regenerated. + * generated/matmul_c4.c: Regenerated. + * generated/matmul_c8.c: Regenerated. + * generated/matmul_c10.c: Regenerated. + * generated/matmul_c16.c: Regenerated. + +2008-04-21 Ralf Wildenhues + + * acinclude.m4 (LIBGFOR_CHECK_ATTRIBUTE_VISIBILITY) + (LIBGFOR_CHECK_ATTRIBUTE_DLLEXPORT) + (LIBGFOR_CHECK_ATTRIBUTE_ALIAS, LIBGFOR_CHECK_SYNC_FETCH_AND_ADD) + (LIBGFOR_GTHREAD_WEAK, LIBGFOR_CHECK_UNLINK_OPEN_FILE) + (LIBGFOR_CHECK_CRLF, LIBGFOR_CHECK_FOR_BROKEN_ISFINITE) + (LIBGFOR_CHECK_FOR_BROKEN_ISNAN) + (LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY, LIBGFOR_CHECK_WORKING_STAT) + (LIBGFOR_CHECK_FPSETMASK, LIBGFOR_CHECK_MINGW_SNPRINTF): + Fix cache variable names. + * configure, Makefile.in: Regenerate. + +2008-04-20 Jerry DeLisle + + PR fortran/35991 + * intrinsics/cshift0.c (cshift0): Avoid divide by zero. + +2008-04-20 Thomas Koenig + + PR libfortran/35960 + * intrinsics/reshape_generic.c (reshape_internal): If the size + of the resized array is zero, as determined by the SHAPE + argument, return early. + * m4/reshape.m4: Likewise. + * generated/reshape_i4.c: Regererated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + +2008-04-18 Paolo Bonzini + + PR bootstrap/35457 + * aclocal.m4: Regenerate. + * configure: Regenerate. + +2008-04-14 Thomas Koenig + + PR libfortran/32972 + * intrinsics/spread_generic.c (spread): Use spread_i2() + for GFC_DTYPE_DERIVED_2 (fix typo from previous commit). + +2008-04-13 Thomas Koenig + Francois-Xavier Coudert + + PR libfortran/32972 + PR libfortran/32512 + configure.ac: Add test for uintptr_t. + configure: Regenerated. + config.h.in: Regenerated. + * libgfortran.h: GFC_DTYPE_DERIVED_1: New macro. + GFC_DTYPE_DERIVED_2: New macro. + GFC_DTYPE_DERIVED_4: New macro. + GFC_DTYPE_DERIVED_8: New macro. + GFC_DTYPE_DERIVED_16: New macro. + GFC_UNALIGNED_2: New macro. + GFC_UNALIGNED_4: New macro. + GFC_UNALIGNED_8: New macro. + GFC_UNALIGNED_16: New macro. + intptr_t: Define if we don't have it. + uintptr_t: Likewise. + * runtime/backtrace.c (show_backtrace): Use intptr_t. + * intrinsics/signal.c (signal_sub): Likewise. + (signal_sub_int): Likewise. + (alarm_sub_int_i4): Likewise. + * intrinsics/spread_generic.c (spread): Use the integer + routines for handling derived types of sizes 1, 2, 4, 8 and 16 + if the alignment of all pointers is correct. + (spread_scalar): Likewise. + * intrinsics/pack_generic.c (pack): Likewise. + Use GFD_DTYPE_TYPE_SIZE to avoid nested switch statements. + * intrinsics/unpack_generic.c (unpack1): Likewise. + (unpack0): Likewise. + * runtime/in_pack_generic.c (internal_pack): Likewise. + * runtime/in_unpack_generic.c (internal_unpack): Likewise. + +2008-04-09 Jakub Jelinek + + * io/list_read.c (snprintf): Define if HAVE_SNPRINTF isn't defined. + (nml_read_obj): Add nml_err_msg_size argument. Pass it down to + recursive call. Use snprintf instead of sprintf when %s nl->var_name + is used. + (nml_get_obj_data): Add nml_err_msg_size argument. Pass it down to + nml_read_obj call. Use snprintf instead of sprintf when %s + nl->var_name is used. Pass nml_err_msg to nml_parse_qualifier instead + of parse_err_msg array. Append " for namelist variable " and + nl->var_name to it. + (namelist_read): Increase size of nml_err_msg array to 200. Pass + sizeof nml_err_msg as extra argument to nml_get_obj_data. + +2008-04-07 Jerry DeLisle + + PR fortran/25829 28655 + * io/open.c (edit_modes): Set flags.async. (new_unit) Set flags.async + and flags.status. (st_open): Initialize flags.async. + * io/list_read.c (read_charactor): Use delim_status instead of + flags.delim. + * io/read.c (read_x): Use pad_status instead of flags.pad. + * io/inquire.c (inquire_via_unit): Add new checks. + (inquire_via_filename): Likewise. + * io/io.h (st_parameter_inquire): Add new flags. + (st_parameter_dt): Likewise. + * io/unit.c (get_internal_unit): Set flags.async. (init_units): Set + flags.async. + * io/transfer.c: Add delim and pad option arrays. (read_sf): Use + pad_status instead of flags.pad. (read_block): Likewise. + (data_transfer_init): Set flags.async and add checks. + * io/write.c (write_character): Use delim_status. + (list_formatted_write_scalar): Likewise. (nml_write_obj): Likewise. + (namelist_write): Likewise. + +2008-04-05 Jerry DeLisle + + PR fortran/25829 28655 + * gfortran.map: Add new symbol, _gfortran_st_wait. + * libgfortran.h (st_paramter_common): Add new I/O parameters. + * open.c (st_option decimal_opt[], st_option encoding_opt[], + st_option round_opt[], st_option sign_opt[], st_option async_opt[]): New + parameter option arrays. (edit_modes): Add checks for new parameters. + (new_unit): Likewise. (st_open): Likewise. + * list_read.c (CASE_SEPERATORS): Add ';' as a valid separator. + (eat_separator): Handle deimal comma. (read_logical): Fix whitespace. + (parse_real): Handle decimal comma. (read_real): Handle decimal comma. + * read.c (read_a): Use decimal status flag to allow comma in place of a + decimal point. (read_f): Allow comma as acceptable character in float. + According to decimal flag, substitute a period for a comma. + (read_x): If decimal status flag is comma, disable the read_comma flag, + not allowing comma as a delimiter, an extension otherwise. + * io.h: (unit_decimal, unit_encoding, unit_round, unit_sign, + unit_async): New enumerators. Add all new I/O parameters. + * unix.c (unix_stream, int_stream): Add io_mode asychronous I/O control. + (move_pos_offset, fd_alloc_w_at): Fix some whitespace. + (fd_sfree): Use new enumerator. (fd_read): Likewise. + (fd_write): Likewise. (fd_close): Fix whitespace. + (fd_open): Use new enumertors. (tempfile, regular_file, + open_external): Fix whitespace. (output_stream, error_stream): Set + method. (stream_offset): Fix whitespace. + * transfer.c: (st_option decimal_opt[], sign_opt[], blank_opt[]): New + option arrays. (formatted_transfer_scalar): Set sf_read_comma flag + based on new decimal_status flag. (data_transfer_init): Initialize new + parameters. Add checks for decimal, sign, and blank. (st_wait): New stub. + * format.c: (format_lex): Add format specifiers DP, DC, and D. + (parse_format_list): Parse the new specifiers. + * write.c (write_decimal): Use new sign enumerators to set the sign. + (write_complex): Handle decimal comma and semi-colon separator. + (nml_write_obj): Likewise. + * write_float.def: Revise sign enumerators. (calculate_sign): Use new + sign enumerators. (output_float): Likewise. Use new decimal_status flag + to set the decimal character to a point or a comma. + +2008-03-28 Thomas Koenig + + PR libfortran/32972 + PR libfortran/32512 + * Makefile.am: Add new variable, i_spread_c, containing + pack_i1.c, pack_i2.c, pack_i4.c, pack_i8.c, spread_i16.c, + spread_r4.c, spread_r8.c, spread_r10.c, spread_r16.c, + spread_c4.c, spread_c8.c, spread_c10.c, spread_c16.c. + * Makefile.in: Regenerated. + * libgfortran.h: Add prototypes for spread_i1, spread_i2, + spread_i4, spread_i8, spread_i16, spread_r4, spread_r8, + spread_c4, spread_c8, spread_c10, spread_c16, + spread_scalar_i1, spread_scalar_i2, spread_scalar_i4, + spread_scalar_i8, spread_scalar_i16, spread_scalar_r4 + spread_scalar_r8, spread_scalar_c4, spread_scalar_c8, + spread_scalar_c10 and spread_scalar_c16. + Add macros to isolate both type and size information + from array descriptors with a single mask operation. + * intrinsics/spread_generic.c: Add calls to specific + spread functions. + * m4/spread.m4: New file. + * generated/spread_i1.c: New file. + * generated/spread_i2.c: New file. + * generated/spread_i4.c: New file. + * generated/spread_i8.c: New file. + * generated/spread_i16.c: New file. + * generated/spread_r4.c: New file. + * generated/spread_r8.c: New file. + * generated/spread_r10.c: New file. + * generated/spread_r16.c: New file. + * generated/spread_c4.c: New file. + * generated/spread_c8.c: New file. + * generated/spread_c10.c: New file. + * generated/spread_c16.c: New file. + +2008-03-28 Jerry DeLisle + + PR libfortran/35699 + * io/transfer.c (write_buf): Don't pad the record, just return if the + data is NULL. (next_record_w): If there are bytes left in the record + for unformatted direct I/O, pad out the record with zero bytes. + +2008-03-28 Tobias Burnus + + PR fortran/35721 + * intrinsics/associated.c (associated): Ignore different + stride of pointer vs. target if only one element is referred. + +2008-03-26 Jerry DeLisle + + * io/unix.c (fd_close): Do not close STDIN. + +2008-03-23 Thomas Koenig + + PR libfortran/32972 + * Makefile.am: Add new variable, i_unpack_c, containing + unpack_i1.c, unpack_i2.c, unpack_i4.c, unpack_i8.c, + unpack_i16.c, unpack_r4.c, unpack_r8.c, unpack_r10.c, + unpack_r16.c, unpack_c4.c, unpack_c8.c, unpack_c10.c + and unpack_c16.c + Add i_unpack_c to gfor_built_src. + Add rule to generate i_unpack_c from m4/unpack.m4. + * Makefile.in: Regenerated. + * libgfortran.h: Add prototypes for unpack0_i1, unpack0_i2, + unpack0_i4, unpack0_i8, unpack0_i16, unpack0_r4, unpack0_r8, + unpack0_r10, unpack0_r16, unpack0_c4, unpack0_c8, unpack0_c10, + unpack0_c16, unpack1_i1, unpack1_i2, unpack1_i4, unpack1_i8, + unpack1_i16, unpack1_r4, unpack1_r8, unpack1_r10, unpack1_r16, + unpack1_c4, unpack1_c8, unpack1_c10 and unpack1_c16. + * intrinsics/pack_generic.c (unpack1): Add calls to specific + unpack1 functions. + (unpack0): Add calls to specific unpack0 functions. + * m4/unpack.m4: New file. + * generated/unpack_i1.c: New file. + * generated/unpack_i2.c: New file. + * generated/unpack_i4.c: New file. + * generated/unpack_i8.c: New file. + * generated/unpack_i16.c: New file. + * generated/unpack_r4.c: New file. + * generated/unpack_r8.c: New file. + * generated/unpack_r10.c: New file. + * generated/unpack_r16.c: New file. + * generated/unpack_c4.c: New file. + * generated/unpack_c8.c: New file. + * generated/unpack_c10.c: New file. + * generated/unpack_c16.c: New file. + +2008-03-22 Jerry DeLisle + + PR libfortran/35632 + * io/transfer.c (data_transfer_init): Fix whitespace. + (next_record_w): Truncate the file only if the stream + position is short of the file end. + +2008-03-21 Jerry DeLisle + + * intrinsics/pack_generic.c: Fix typo. + +2008-03-21 Janne Blomqvist + + * gfortran.map: Move erfc_scaled symbols to new symbol node + GFORTRAN_1.1, thereby fixing ABI bug introduced in r132846. + +2008-03-21 Thomas Koenig + + PR libfortran/32972 + * runtime/in_pack_generic.c (internal_pack): Call correct + function, pack_i16, for GFC_INTEGER_16. + +2008-03-21 Thomas Koenig + + PR libfortran/32972 + * Makefile.am: Add new variable, i_pack_c, containing + pack_i1.c, pack_i2.c, pack_i4.c, pack_i8.c, pack_i16.c, + pack_r4.c, pack_r8.c, pack_r10.c, pack_r16.c, pack_c4.c, + pack_c8.c, pack_c10.c, pack_c16.c. + Add m4/pack.m4 to m4_files. + Add i_pack_c to gfor_built_src. + Add rule to generate i_pack_c from m4/pack.m4. + * Makefile.in: Regenerated. + * libgfortran.h: Add prototypes for pack_i1, pack_i2, pack_i4, + pack_i8, pack_i16, pack_r4, pack_r8, pack_c4, pack_c8, + pack_c10, pack_c16. + * intrinsics/pack_generic.c: Add calls to specific + pack functions. + * m4/pack.m4: New file. + * generated/pack_i1.c: New file. + * generated/pack_i2.c: New file. + * generated/pack_i4.c: New file. + * generated/pack_i8.c: New file. + * generated/pack_i16.c: New file. + * generated/pack_r4.c: New file. + * generated/pack_r8.c: New file. + * generated/pack_r10.c: New file. + * generated/pack_r16.c: New file. + * generated/pack_c4.c: New file. + * generated/pack_c8.c: New file. + * generated/pack_c10.c: New file. + * generated/pack_c16.c: New file. + +2008-03-19 Jerry DeLisle + + PR libfortran/35627 + * io/list_read.c (free_line): Clear the line buffer enable flag and + reset the index into line_buffer, aka item_count. + (next_char): Cleanup whitespace. + (read_logical): Use unget_char to assure that the first character of the + bad logical is saved in case it is part of an object name. Remove the + clearing of index and flag that is now in free_line. + (read_real): Likewise. + +2008-03-19 Thomas Koenig + + PR libfortran/32972 + * runtime/in_pack_generic.c (internal_pack): Fix typo in + last commit. + +2008-03-19 Thomas Koenig + + PR libfortran/32972 + * Makefile.am (in_pack_c): Add in_pack_i1.c, in_pack_i2.c, + in_pack_r4.c, in_pack_r8.c, in_pack_r10.c and in_pack_r16.c. + (in_unpack_c): Add in_unpack_i1.c, in_unpack_i2.c, + in_unpack_r4.c, in_unpack_r8.c, in_unpack_r10.c and + in_unpack_r16.c. + * Makefile.in: Regenerate. + * libgfortran.h: Add prototypes for internal_pack_1, + internal_pack_2, internal_pack_16, internal_pack_r4, + internal_pack_r8, internal_pack_r10, internal_pack_r16, + internal_pack_c10 and internal_pack_c16. Add prototypes for + internal_unpack_1, internal_unpack_2, internal_unpack_16, + internal_unpack_r4, internal_unpack_r8, internal_unpack_r10, + internal_unpack_r16, internal_unpack_c10 and + internal_unpack_c16. + * runtime/in_pack_generic.c (internal_pack): Use sizeof instead + of hardwired sizes. + Add calls to internal_pack_1, internal_pack_2, + internal_pack_16, internal_pack_r4, internal_pack_r8, + internal_pack_r10, internal_pack_r16, internal_pack_c10 and + internal_pack_c16. + * runtime/in_unpack_generic.c (internal_unpack): Use sizeof + instead of hardwired sizes. + Add calls to internal_unpack_1, internal_unpack_2, + internal_unpack_16, internal_unpack_r4, internal_unpack_r8, + internal_unpack_r10, internal_unpack_r16, internal_unpack_c10 + and internal_unpack_c16. + * generated/in_pack_r4.c: New file. + * generated/in_pack_i2.c: New file. + * generated/in_unpack_i1.c: New file. + * generated/in_pack_r10.c: New file. + * generated/in_unpack_r4.c: New file. + * generated/in_unpack_i2.c: New file. + * generated/in_unpack_r16.c: New file. + * generated/in_pack_r8.c: New file. + * generated/in_unpack_r10.c: New file. + * generated/in_unpack_r8.c: New file. + * generated/in_pack_r16.c: New file. + * generated/in_pack_i1.c: New file. + +2008-03-17 Jerry DeLisle + + PR libfortran/35617 + * io/list_read.c (eat_separator): If next character after eatline is '!' + then eatline again. + +2008-03-16 Ralf Wildenhues + + * aclocal.m4: Regenerate. + * configure: Likewise. + * Makefile.in: Likewise. + +2008-03-12 Francois-Xavier Coudert + + PR libfortran/35524 + * intrinsics/erfc_scaled_inc.c: Only define the long double + variant of erfc_scaled if expl is available. + +2008-03-11 Francois-Xavier Coudert + + PR libfortran/32812 + * intrinsics/random.c (scramble_seed, unscramble_seed): New + functions. + (random_seed_i4): Scramble the seed the user gives us before + storing it, and unscramble it when we return it back later. + +2008-03-05 Hans-Peter Nilsson + + PR libfortran/35293 + * io/unix.c (fd_truncate): Fold s->special_file case into + success case of ftruncate/chsize call instead of the failure case. + Make failure case actually return failure. Properly update stream + pointers on failure. Call runtime_error for targets without + neither ftruncate nor chsize where such a call would be needed. + +2008-03-03 Francois-Xavier Coudert + + PR fortran/33197 + * intrinsics/erfc_scaled_inc.c: New file. + * intrinsics/erfc_scaled.c: New file. + * gfortran.map (GFORTRAN_1.0): Add _gfortran_erfc_scaled_r*. + * Makefile.am: Add intrinsics/erfc_scaled.c. + * config.h.in: Regenerate. + * configure: Regenerate. + * Makefile.in: Regenerate. + +2008-03-01 Francois-Xavier Coudert + + PR libfortran/35355 + * intrinsics/time_1.h (__time_1): Fix calculation of user_usec + for mingw. + +2008-03-01 Janne Blomqvist + + PR libfortran/35063 + * io/unit.c (destroy_unit_mutex): Call __gthread_mutex_destroy + instead of macro kludge. + +2008-02-25 Janne Blomqvist + + PR fortran/29549 + * Makefile.am: Add -fcx-fortran-rules to AM_CFLAGS for all of + libgfortran. + * Makefile.in: Regenerated. + +2008-02-25 Francois-Xavier Coudert + + * m4/ifunction_logical.m4: Add casts to get rid of warnings. + * generated/all_l1.c: Regenerate. + * generated/all_l2.c: Regenerate. + * generated/all_l4.c: Regenerate. + * generated/all_l8.c: Regenerate. + * generated/all_l16.c: Regenerate. + * generated/any_l1.c: Regenerate. + * generated/any_l2.c: Regenerate. + * generated/any_l4.c: Regenerate. + * generated/any_l8.c: Regenerate. + * generated/any_l16.c: Regenerate. + * generated/count_1_l.c: Regenerate. + * generated/count_2_l.c: Regenerate. + * generated/count_4_l.c: Regenerate. + * generated/count_8_l.c: Regenerate. + * generated/count_16_l.c: Regenerate. + +2008-02-24 Francois-Xavier Coudert + + PR libfortran/32841 + * acinclude.m4: Don't use HAVE_MATH_H. + * configure: Regenerate. + +2008-02-20 Jerry DeLisle + + PR libfortran/35132 + * io/transfer.c (next_record_w): Truncate after the last record for + STREAM I/O. + + PR libfortran/34954 + * io/transfer.c (data_transfer_init): Initialize dtp->rec if writing. + + PR libfortran/34974 + * io/transfer.c (formatted_transfer_scalar): Flush the buffer if skips + is less than zero. (next_record_w): Use sseek to position the file to + the max position reached. + +2008-02-20 Jerry DeLisle + + PR libfortran/35036 + * write_float.def (output_float): Add error checks for zero digits + after decimal point in E and D format specifiers. + +2008-02-10 Jerry DeLisle + + PR libfortran/35063 + * io/unit.c (destroy_unit_mutex): New function that uses + __gthread_mutex_destroy_function or pthread_mutex_destroy after + unlocking and before free_mem for final closure of I/O unit. + (delete_root): Use new function. + (free_internal_unit): Likewise. + (close_unit_1): Likewise. + +2008-02-02 Thomas Koenig + + PR libfortran/35001 + * m4/shape.m4: Return 0 for extents <= 0. + * generated/shape_i4.c: Regenerated. + * generated/shape_i8.c: Regenerated. + * generated/shape_i16.c: Regenerated. + +2008-01-27 Thomas Koenig + + PR libfortran/34980 + * m4/shape.m4: If return array is empty, return early. + * generated/shape_i4.c: Regenerated. + * generated/shape_i8.c: Regenerated. + * generated/shape_i16.c: Regenerated. + +2008-01-26 Thomas Koenig + + PR libfofortran/34887 + * io/transfer.c (next_record_w): Always move to the farthest + position when completing the record (also when we are + processing a slash edit descriptor). + +2008-01-25 Jerry DeLisle + + PR libfortran/34876 + * io/transfer.c (write_buf): Handle case of zero sized array. + (transfer_array): Set data pointer to NULL and size to zero. Then + make a data transfer and return. + +2008-01-24 David Edelsohn + + * configure: Regenerate. + +2008-01-19 Jerry DeLisle + + PR libfortran/34795 + * io/inquire.c (inquire_via_unit): If a unit is opened, return values + according to the open action for DIRECT, FORMATTED, and UNFORMATTED. + (inquire_via_filename): Return "UNKNOWN" for SEQUENTIAL, DIRECT, + FORAMATTED, and UNFORMATTED inquiries. + * io/unix.c (inquire_sequential): Return "UNKNOWN" when appropriate + for files that are not opened. (inquire_direct): Same. + (inquire_formatted): Same. + +2008-01-18 Jerry DeLisle + + PR libfortran/34782 + * io/transfer.c (formatted_transfer_scalar): Set max_pos to the greater + of the current max_pos or the newly calculated position. + +2008-01-18 Tobias Burnus + + * io/write.c (write_real): Increase default precision + for REAL(16) by one. + +2008-01-16 Steven Bosscher + + PR libfortran/34669 + * mk-kinds-h.sh: Compile with -S to avoid calling the assembler, + to avoid piping the -fdump-parse-tree output to the assembler + when configuring with -pipe. + * mk-sik-inc.sh: Likewise. + * mk-srk-inc.sh: Likewise. + +2008-01-15 Thomas Koenig + + PR libfortran/34671 + * gfortran.am: Added _gfortran_all_l1, _gfortran_all_l2, + _gfortran_any_l1, _gfortran_any_l2, -28,15 _gfortran_count_1_l, + _gfortran_count_16_l, _gfortran_count_2_l, _gfortran_count_4_l and + _gfortran_count_8_l Removed _gfortran_count_16_l16, + _gfortran_count_16_l4, _gfortran_count_16_l8, + _gfortran_count_4_l16, _gfortran_count_4_l4, _gfortran_count_4_l8, + _gfortran_count_8_l16, _gfortran_count_8_l4 and + _gfortran_count_8_l8. + * Makefile.am: Added generated/any_l1.c and generated/any_l2.c to + i_any_c. Added generated/all_l1. and generated/all_l2.c to + i_all_c. Removed 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_16_l8.c, + generated/count_4_l16.c, generated/count_8_l16.c, and + generated/count_16_l16.c from i_count_c. Added count_1_l.c, + count_2_l.c, count_4_l.c, count_8_l.c and count_16_l.c to + i_count_c. I_M4_DEPS2 depends on ifunction_logical.m4, for + any of the files generated from all.m4, any.m4 and count.m4. + * Makefile.in: Regenerated. + * m4/ifunction_logical.m4: New file. Use + GFC_LOGICAL_1 pointer for access to source arrays. + * m4/any.m4: Include ifunction_logical.m4 instead of + ifunction.m4. Don't check atype_name. + * m4/all.m4: Likewise. + * m4/count.m4: Likewise. + * generated/any_l1.c: New file. + * generated/any_l2.c: New file. + * generated/all_l1.c: New file. + * generated/count_1_l.c: New file. + * generated/count_2_l.c: New file. + * generated/count_4_l.c: New file. + * generated/count_8_l.c: New file. + * generated/count_16_l.c: New file. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/all_l16.c: Regenerated. + * generated/count_4_l4.c: Removed. + * generated/count_4_l8.c: Removed. + * generated/count_4_l16.c: Removed. + * generated/count_8_l4.c: Removed. + * generated/count_8_l8.c: Removed. + * generated/count_8_l16.c: Removed. + * generated/count_16_l4.c: Removed. + * generated/count_16_l8.c: Removed. + * generated/count_16_l16.c: Removed. + +2008-01-13 Thomas Koenig + + PR libfortran/34746 + * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Use %ld + in printf format for all bounds checking; cast all + integer-like arguments to runtime_error() to long int. + (`m'name`'rtype_qual`_'atype_code): Likewise. + (`s'name`'rtype_qual`_'atype_code): Likewise. + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Likewise. + (`m'name`'rtype_qual`_'atype_code): Likewise. + (`s'name`'rtype_qual`_'atype_code): Likewise. + * generated/all_l16.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_16_l16.c: Regenerated. + * generated/count_16_l4.c: Regenerated. + * generated/count_16_l8.c: Regenerated. + * generated/count_4_l16.c: Regenerated. + * generated/count_4_l4.c: Regenerated. + * generated/count_4_l8.c: Regenerated. + * generated/count_8_l16.c: Regenerated. + * generated/count_8_l4.c: Regenerated. + * generated/count_8_l8.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2008-01-11 Thomas Koenig + + PR libfortran/34670 + * m4/iparm.m4 (upcase): New macro (copied from the m4 manual). + (u_name): New macro for the upper case name of the intrinsic. + * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Add + bounds checking and rank check, depending on + compile_options.bounds_check. + (`m'name`'rtype_qual`_'atype_code): Likewise. + (`s'name`'rtype_qual`_'atype_code): Likewise. + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Add + bounds checking and rank check, depending on + compile_options.bounds_check. + (`m'name`'rtype_qual`_'atype_code): Likewise. + (`s'name`'rtype_qual`_'atype_code): Likewise. + * generated/all_l16.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_16_l16.c: Regenerated. + * generated/count_16_l4.c: Regenerated. + * generated/count_16_l8.c: Regenerated. + * generated/count_4_l16.c: Regenerated. + * generated/count_4_l4.c: Regenerated. + * generated/count_4_l8.c: Regenerated. + * generated/count_8_l16.c: Regenerated. + * generated/count_8_l4.c: Regenerated. + * generated/count_8_l8.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2008-01-05 Jerry DeLisle + + PR libfortran/34676 + * io/list_read.c (next_char): Only save the EOF condition for later if + advance="no". + +2008-01-03 Thomas Koenig + + PR libfortran/34565 + * io/io.h: Adjust protoypes for open_internal(), + next_array_record() and init_loop_spec(). + * io/list_read.c (next_char): Use argument "finished" + of next_array_record to check for end on internal file. + * io/unit.c: Calculate the offset for an array + internal file and supply this informatin to open_internal(). + * io/unix.c (open_internal): Set the offset for the internal + file on open. + * io/transfer.c (init_loop_spec): Calculate the starting + record in case of negative strides. Return size of 0 for + an empty array. + (next_array_record): Use an extra flag to signal that the + array is finished. + (next_record_r): Use the new flag to next_array_record(). + (next_record_w): Likewise. + + +Copyright (C) 2008 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/libgfortran/ChangeLog-2009 b/libgfortran/ChangeLog-2009 new file mode 100644 index 000000000..2611ef1ae --- /dev/null +++ b/libgfortran/ChangeLog-2009 @@ -0,0 +1,2502 @@ +2009-12-19 Janne Blomqvist + + * intrinsics/system_clock.c: Fix library name in comment, move TCK + definition into functions. + (system_clock_4): Remove unused struct timezone. + (system_clock_8): Remove unused struct timezone, increase TCK. + +2009-12-08 Tobias Burnus + + PR fortran/41711 + * io/read.c (set_integer): Support kind=10 for reading + real/complex BOZ. + +2009-12-06 Janus Weil + + PR fortran/41478 + PR fortran/42268 + * intrinsics/pack_generic.c (pack): Add safety checks for the case that + 'vector' is NULL. + +2009-12-05 Ralf Wildenhues + + * Makefile.in: Regenerate. + * configure: Regenerate. + +2009-12-04 Janne Blomqvist + + PR libfortran/40812 + * libgfortran.h: typedef gfc_offset differently for MinGW. + * io/unix.h (struct stream): Change function pointers to use + gfc_offset instead of off_t. + (sseek): Change prototype to use gfc_offset instead of off_t. + (stell): Likewise. + (struncate): Likewise. + * io/unix.c: Redefine lseek() for mingw. + (raw_seek): Use gfc_offset instead of off_t. + (raw_tell): Likewise. + (buf_seek): Likewise. + (buf_tell): Likewise. + (buf_truncate): Likewise. + (mem_seek): Likewise. + (mem_tell): Likewise. + (mem_truncate): Likewise. + (fd_to_stream): Likewise. + (file_length): Likewise. + (raw_truncate): Use gfc_offset instead of off_t, add large file + capable implementation for MinGW. + +2009-11-30 Janus Weil + + * gfortran.map: Add _gfortran_is_extension_of. + * Makefile.am: Add intrinsics/extends_type_of.c. + * Makefile.in: Regenerated. + * intrinsics/extends_type_of.c: New file. + +2009-11-30 Kai Tietz + + * io/unix.c (find_file): Add variable id conditionally for + mingw targets. + +2009-11-28 Jakub Jelinek + + * intrinsics/pack_generic.c (pack_internal): Remove unused + zero_sized variable. + * intrinsics/unpack_generic.c (unpack0): Remove unused size + variable. + * io/write.c (namelist_write_newline): Remove unused length + variable. + * io/unix.c (find_file): Remove unused id variable. + * m4/ifunction.m4 (SCALAR_ARRAY_FUNCTION): Remove unused sstride + variable. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2009-11-19 Janne Blomqvist + + * io/fbuf.h: Move includes after include guard. + * io/format.h: Likewise. + * io/unix.h: Likewise. + +2009-11-18 Jerry DeLisle + + PR libgfortran/42090 + * io/transfer.c (skip_record): Set bytes_left_subrecord to zero after + skipping the remaining bytes in the record. + (next_record_r): Call skip_record with the number of bytes_left to be + skipped. + +2009-11-02 Janne Blomqvist + + * Makefile.am (gfor_io_headers): Add fbuf.h, format.h, unix.h. + * Makefile.in: Regenerated. + * io/fbuf.h: New file. + * io/format.h: New file. + * io/unix.h: New file. + * io/io.h (struct stream): Move to unix.h, add forward declaration. + (sread): Likewise. + (swrite): Likewise. + (sseek): Likewise. + (stell): Likewise. + (struncate): Likewise. + (sflush): Likewise. + (sflush): Likewise. + (sclose): Likewise. + (compared_files): Move prototype to unix.h. + (open_external): Likewise. + (open_internal): Likewise. + (mem_alloc_w): Likewise. + (mem_alloc_r): Likewise. + (input_stream): Likewise. + (output_stream): Likewise. + (error_stream): Likewise. + (compare_file_filename): Likewise. + (find_file): Likewise. + (delete_file): Likewise. + (file_exists): Likewise. + (inquire_sequential): Likewise. + (inquire_direct): Likewise. + (inquire_formatted): Likewise. + (inquire_unformatted): Likewise. + (inquire_read): Likewise. + (inquire_write): Likewise. + (inquire_readwrite): Likewise. + (file_length): Likewise. + (is_seekable): Likewise. + (is_special): Likewise. + (flush_if_preconnected): Likewise. + (empty_internal_buffer): Likewise. + (stream_isatty): Likewise. + (stream_ttyname): Likewise. + (unpack_filename): Likewise. + (struct fbuf): Move to fbuf.h, add forward declaration. + (fbuf_init): Move prototype to fbuf.h. + (fbuf_destroy): Likewise. + (fbuf_reset): Likewise. + (fbuf_alloc): Likewise. + (fbuf_flush): Likewise. + (fbuf_seek): Likewise. + (fbuf_read): Likewise. + (fbuf_getc_refill): Likewise. + (fbuf_getc): Move inline function to fbuf.h. + (enum format_token): Move to format.h. + (struct fnode): Move to format.h, add forward declaration. + (parse_format): Move prototype to format.h. + (next_format): Likewise. + (unget_format): Likewise. + (format_error): Likewise. + (free_format_data): Likewise. + (free_format_hash_table): Likewise. + (init_format_hash): Likewise. + (free_format_hash): Likewise. + * io/close.c: Include unix.h. + * io/fbuf.c: Include fbuf.h and unix.h. + * io/file_pos.c: Include fbuf.h and unix.h. + * io/format.c: Include format.h. + * io/inquire.c: Include unix.h. + * io/intrinsics.c: Include fbuf.h and unix.h. + * io/list_read.c: Include fbuf.h and unix.h. + * io/open.c: Include fbuf.h and unix.h. + * io/read.c: Include format.h. + * io/transfer.c: Include fbuf.h, format.h, and unix.h. + * io/unit.c: Likewise. + * io/unix.c: Include unix.h. + * io/write.c: Include format.h and unix.h. + +2009-10-31 Janne Blomqvist + + PR libfortran/41219 + * intrinsics/unpack_generic.c (unpack_internal): Remove unused + argument from prototype. + (unpack1): Update unpack_internal call. + (unpack1_char): Likewise. + (unpack1_char4): Likewise. + (unpack0): Likewise. + (unpack0_char): Likewise. + (unpack0_char4): Likewise. + * intrinsics/iso_c_binding.c (c_f_pointer_u0): Get rid of + uninitialized variable warning. + +2009-10-29 Jerry DeLisle + + PR libgfortran/41711 + * libgfortran.h: Define larger sizes for BOZ conversion buffers. + * io/write.c (extract_uint): Include case where size is 10 if integer + is large enough. (write_int): Rename to write_boz. (write_boz): Factor + out extract_uint and delete the conversion function. + (btoa_big): New binary conversion function. + (otoa_big): New octal conversion function. + (ztoa_big): New hexidecimal conversion function. + (write_b): Modify to use new function. + (write_o): Likewise. + (write_z): Likewise. + +2009-10-12 Jerry DeLisle + + PR libgfortran/41683 + * io/format.c (parse_format_list): Allow a repeat specifier immediately + after a P specifier. + +2009-10-11 Jerry DeLisle + + PR libgfortran/38439 + * io/format.c (parse_format_list): Correct logic for FMT_F reading vs + writing. Code clean-up. + +2009-10-11 Jerry DeLisle + + PR libgfortran/38439 + * io/format.c (parse_format_list): Add check for tokens not allowed + after P specifier. Fix comments. Remove un-needed code. Fix the + default exponent list. Correct pointer assignment error. + +2009-10-05 Jerry DeLisle + + PR libgfortran/35862 + * write_float.def (outout_float): Fix handling of special case where no + digits after the decimal point and values less than 1.0. Adjust index + into digits string. (WRITE_FLOAT): Remove special case code from macro. + +2009-09-28 Jerry DeLisle + + PR libgfortran/35862 + * io.h (gfc_unit): Add round_status. + (format_token): Add enumerators for rounding format specifiers. + * transfer.c (round_opt): New options table. + (formatted_transfer_scalar_read): Add set round_status for each rounding + format token. (formatted_transfer_scalar_write): Likewise. + * format.c (format_lex): Tokenize the rounding format specifiers. + (parse_format_list): Parse the rounding format specifiers. + * write_float.def (outout_float): Modify rounding code to use new + variable rchar to set the appropriate rounding. Fix some whitespace. + * unit.c (get_internal_unit): Initialize rounding mode for internal + units. (init_units): Likewise. + +2009-09-19 Iain Sandoe + + * configure.ac: Check for GFORTRAN_C99_1.1 funcs in OS libm. + * configure: Regenerate. + * config.h.in: Ditto. + +2009-09-18 Jerry DeLisle + + PR libgfortran/41328 + * io/transfer.c (read_sf): Set at_eof flag on short read if any + characters were successfully read so that EOF condition with no EOR + marker succeeds. + +2009-09-12 Jerry DeLisle + + PR libgfortran/41328 + * io/transfer.c (read_sf): Adjust fbuf position and do proper + fbuf reads to traverse CR, CR-LF, and LF style line ends. + +2009-09-12 Jerry DeLisle + + PR libgfortran/41219 + * io/write.c (write_a_char4): Use correct type for crlf constant. + +2009-09-11 Ralf Wildenhues + + * Makefile.am (libgfortranbegin_la_LINK): New. + * Makefile.in: Regenerate. + +2009-09-09 Paolo Bonzini + + * configure: Regenerate. + +2009-09-08 Paolo Bonzini + + * configure: Regenerate. + +2009-09-07 Jerry DeLisle + + PR libgfortran/41192 + * io/list_read.c (eat_line): Enable eat_line to function on + internal units. + + PR libgfortran/41219 + * io/list_read.c (nml_read_obj): Replace GFC_DTYPE_UNKNOWN with + BT_NULL to get rid of warning. + +2009-09-04 Tobias Burnus + + PR fortran/41219 + * intrinsics/getlog.c: Define _POSIX for MINGW32. + +2009-09-03 Tobias Burnus + + PR fortran/41219 + * intrinsics/iso_c_binding.c (c_f_pointer_u0): Move variable + declaration out of the loop. + +2009-08-30 Thomas Koenig + + * m4/pack.m4 (pack_'rtype_code`): Use count_0 for counting true + values in a logical array. Mark bounds checking tests as + unlikely. + * intrinsics/pack_generic.c (pack_internal): Likewise. + * runtime/bounds.c (count_0): Fix off-by-one error in detecting + empty arrays. + * generated/pack_c4.c: Regenerated. + * generated/pack_c8.c: Regenerated. + * generated/pack_c10.c: Regenerated. + * generated/pack_c16.c: Regenerated. + * generated/pack_i1.c: Regenerated. + * generated/pack_i16.c: Regenerated. + * generated/pack_i2.c: Regenerated. + * generated/pack_i4.c: Regenerated. + * generated/pack_i8.c: Regenerated. + * generated/pack_r4.c: Regenerated. + * generated/pack_r8.c: Regenerated. + * generated/pack_r10.c: Regenerated. + * generated/pack_r16.c: Regenerated. + +2009-08-25 Thomas Koenig + + PR libfortran/34670 + * runtime/bounds.c (count_0): New function. + * intrinsics/unpack_generic (unpack_bounds): New function. + (unpack_internal): Remove zero stride checks. + (unpack1): Use unpack_bounds. + (unpack1_char): Likeweise. + (unpack1_char4): Likewise + (unpack0): Likewise. + (unpack0_char): Likewise. + (unpack0_char4): Likewise. + +2009-08-24 Steven G. Kargl + + PR fortran/41157 + * dtime.c (dtime_sub): Fix computing time increment. + * time_1.h: Add header. Use RUSAGE_SELF macro instead + of a hardcoded 0. + +2009-08-24 Ralf Wildenhues + + * configure.ac (AC_PREREQ): Bump to 2.64. + +2009-08-23 Steven G. Kargl + + * intrinsics/cshift0.c: Update license to GPL3+exception. + * runtime/fpu.c: Add a GPL3+exception statement. + +2009-08-22 Ralf Wildenhues + + * Makefile.am (install-html, install-pdf): Remove. + * Makefile.in: Regenerate. + + * Makefile.in: Regenerate. + * aclocal.m4: Regenerate. + * config.h.in: Regenerate. + * configure: Regenerate. + +2009-08-22 Ralf Wildenhues + + * Makefile.am (libgfortran_la_LINK): Add $(libgfortran_la_LDFLAGS). + * Makefile.in: Regenerate. + +2009-08-20 Thomas Koenig + + PR libfortran/40962 + * iso_c_binding.c (c_f_pointer_u0): Multiply stride by + previous stride. + +2009-08-20 Dave Korn + + * Makefile.am (LTLDFLAGS): Add -bindir flag. + * Makefile.in: Regenerate. + +2009-08-17 Jerry DeLisle + + PR fortran/41075 + * io/io.h (enum format_token): Add FMT_STAR. + * io/format.c (format_lex): Add case for FMT_STAR. + (parse_format_list): Parse FMT_STAR and check for left paren + after. (next_format0): Modify helper function to check for + unimited format and return the repeated format node. Update + comments to clarify. + +2009-08-15 Kai Tietz + + * intrinsics/string_intrinsics_inc.c (string_len_trim): Use + __INTPTR_TYPE__ to cast from pointer to scalar integer, if + __INTPTR_TYPE is defined. + +2009-08-14 Janne Blomqvist + + * fmain.c: Add comment saying file is deprecated. + +2009-08-14 Janne Blomqvist + + PR libfortran/40863 + * gfortran.map: Move new symbols to GFORTRAN_C99_1.1 version node. + +2009-08-09 Francois-Xavier Coudert + + PR libfortran/40549 + * Makefile.in (LTLDFLAGS): Add -no-undefined. + * Makefile.am: Regenerate. + * libgfortran.h: Remove unused block of code. + +2009-08-02 Jerry DeLisle + + PR libfortran/40853 + * io/list_read.c (nml_get_obj_data): Do not set nl + pointer to first_nl if nl->next is NULL. + +2009-07-31 Kaz Kojima + + * Makefile.am: Don't set SECTION_FLAGS with @SECTION_FLAGS@. + Don't set IEEE_FLAGS with @IEEE_FLAGS@. + * Makefile.in: Regenerate. + +2009-07-30 Kaz Kojima + + * configure.host: Define ieee_flags and set it to -mieee for sh. + * configure.ac: Set IEEE_FLAGS with ieee_flags. + * Makefile.am: Add IEEE_FLAGS to AM_CFLAGS. + * configure: Regenerate. + * Makefile.in: Regenerate. + +2009-07-30 Ralf Wildenhues + + * configure.ac (_AC_ARG_VAR_PRECIOUS): Use m4_rename_force. + +2009-07-27 Tobias Burnus + + PR fortran/40863 + * c99_functions.c: Define complex I, if not defined. + Create prototypes for C99 functions to silence warnings. + * gfortran.map: Add missing functions to GFORTRAN_C99_1.0 + and new GFORTRAN_C99_1.1. + +2009-07-25 Tobias Burnus + + PR fortran/33197 + * intrinsics/c99_functions.c (cacosf,cacos,cacosl,casinf, + casin,casind,catanf,catan,catanl,cacoshf,cacosh,cacoshl, + casinhf,casinh,casinhf,catanhf,catanh,catanhl): New functions. + * c99_protos.h: Add prototypes for those. + +2009-07-24 Jakub Jelinek + + PR fortran/40643 + PR fortran/31067 + * libgfortran.h (GFC_REAL_4_INFINITY, GFC_REAL_8_INFINITY, + GFC_REAL_10_INFINITY, GFC_REAL_16_INFINITY, GFC_REAL_4_QUIET_NAN, + GFC_REAL_8_QUIET_NAN, GFC_REAL_10_QUIET_NAN, GFC_REAL_16_QUIET_NAN): + Define. + * m4/iparm.m4 (atype_inf, atype_nan): Define. + * m4/ifunction.m4: Formatting. + * m4/iforeach.m4: Likewise. + (START_FOREACH_FUNCTION): Initialize dest to all 1s, not all 0s. + (START_FOREACH_BLOCK, FINISH_FOREACH_FUNCTION, + FINISH_MASKED_FOREACH_FUNCTION): Run foreach block inside a loop + until count[0] == extent[0]. + * m4/minval.m4: Formatting. Handle NaNs and infinities. Optimize. + * m4/maxval.m4: Likewise. + * m4/minloc0.m4: Likewise. + * m4/maxloc0.m4: Likewise. + * m4/minloc1.m4: Likewise. + * m4/maxloc1.m4: Likewise. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i1.c: Likewise. + * generated/maxloc0_16_i2.c: Likewise. + * generated/maxloc0_16_i4.c: Likewise. + * generated/maxloc0_16_i8.c: Likewise. + * generated/maxloc0_16_r10.c: Likewise. + * generated/maxloc0_16_r16.c: Likewise. + * generated/maxloc0_16_r4.c: Likewise. + * generated/maxloc0_16_r8.c: Likewise. + * generated/maxloc0_4_i16.c: Likewise. + * generated/maxloc0_4_i1.c: Likewise. + * generated/maxloc0_4_i2.c: Likewise. + * generated/maxloc0_4_i4.c: Likewise. + * generated/maxloc0_4_i8.c: Likewise. + * generated/maxloc0_4_r10.c: Likewise. + * generated/maxloc0_4_r16.c: Likewise. + * generated/maxloc0_4_r4.c: Likewise. + * generated/maxloc0_4_r8.c: Likewise. + * generated/maxloc0_8_i16.c: Likewise. + * generated/maxloc0_8_i1.c: Likewise. + * generated/maxloc0_8_i2.c: Likewise. + * generated/maxloc0_8_i4.c: Likewise. + * generated/maxloc0_8_i8.c: Likewise. + * generated/maxloc0_8_r10.c: Likewise. + * generated/maxloc0_8_r16.c: Likewise. + * generated/maxloc0_8_r4.c: Likewise. + * generated/maxloc0_8_r8.c: Likewise. + * generated/maxloc1_16_i16.c: Likewise. + * generated/maxloc1_16_i1.c: Likewise. + * generated/maxloc1_16_i2.c: Likewise. + * generated/maxloc1_16_i4.c: Likewise. + * generated/maxloc1_16_i8.c: Likewise. + * generated/maxloc1_16_r10.c: Likewise. + * generated/maxloc1_16_r16.c: Likewise. + * generated/maxloc1_16_r4.c: Likewise. + * generated/maxloc1_16_r8.c: Likewise. + * generated/maxloc1_4_i16.c: Likewise. + * generated/maxloc1_4_i1.c: Likewise. + * generated/maxloc1_4_i2.c: Likewise. + * generated/maxloc1_4_i4.c: Likewise. + * generated/maxloc1_4_i8.c: Likewise. + * generated/maxloc1_4_r10.c: Likewise. + * generated/maxloc1_4_r16.c: Likewise. + * generated/maxloc1_4_r4.c: Likewise. + * generated/maxloc1_4_r8.c: Likewise. + * generated/maxloc1_8_i16.c: Likewise. + * generated/maxloc1_8_i1.c: Likewise. + * generated/maxloc1_8_i2.c: Likewise. + * generated/maxloc1_8_i4.c: Likewise. + * generated/maxloc1_8_i8.c: Likewise. + * generated/maxloc1_8_r10.c: Likewise. + * generated/maxloc1_8_r16.c: Likewise. + * generated/maxloc1_8_r4.c: Likewise. + * generated/maxloc1_8_r8.c: Likewise. + * generated/maxval_i16.c: Likewise. + * generated/maxval_i1.c: Likewise. + * generated/maxval_i2.c: Likewise. + * generated/maxval_i4.c: Likewise. + * generated/maxval_i8.c: Likewise. + * generated/maxval_r10.c: Likewise. + * generated/maxval_r16.c: Likewise. + * generated/maxval_r4.c: Likewise. + * generated/maxval_r8.c: Likewise. + * generated/minloc0_16_i16.c: Likewise. + * generated/minloc0_16_i1.c: Likewise. + * generated/minloc0_16_i2.c: Likewise. + * generated/minloc0_16_i4.c: Likewise. + * generated/minloc0_16_i8.c: Likewise. + * generated/minloc0_16_r10.c: Likewise. + * generated/minloc0_16_r16.c: Likewise. + * generated/minloc0_16_r4.c: Likewise. + * generated/minloc0_16_r8.c: Likewise. + * generated/minloc0_4_i16.c: Likewise. + * generated/minloc0_4_i1.c: Likewise. + * generated/minloc0_4_i2.c: Likewise. + * generated/minloc0_4_i4.c: Likewise. + * generated/minloc0_4_i8.c: Likewise. + * generated/minloc0_4_r10.c: Likewise. + * generated/minloc0_4_r16.c: Likewise. + * generated/minloc0_4_r4.c: Likewise. + * generated/minloc0_4_r8.c: Likewise. + * generated/minloc0_8_i16.c: Likewise. + * generated/minloc0_8_i1.c: Likewise. + * generated/minloc0_8_i2.c: Likewise. + * generated/minloc0_8_i4.c: Likewise. + * generated/minloc0_8_i8.c: Likewise. + * generated/minloc0_8_r10.c: Likewise. + * generated/minloc0_8_r16.c: Likewise. + * generated/minloc0_8_r4.c: Likewise. + * generated/minloc0_8_r8.c: Likewise. + * generated/minloc1_16_i16.c: Likewise. + * generated/minloc1_16_i1.c: Likewise. + * generated/minloc1_16_i2.c: Likewise. + * generated/minloc1_16_i4.c: Likewise. + * generated/minloc1_16_i8.c: Likewise. + * generated/minloc1_16_r10.c: Likewise. + * generated/minloc1_16_r16.c: Likewise. + * generated/minloc1_16_r4.c: Likewise. + * generated/minloc1_16_r8.c: Likewise. + * generated/minloc1_4_i16.c: Likewise. + * generated/minloc1_4_i1.c: Likewise. + * generated/minloc1_4_i2.c: Likewise. + * generated/minloc1_4_i4.c: Likewise. + * generated/minloc1_4_i8.c: Likewise. + * generated/minloc1_4_r10.c: Likewise. + * generated/minloc1_4_r16.c: Likewise. + * generated/minloc1_4_r4.c: Likewise. + * generated/minloc1_4_r8.c: Likewise. + * generated/minloc1_8_i16.c: Likewise. + * generated/minloc1_8_i1.c: Likewise. + * generated/minloc1_8_i2.c: Likewise. + * generated/minloc1_8_i4.c: Likewise. + * generated/minloc1_8_i8.c: Likewise. + * generated/minloc1_8_r10.c: Likewise. + * generated/minloc1_8_r16.c: Likewise. + * generated/minloc1_8_r4.c: Likewise. + * generated/minloc1_8_r8.c: Likewise. + * generated/minval_i16.c: Likewise. + * generated/minval_i1.c: Likewise. + * generated/minval_i2.c: Likewise. + * generated/minval_i4.c: Likewise. + * generated/minval_i8.c: Likewise. + * generated/minval_r10.c: Likewise. + * generated/minval_r16.c: Likewise. + * generated/minval_r4.c: Likewise. + * generated/minval_r8.c: Likewise. + * generated/product_c10.c: Likewise. + * generated/product_c16.c: Likewise. + * generated/product_c4.c: Likewise. + * generated/product_c8.c: Likewise. + * generated/product_i16.c: Likewise. + * generated/product_i1.c: Likewise. + * generated/product_i2.c: Likewise. + * generated/product_i4.c: Likewise. + * generated/product_i8.c: Likewise. + * generated/product_r10.c: Likewise. + * generated/product_r16.c: Likewise. + * generated/product_r4.c: Likewise. + * generated/product_r8.c: Likewise. + * generated/sum_c10.c: Likewise. + * generated/sum_c16.c: Likewise. + * generated/sum_c4.c: Likewise. + * generated/sum_c8.c: Likewise. + * generated/sum_i16.c: Likewise. + * generated/sum_i1.c: Likewise. + * generated/sum_i2.c: Likewise. + * generated/sum_i4.c: Likewise. + * generated/sum_i8.c: Likewise. + * generated/sum_r10.c: Likewise. + * generated/sum_r16.c: Likewise. + * generated/sum_r4.c: Likewise. + * generated/sum_r8.c: Likewise. + +2009-07-22 Jerry DeLisle + + PR libfortran/32784 + * unix.c (regular_file): Check for CONIN$ CONOUT$, and CONERR$ and open + the respective /dev/conin or /dev/conout devices. This is Cygwin + specific. + +2009-07-19 Thomas Koenig + + PR libfortran/34670 + PR libfortran/36874 + * Makefile.am: Add bounds.c + * libgfortran.h (bounds_equal_extents): Add prototype. + (bounds_iforeach_return): Likewise. + (bounds_ifunction_return): Likewise. + (bounds_reduced_extents): Likewise. + * runtime/bounds.c: New file. + (bounds_iforeach_return): New function; correct typo in + error message. + (bounds_ifunction_return): New function. + (bounds_equal_extents): New function. + (bounds_reduced_extents): Likewise. + * intrinsics/cshift0.c (cshift0): Use new functions + for bounds checking. + * intrinsics/eoshift0.c (eoshift0): Likewise. + * intrinsics/eoshift2.c (eoshift2): Likewise. + * m4/iforeach.m4: Likewise. + * m4/eoshift1.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * m4/cshift1.m4: Likewise. + * m4/ifunction.m4: Likewise. + * Makefile.in: Regenerated. + * generated/cshift1_16.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/eoshift1_16.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + +2009-07-17 Janne Blomqvist + Jerry DeLisle + + PR libfortran/40714 + * io/transfer.c (finalize_transfer): Set current_record to 0 + before returning in case of error. + +2009-07-12 Tobias Burnus + + PR libfortran/22423 + * io/io.h (namelist_type): Use the proper enum for GFC_DTYPE_*. + * intrinsics/iso_c_binding.c (c_f_pointer_u0): Make sure + variable is initialized to silence warning. + +2009-07-10 Steven G. Kargl + + * c99_functions.c (ccoshf, ccosh, ccoshl, ctanhf, ctanh, ctanl): + Fix errant minus. + +2009-07-08 Jerry DeLisle + + PR libfortran/40330 + PR libfortran/40662 + * io/io.h (st_parameter_dt): Define format_not_saved bit used to signal + whether the parsed format data was previously saved. Used to determine + if the current format data should be freed or not. + * io/transfer.c (st_read_done): Use the format_not_saved bit. + (st_write_done): Likewise. + * io/format.c (parse_format_list): Add boolean pointer to arg list. This + pointer is used to return status to the caller regarding whether it is + safe to cache the parsed format data. Currently, if a FMT_STRING token + is encounetered, it is not safe to cache. Also, added a local boolean + variable to hold this information as recursive calls to + parse_format_list are made. Remove previous save_format logic. + (parse_format): Do not use the format caching facility if the current + unit is an internal unit or if it is not safe to save parsed format + data. + +2009-06-29 Jerry DeLisle + + PR libfortran/40576 + * io/transfer.c (sset): Adjust exit condition for loop. + +2009-06-22 Jerry DeLisle + + PR libfortran/40508 + * io/format.c: Don't save parsed format data for internal units. + +2009-06-21 Thomas Koenig + + PR fortran/37577 + Port from fortran-dev + * runtime/in_pack_generic (internal_pack): Remove unnecessary + test for stride == 0. + * runtime/in_unpack_generic.c (internal_unpack): Likewise. + * intrinsics/iso_c_binding.c (c_f_pointer_u0): Take care + of stride in "shape" argument. Use array access macros for + accessing array descriptors. + * libgfortran.h (struct descriptor_dimension): Change stride + to _stride, lbound to _lbound and ubound to _ubound. + (GFC_DIMENSION_LBOUND): Use new name(s) in struct + descriptor_dimension. + (GFC_DIMENSION_UBOUND): Likewise. + (GFC_DIMENSION_STRIDE): Likewise. + (GFC_DIMENSION_EXTENT): Likewise. + (GFC_DIMENSION_SET): Likewise. + (GFC_DESCRIPTOR_LBOUND): Likewise. + (GFC_DESCRIPTOR_UBOUND): Likewise. + (GFC_DESCRIPTOR_EXTENT): Likewise. + (GFC_DESCRIPTOR_STRIDE): Likewise. + * io/transfer.c (transfer_array): Use array access macros. + Use byte-sized strides. + * intrinsics/eoshift0.c (eoshift0): Use array access + macros everywhere. + * m4/in_pack.m4 (internal_pack_'rtype_ccode`): Use + array access macros for accessing array descriptors. + * m4/in_unpack.m4 (internal_unpack_'rtype_ccode`): + Likewise. + * m4/matmull.m4 (matmul_'rtype_code`): Likewise. + * m4/matmul.m4 (matmul_'rtype_code`): Likewise. + * m4/unpack.m4 (unpack0_'rtype_code`): Likewise. + (unpack1_'rtype_code`): Likewise. + * m4/ifunction_logical.m4 (name`'rtype_qual`_'atype_code): Likewise. + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Use array access + macros everywhere. + * intrinsics/dtime.c (dtime_sub): Use array access macros + for accessing array descriptors. + * intrinsics/cshift0 (cshift0): Likewise. + * intrinsics/etime.c: Likewise. Remove redundant calculation + of rdim. + * m4/cshift0.m4 (cshift0_'rtype_code`): Use array access macros + for accessing array descriptors. + * m4/pack.m4 (pack_'rtype_code`): Likewise. + * m4/spread.m4 (spread_'rtype_code`): Likewise. + (spread_scalar_'rtype_code`): Likewise. + * m4/transpose.m4 (transpose_'rtype_code`): Likewise. + * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise. + * m4/eoshift1.m4 (eoshift1): Likewise. Remove size argument, + calculate within function. + (eoshift1_'atype_kind`): Remove size argument from call + to eoshift1. + (eoshift1_'atype_kind`_char): Likewise. + (eoshift1_'atype_kind`_char4): Likewise. + * m4/eoshift3.m4 (eoshift3): Remove size argument, calculate + within function. Use array access macros for accessing array + descriptors. + (eoshift3_'atype_kind`): Remove size argument from call + to eoshift1. + (eoshift3_'atype_kind`_char): Likewise. + (eoshift3_'atype_kind`_char4): Likewise. + * m4/shape.m4 (shape_'rtype_kind`): Use array access macros + for accessing array descriptors. + * m4/cshift1.m4 (cshift1): Remove size argument, calculate + within function. Use array access macros for accessing array + descriptors. + (cshift1_'atype_kind`): Remove size argument from call to + cshift1. + (cshift1_'atype_kind`_char): Remove size argument from call to + cshift1. + (cshift1_'atype_kind`_char4): Remove size argument from call to + cshift1. + * m4/reshape.m4 (reshape_'rtype_ccode`): Use array access macros + for accessing array descriptors. + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Likewise. + * intrinsics/pack_generic.c (pack_internal): Use array access + macros for accessing array descriptors. + (pack_s_internal): Likewise. + * intrinsics/transpose_generic.c (transpose_internal): Remove + size argument, calculate from array descriptor. Use array + access macros for accessing array descriptors. + (transpose): Remove size argument from call. + (transpoe_char): Likewise. + (transpose_char4): Likewise. + * intrinsics/move_alloc.c (move_alloc): Use array access macros + for accessing array descriptors. + * intrinsics/spread_generic.c (spread_internal): Remove size + argument, calculate from array descriptor. Use array access + macros for accessing array descriptors. + (spread_internal_scalar): Likewise. + (spread): Remove size argument from call to spread_internal. + (spread_char): Mark argument source_length as unused. + Remove size argument from call to spread_internal. + (spread_char4): Likewise. + (spread_char_scalar): Likewise. + (spread_char4_scalar): Likewise. + * intrinsics/unpack_generic.c (unpack_internal): Use array access + macros for accessing array descriptors. + * intrinsics/eoshift2.c (eoshift2): Remove size argument, calculate + from array descriptor instead. Use array access macros for + accessing array descriptors. + (eoshift2_##N): Remove size argument from call to eoshift2. + (eoshift2_##N_##char): Likewise. + (eoshift2_##N_##char4): Likewise. + * intrinsics/reshape_generic.c (reshape_internal): Use array + access macross for accessing array descriptors. + * libgfortran.h: Introduce new macros GFC_DIMENSION_LBOUND, + GFC_DIMENSION_UBOUND,GFC_DIMENSION_STRIDE, GFC_DIMENSION_EXTENT, + GFC_DIMENSION_SET, GFC_DESCRIPTOR_LBOUND, GFC_DESCRIPTOR_UBOUND, + GFC_DESCRIPTOR_EXTENT, GFC_DESCRIPTOR_EXTENT_BYTES, + GFC_DESCRIPTOR_STRIDE, GFC_DESCRIPTOR_STRIDE_BYTES + * runtime/in_pack_generic.c (internal_pack): Use new macros + for array descriptor access. + * runtime/in_unpack_generic.c (internal_unpack): Likewise. + * intrinsics/dtime.c (dtime_sub): Likewise. + * intrinsics/cshift0 (cshift0): Remove argument size, + calculate directly from the array descriptor. Use new macros + for array descriptor access. + * cshift0_##N: Remove shift argument in call to cshift0. + * cshift0_##N_char: Mark array_length as unused. Remove + array_length in call to cshift0. + * cshift0_##N_char4: Likewise. + * intrisics/etime.c: Use new macros for array descriptor access. + * intrinsics/stat.c (stat_i4_sub_0): Likewise. + (stat_i8_sub_0): Likewise. + (fstat_i4_sub): Likewise. + (fstat_i8_sub): Likewise. + * intrinsics/date_and_time.c (date_and_time): Likewise. + (secnds): Likewise. + (itime_i4): Likewise. + (itime_i8): Likewise. + (idate_i4): Likewise. + (idate_i8): Likewise. + (gmtime_i4): Likewise. + (gmtime_i8): Likewise. + (ltime_i4): Likewise. + (litme_i8): Likewise. + * intrinsics/associated.c (associated): Likewise. + * intrinsics/eoshift0.c (eoshift0): Likewise. + * intriniscs/size.c (size0): Likewise. + * intrinsics/random.c (arandom_r4): Likewise. + (arandom_r8): Likewise. + (arandom_r10): Likewise. + (arandom_r16): Likewise. + (random_seed_i4): Likewise. + (random_seed_i8): Likewise. + * io/list_read.c (nml_parse_qualifier): Likewise. + (nml_touch_nodes): Likewise. + (nml_read_obj): Likewise. + (get_name): Likewise. + * io/transfer.c (transfer_array): Likewise. + (init_loop_spec): Likewise. + (st_set_nml_var_dim): Likewise. + * io/write.c (nml_write_obj): Likewise. + (obj_loop): Likewise. + * generated/all_l1.c: Regenerated. + * generated/all_l16.c: Regenerated. + * generated/all_l2.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l1.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/any_l2.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_16_l.c: Regenerated. + * generated/count_1_l.c: Regenerated. + * generated/count_2_l.c: Regenerated. + * generated/count_4_l.c: Regenerated. + * generated/count_8_l.c: Regenerated. + * generated/cshift0_c10.c: Regenerated. + * generated/cshift0_c16.c: Regenerated. + * generated/cshift0_c4.c: Regenerated. + * generated/cshift0_c8.c: Regenerated. + * generated/cshift0_i1.c: Regenerated. + * generated/cshift0_i16.c: Regenerated. + * generated/cshift0_i2.c: Regenerated. + * generated/cshift0_i4.c: Regenerated. + * generated/cshift0_i8.c: Regenerated. + * generated/cshift0_r10.c: Regenerated. + * generated/cshift0_r16.c: Regenerated. + * generated/cshift0_r4.c: Regenerated. + * generated/cshift0_r8.c: Regenerated. + * generated/cshift1_16.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/eoshift1_16.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.c: Regenerated. + * generated/in_pack_c10.c: Regenerated. + * generated/in_pack_c16.c: Regenerated. + * generated/in_pack_c4.c: Regenerated. + * generated/in_pack_c8.c: Regenerated. + * generated/in_pack_i1.c: Regenerated. + * generated/in_pack_i16.c: Regenerated. + * generated/in_pack_i2.c: Regenerated. + * generated/in_pack_i4.c: Regenerated. + * generated/in_pack_i8.c: Regenerated. + * generated/in_pack_r10.c: Regenerated. + * generated/in_pack_r16.c: Regenerated. + * generated/in_pack_r4.c: Regenerated. + * generated/in_pack_r8.c: Regenerated. + * generated/in_unpack_c10.c: Regenerated. + * generated/in_unpack_c16.c: Regenerated. + * generated/in_unpack_c4.c: Regenerated. + * generated/in_unpack_c8.c: Regenerated. + * generated/in_unpack_i1.c: Regenerated. + * generated/in_unpack_i16.c: Regenerated. + * generated/in_unpack_i2.c: Regenerated. + * generated/in_unpack_i4.c: Regenerated. + * generated/in_unpack_i8.c: Regenerated. + * generated/in_unpack_r10.c: Regenerated. + * generated/in_unpack_r16.c: Regenerated. + * generated/in_unpack_r4.c: Regenerated. + * generated/in_unpack_r8.c: Regenerated. + * generated/matmul_c10.c: Regenerated. + * generated/matmul_c16.c: Regenerated. + * generated/matmul_c4.c: Regenerated. + * generated/matmul_c8.c: Regenerated. + * generated/matmul_i1.c: Regenerated. + * generated/matmul_i16.c: Regenerated. + * generated/matmul_i2.c: Regenerated. + * generated/matmul_i4.c: Regenerated. + * generated/matmul_i8.c: Regenerated. + * generated/matmul_l16.c: Regenerated. + * generated/matmul_l4.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + * generated/matmul_r10.c: Regenerated. + * generated/matmul_r16.c: Regenerated. + * generated/matmul_r4.c: Regenerated. + * generated/matmul_r8.c: Regenerated. + * generated/maxloc0_16_i1.c: Regenerated. + * generated/maxloc0_16_i16.c: Regenerated. + * generated/maxloc0_16_i2.c: Regenerated. + * generated/maxloc0_16_i4.c: Regenerated. + * generated/maxloc0_16_i8.c: Regenerated. + * generated/maxloc0_16_r10.c: Regenerated. + * generated/maxloc0_16_r16.c: Regenerated. + * generated/maxloc0_16_r4.c: Regenerated. + * generated/maxloc0_16_r8.c: Regenerated. + * generated/maxloc0_4_i1.c: Regenerated. + * generated/maxloc0_4_i16.c: Regenerated. + * generated/maxloc0_4_i2.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r10.c: Regenerated. + * generated/maxloc0_4_r16.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i1.c: Regenerated. + * generated/maxloc0_8_i16.c: Regenerated. + * generated/maxloc0_8_i2.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r10.c: Regenerated. + * generated/maxloc0_8_r16.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_16_i1.c: Regenerated. + * generated/minloc0_16_i16.c: Regenerated. + * generated/minloc0_16_i2.c: Regenerated. + * generated/minloc0_16_i4.c: Regenerated. + * generated/minloc0_16_i8.c: Regenerated. + * generated/minloc0_16_r10.c: Regenerated. + * generated/minloc0_16_r16.c: Regenerated. + * generated/minloc0_16_r4.c: Regenerated. + * generated/minloc0_16_r8.c: Regenerated. + * generated/minloc0_4_i1.c: Regenerated. + * generated/minloc0_4_i16.c: Regenerated. + * generated/minloc0_4_i2.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r10.c: Regenerated. + * generated/minloc0_4_r16.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i1.c: Regenerated. + * generated/minloc0_8_i16.c: Regenerated. + * generated/minloc0_8_i2.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r10.c: Regenerated. + * generated/minloc0_8_r16.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/pack_c10.c: Regenerated. + * generated/pack_c16.c: Regenerated. + * generated/pack_c4.c: Regenerated. + * generated/pack_c8.c: Regenerated. + * generated/pack_i1.c: Regenerated. + * generated/pack_i16.c: Regenerated. + * generated/pack_i2.c: Regenerated. + * generated/pack_i4.c: Regenerated. + * generated/pack_i8.c: Regenerated. + * generated/pack_r10.c: Regenerated. + * generated/pack_r16.c: Regenerated. + * generated/pack_r4.c: Regenerated. + * generated/pack_r8.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/reshape_c10.c: Regenerated. + * generated/reshape_c16.c: Regenerated. + * generated/reshape_c4.c: Regenerated. + * generated/reshape_c8.c: Regenerated. + * generated/reshape_i16.c: Regenerated. + * generated/reshape_i4.c: Regenerated. + * generated/reshape_i8.c: Regenerated. + * generated/reshape_r10.c: Regenerated. + * generated/reshape_r16.c: Regenerated. + * generated/reshape_r4.c: Regenerated. + * generated/reshape_r8.c: Regenerated. + * generated/shape_i16.c: Regenerated. + * generated/shape_i4.c: Regenerated. + * generated/shape_i8.c: Regenerated. + * generated/spread_c10.c: Regenerated. + * generated/spread_c16.c: Regenerated. + * generated/spread_c4.c: Regenerated. + * generated/spread_c8.c: Regenerated. + * generated/spread_i1.c: Regenerated. + * generated/spread_i16.c: Regenerated. + * generated/spread_i2.c: Regenerated. + * generated/spread_i4.c: Regenerated. + * generated/spread_i8.c: Regenerated. + * generated/spread_r10.c: Regenerated. + * generated/spread_r16.c: Regenerated. + * generated/spread_r4.c: Regenerated. + * generated/spread_r8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + * generated/transpose_c10.c: Regenerated. + * generated/transpose_c16.c: Regenerated. + * generated/transpose_c4.c: Regenerated. + * generated/transpose_c8.c: Regenerated. + * generated/transpose_i16.c: Regenerated. + * generated/transpose_i4.c: Regenerated. + * generated/transpose_i8.c: Regenerated. + * generated/transpose_r10.c: Regenerated. + * generated/transpose_r16.c: Regenerated. + * generated/transpose_r4.c: Regenerated. + * generated/transpose_r8.c: Regenerated. + * generated/unpack_c10.c: Regenerated. + * generated/unpack_c16.c: Regenerated. + * generated/unpack_c4.c: Regenerated. + * generated/unpack_c8.c: Regenerated. + * generated/unpack_i1.c: Regenerated. + * generated/unpack_i16.c: Regenerated. + * generated/unpack_i2.c: Regenerated. + * generated/unpack_i4.c: Regenerated. + * generated/unpack_i8.c: Regenerated. + * generated/unpack_r10.c: Regenerated. + * generated/unpack_r16.c: Regenerated. + * generated/unpack_r4.c: Regenerated. + * generated/unpack_r8.c: Regenerated. + +2009-06-14 Francois-Xavier Coudert + + * fmain.c (main): Don't PREFIX set_args. + * libgfortran.h (set_args): Use iexport_proto. + * runtime/main.c (set_args): Use iexport. + +2009-06-07 Jerry DeLisle + + PR libfortran/40008 + * libgfortran.h: Define IOPARM_OPEN_HAS_NEWUNIT. + * io/open.c (st_open): Don't error on negative unit number if NEWUNIT + was specified. If NEWUNIT is specified, call new function to get the + unique unit number and assign it. + * io/io.h (st_parameter_open): Add pointer to newunit. Add prototype for + next_available_newunit. Add prototype for new function, + get_unique_unit_number. + * io/unit.c: Declare next_available_newunit. Define the first newunit + number. (init_units): Initialize next_available_unit. + (get_unique_unit_number): New function. Fix whitespace and comments. + * io/transfer.c (data_transfer_init): Update error message to not be + specific to OPEN statements. + +2009-06-07 Jerry DeLisle + + PR libfortran/40334 + * io/list_read.c (list_formatted_read_scalar): Set the end file + conditions after a return from EOF error. + +2009-06-04 Janne Blomqvist + + PR libfortran/40330 + * io/format.c (free_format_hash_table): Also free and nullify hash key. + (save_parsed_format): Copy string rather than pointer copy. + +2009-05-29 Francois-Xavier Coudert + + PR fortran/40019 + * intrinsics/bit_intrinsics.c: New file. + * gfortran.map (GFORTRAN_1.2): New list. + * Makefile.am: Add intrinsics/bit_intrinsics.c. + * Makefile.in: Regenerate. + +2009-05-29 Janne Blomqvist + + PR libfortran/40190 + * configure.ac: Check for localtime_r and gmtime_r. + * intrinsics/date_and_time.c: Add fallback implementations for + localtime_r and gmtime_r. + (date_and_time): Change to use localtime_r and gmtime_r instead of + localtime and gmtime, respectively. + (itime0): Use localtime_r instead of localtime. + (ltime_0): Likewise. + (gmtime_0): Use gmtime_r instead of gmtime. + * config.h.in: Regenerated + * configure: Regenerated. + +2009-05-27 Janne Blomqvist + + PR fortran/39178 + * runtime/main.c (store_exe_path): Remove static attribute. + * libgfortran.h: Add back store_exe_path prototype. + +2009-05-27 Thomas Koenig + + PR libfortran/40187 + * intrinsics/iso_c_binding.c (c_f_pointer_u0): Take care + of stride in "shape" argument. + +2009-05-26 Tobias Burnus + + PR fortran/39178 + * runtime/main.c (store_exe_path): Make static + and multiple-times callable. + (set_args): Call store_exe_path. + * libgfortran.h: Remove store_exe_path prototype. + * fmain.c (main): Remove store_exe_path call. + +2009-05-19 Jerry DeLisle + + PR libfortran/37754 + * io/write_float.def: Simplify format calculation. + +2009-05-07 Francois-Xavier Coudert + + PR fortran/22423 + * io/transfer.c (read_block_direct): Avoid warning. + * runtime/string.c (compare0): Avoid warning. + +2009-04-30 Janne Blomqvist + + PR libfortran/39667 + * io/file_pos.c (st_rewind): Don't truncate or flush. + * io/intrinsics.c (fgetc): Flush if switching mode. + (fputc): Likewise. + +2009-04-18 Janne Blomqvist + + PR libfortran/39782 + * io/transfer.c (data_transfer_init): Don't flush before seek. + (finalize_transfer): Remove extra flush. + +2009-04-17 Janne Blomqvist + + * io/io.h (is_preconnected): Remove prototype. + * io/unix.c (is_preconnected): Remove function. + +2009-04-17 Ulrich Weigand + + * configure.ac: Test for -ffunction-sections -fdata-sections and + set SECTION_FLAGS accordingly. + * configure: Regenerate. + + * Makefile.am: Add SECTION_FLAGS to AM_CFLAGS. + * Makefile.in: Regenerate. + +2009-04-15 Janne Blomqvist + + PR libfortran/38668 + * io/transfer.c (finalize_transfer): Don't flush for advance='no'. + +2009-04-15 Danny Smith + + * io/write.c (itoa) : Rename back to gfc_itoa. + (write_i): Adjust call to write_decimal. + (write_integer): Use gfc_itoa. + +2009-04-10 Janne Blomqvist + + * io/io.h (move_pos_offset): Remove prototype. + * io/transfer.c (formatted_transfer_scalar_read): Use sseek + instead of move_pos_offset. + * io/unix.c (move_pos_offset): Remove. + +2009-04-10 Janne Blomqvist + + PR libfortran/39665 libfortran/39702 libfortran/39709 + * io/io.h (st_parameter_dt): Revert aligned attribute from u.p.value. + * io/list_read.c (read_complex): Read directly into user pointer. + (read_real): Likewise. + (list_formatted_read_scalar): Update read_complex and read_real calls. + (nml_read_obj): Read directly into user pointer. + +2009-04-09 Janne Blomqvist + + PR libfortran/39665 + * io/io.h (st_parameter_dt): Add aligned attribute to u.p.value. + * io/read.c (convert_real): Add note about alignment requirements. + +2009-04-09 Nick Clifton + + * m4/cshift0.m4: Change copyright header to refer to version 3 + of the GNU General Public License with version 3.1 of the GCC + Runtime Library Exception and to point readers at the COPYING3 + and COPYING3.RUNTIME files and the FSF's license web page. + * c99_protos.h: Likewise. + * config/fpu-387.h: Likewise. + * config/fpu-aix.h: Likewise. + * config/fpu-generic.h: Likewise. + * config/fpu-glibc.h: Likewise. + * config/fpu-sysv.h: Likewise. + * intrinsics/abort.c: Likewise. + * intrinsics/access.c: Likewise. + * intrinsics/args.c: Likewise. + * intrinsics/associated.c: Likewise. + * intrinsics/c99_functions.c: Likewise. + * intrinsics/chdir.c: Likewise. + * intrinsics/chmod.c: Likewise. + * intrinsics/clock.c: Likewise. + * intrinsics/cpu_time.c: Likewise. + * intrinsics/cshift0.c: Likewise. + * intrinsics/ctime.c: Likewise. + * intrinsics/date_and_time.c: Likewise. + * intrinsics/dprod_r8.f90: Likewise. + * intrinsics/dtime.c: Likewise. + * intrinsics/env.c: Likewise. + * intrinsics/eoshift0.c: Likewise. + * intrinsics/eoshift2.c: Likewise. + * intrinsics/erfc_scaled.c: Likewise. + * intrinsics/erfc_scaled_inc.c: Likewise. + * intrinsics/etime.c: Likewise. + * intrinsics/exit.c: Likewise. + * intrinsics/f2c_specifics.F90: Likewise. + * intrinsics/fnum.c: Likewise. + * intrinsics/gerror.c: Likewise. + * intrinsics/getXid.c: Likewise. + * intrinsics/getcwd.c: Likewise. + * intrinsics/getlog.c: Likewise. + * intrinsics/hostnm.c: Likewise. + * intrinsics/ierrno.c: Likewise. + * intrinsics/ishftc.c: Likewise. + * intrinsics/iso_c_binding.c: Likewise. + * intrinsics/iso_c_binding.h: Likewise. + * intrinsics/iso_c_generated_procs.c: Likewise. + * intrinsics/kill.c: Likewise. + * intrinsics/link.c: Likewise. + * intrinsics/malloc.c: Likewise. + * intrinsics/move_alloc.c: Likewise. + * intrinsics/mvbits.c: Likewise. + * intrinsics/pack_generic.c: Likewise. + * intrinsics/perror.c: Likewise. + * intrinsics/rand.c: Likewise. + * intrinsics/random.c: Likewise. + * intrinsics/rename.c: Likewise. + * intrinsics/reshape_generic.c: Likewise. + * intrinsics/reshape_packed.c: Likewise. + * intrinsics/selected_char_kind.c: Likewise. + * intrinsics/selected_int_kind.f90: Likewise. + * intrinsics/selected_real_kind.f90: Likewise. + * intrinsics/signal.c: Likewise. + * intrinsics/size.c: Likewise. + * intrinsics/sleep.c: Likewise. + * intrinsics/spread_generic.c: Likewise. + * intrinsics/stat.c: Likewise. + * intrinsics/string_intrinsics.c: Likewise. + * intrinsics/string_intrinsics_inc.c: Likewise. + * intrinsics/symlnk.c: Likewise. + * intrinsics/system.c: Likewise. + * intrinsics/system_clock.c: Likewise. + * intrinsics/time.c: Likewise. + * intrinsics/time_1.h: Likewise. + * intrinsics/transpose_generic.c: Likewise. + * intrinsics/umask.c: Likewise. + * intrinsics/unlink.c: Likewise. + * intrinsics/unpack_generic.c: Likewise. + * io/close.c: Likewise. + * io/fbuf.c: Likewise. + * io/file_pos.c: Likewise. + * io/format.c: Likewise. + * io/inquire.c: Likewise. + * io/intrinsics.c: Likewise. + * io/io.h: Likewise. + * io/list_read.c: Likewise. + * io/lock.c: Likewise. + * io/open.c: Likewise. + * io/read.c: Likewise. + * io/size_from_kind.c: Likewise. + * io/transfer.c: Likewise. + * io/unit.c: Likewise. + * io/unix.c: Likewise. + * io/write.c: Likewise. + * io/write_float.def: Likewise. + * libgfortran.h: Likewise. + * m4/all.m4: Likewise. + * m4/any.m4: Likewise. + * m4/count.m4: Likewise. + * m4/cshift1.m4: Likewise. + * m4/eoshift1.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * m4/exponent.m4: Likewise. + * m4/fraction.m4: Likewise. + * m4/head.m4: Likewise. + * m4/in_pack.m4: Likewise. + * m4/in_unpack.m4: Likewise. + * m4/matmul.m4: Likewise. + * m4/matmull.m4: Likewise. + * m4/maxloc0.m4: Likewise. + * m4/maxloc1.m4: Likewise. + * m4/maxval.m4: Likewise. + * m4/minloc0.m4: Likewise. + * m4/minloc1.m4: Likewise. + * m4/minval.m4: Likewise. + * m4/nearest.m4: Likewise. + * m4/pack.m4: Likewise. + * m4/pow.m4: Likewise. + * m4/product.m4: Likewise. + * m4/reshape.m4: Likewise. + * m4/rrspacing.m4: Likewise. + * m4/set_exponent.m4: Likewise. + * m4/shape.m4: Likewise. + * m4/spacing.m4: Likewise. + * m4/spread.m4: Likewise. + * m4/sum.m4: Likewise. + * m4/transpose.m4: Likewise. + * m4/unpack.m4: Likewise. + * runtime/backtrace.c: Likewise. + * runtime/compile_options.c: Likewise. + * runtime/convert_char.c: Likewise. + * runtime/environ.c: Likewise. + * runtime/error.c: Likewise. + * runtime/in_pack_generic.c: Likewise. + * runtime/in_unpack_generic.c: Likewise. + * runtime/main.c: Likewise. + * runtime/memory.c: Likewise. + * runtime/pause.c: Likewise. + * runtime/select.c: Likewise. + * runtime/select_inc.c: Likewise. + * runtime/stop.c: Likewise. + * runtime/string.c: Likewise. + * generated/_abs_c10.F90: Regenerate. + * generated/_abs_c16.F90: Regenerate. + * generated/_abs_c4.F90: Regenerate. + * generated/_abs_c8.F90: Regenerate. + * generated/_abs_i16.F90: Regenerate. + * generated/_abs_i4.F90: Regenerate. + * generated/_abs_i8.F90: Regenerate. + * generated/_abs_r10.F90: Regenerate. + * generated/_abs_r16.F90: Regenerate. + * generated/_abs_r4.F90: Regenerate. + * generated/_abs_r8.F90: Regenerate. + * generated/_acos_r10.F90: Regenerate. + * generated/_acos_r16.F90: Regenerate. + * generated/_acos_r4.F90: Regenerate. + * generated/_acos_r8.F90: Regenerate. + * generated/_acosh_r10.F90: Regenerate. + * generated/_acosh_r16.F90: Regenerate. + * generated/_acosh_r4.F90: Regenerate. + * generated/_acosh_r8.F90: Regenerate. + * generated/_aimag_c10.F90: Regenerate. + * generated/_aimag_c16.F90: Regenerate. + * generated/_aimag_c4.F90: Regenerate. + * generated/_aimag_c8.F90: Regenerate. + * generated/_aint_r10.F90: Regenerate. + * generated/_aint_r16.F90: Regenerate. + * generated/_aint_r4.F90: Regenerate. + * generated/_aint_r8.F90: Regenerate. + * generated/_anint_r10.F90: Regenerate. + * generated/_anint_r16.F90: Regenerate. + * generated/_anint_r4.F90: Regenerate. + * generated/_anint_r8.F90: Regenerate. + * generated/_asin_r10.F90: Regenerate. + * generated/_asin_r16.F90: Regenerate. + * generated/_asin_r4.F90: Regenerate. + * generated/_asin_r8.F90: Regenerate. + * generated/_asinh_r10.F90: Regenerate. + * generated/_asinh_r16.F90: Regenerate. + * generated/_asinh_r4.F90: Regenerate. + * generated/_asinh_r8.F90: Regenerate. + * generated/_atan2_r10.F90: Regenerate. + * generated/_atan2_r16.F90: Regenerate. + * generated/_atan2_r4.F90: Regenerate. + * generated/_atan2_r8.F90: Regenerate. + * generated/_atan_r10.F90: Regenerate. + * generated/_atan_r16.F90: Regenerate. + * generated/_atan_r4.F90: Regenerate. + * generated/_atan_r8.F90: Regenerate. + * generated/_atanh_r10.F90: Regenerate. + * generated/_atanh_r16.F90: Regenerate. + * generated/_atanh_r4.F90: Regenerate. + * generated/_atanh_r8.F90: Regenerate. + * generated/_conjg_c10.F90: Regenerate. + * generated/_conjg_c16.F90: Regenerate. + * generated/_conjg_c4.F90: Regenerate. + * generated/_conjg_c8.F90: Regenerate. + * generated/_cos_c10.F90: Regenerate. + * generated/_cos_c16.F90: Regenerate. + * generated/_cos_c4.F90: Regenerate. + * generated/_cos_c8.F90: Regenerate. + * generated/_cos_r10.F90: Regenerate. + * generated/_cos_r16.F90: Regenerate. + * generated/_cos_r4.F90: Regenerate. + * generated/_cos_r8.F90: Regenerate. + * generated/_cosh_r10.F90: Regenerate. + * generated/_cosh_r16.F90: Regenerate. + * generated/_cosh_r4.F90: Regenerate. + * generated/_cosh_r8.F90: Regenerate. + * generated/_dim_i16.F90: Regenerate. + * generated/_dim_i4.F90: Regenerate. + * generated/_dim_i8.F90: Regenerate. + * generated/_dim_r10.F90: Regenerate. + * generated/_dim_r16.F90: Regenerate. + * generated/_dim_r4.F90: Regenerate. + * generated/_dim_r8.F90: Regenerate. + * generated/_exp_c10.F90: Regenerate. + * generated/_exp_c16.F90: Regenerate. + * generated/_exp_c4.F90: Regenerate. + * generated/_exp_c8.F90: Regenerate. + * generated/_exp_r10.F90: Regenerate. + * generated/_exp_r16.F90: Regenerate. + * generated/_exp_r4.F90: Regenerate. + * generated/_exp_r8.F90: Regenerate. + * generated/_log10_r10.F90: Regenerate. + * generated/_log10_r16.F90: Regenerate. + * generated/_log10_r4.F90: Regenerate. + * generated/_log10_r8.F90: Regenerate. + * generated/_log_c10.F90: Regenerate. + * generated/_log_c16.F90: Regenerate. + * generated/_log_c4.F90: Regenerate. + * generated/_log_c8.F90: Regenerate. + * generated/_log_r10.F90: Regenerate. + * generated/_log_r16.F90: Regenerate. + * generated/_log_r4.F90: Regenerate. + * generated/_log_r8.F90: Regenerate. + * generated/_mod_i16.F90: Regenerate. + * generated/_mod_i4.F90: Regenerate. + * generated/_mod_i8.F90: Regenerate. + * generated/_mod_r10.F90: Regenerate. + * generated/_mod_r16.F90: Regenerate. + * generated/_mod_r4.F90: Regenerate. + * generated/_mod_r8.F90: Regenerate. + * generated/_sign_i16.F90: Regenerate. + * generated/_sign_i4.F90: Regenerate. + * generated/_sign_i8.F90: Regenerate. + * generated/_sign_r10.F90: Regenerate. + * generated/_sign_r16.F90: Regenerate. + * generated/_sign_r4.F90: Regenerate. + * generated/_sign_r8.F90: Regenerate. + * generated/_sin_c10.F90: Regenerate. + * generated/_sin_c16.F90: Regenerate. + * generated/_sin_c4.F90: Regenerate. + * generated/_sin_c8.F90: Regenerate. + * generated/_sin_r10.F90: Regenerate. + * generated/_sin_r16.F90: Regenerate. + * generated/_sin_r4.F90: Regenerate. + * generated/_sin_r8.F90: Regenerate. + * generated/_sinh_r10.F90: Regenerate. + * generated/_sinh_r16.F90: Regenerate. + * generated/_sinh_r4.F90: Regenerate. + * generated/_sinh_r8.F90: Regenerate. + * generated/_sqrt_c10.F90: Regenerate. + * generated/_sqrt_c16.F90: Regenerate. + * generated/_sqrt_c4.F90: Regenerate. + * generated/_sqrt_c8.F90: Regenerate. + * generated/_sqrt_r10.F90: Regenerate. + * generated/_sqrt_r16.F90: Regenerate. + * generated/_sqrt_r4.F90: Regenerate. + * generated/_sqrt_r8.F90: Regenerate. + * generated/_tan_r10.F90: Regenerate. + * generated/_tan_r16.F90: Regenerate. + * generated/_tan_r4.F90: Regenerate. + * generated/_tan_r8.F90: Regenerate. + * generated/_tanh_r10.F90: Regenerate. + * generated/_tanh_r16.F90: Regenerate. + * generated/_tanh_r4.F90: Regenerate. + * generated/_tanh_r8.F90: Regenerate. + * generated/all_l1.c: Regenerate. + * generated/all_l16.c: Regenerate. + * generated/all_l2.c: Regenerate. + * generated/all_l4.c: Regenerate. + * generated/all_l8.c: Regenerate. + * generated/any_l1.c: Regenerate. + * generated/any_l16.c: Regenerate. + * generated/any_l2.c: Regenerate. + * generated/any_l4.c: Regenerate. + * generated/any_l8.c: Regenerate. + * generated/count_16_l.c: Regenerate. + * generated/count_1_l.c: Regenerate. + * generated/count_2_l.c: Regenerate. + * generated/count_4_l.c: Regenerate. + * generated/count_8_l.c: Regenerate. + * generated/cshift0_c10.c: Regenerate. + * generated/cshift0_c16.c: Regenerate. + * generated/cshift0_c4.c: Regenerate. + * generated/cshift0_c8.c: Regenerate. + * generated/cshift0_i1.c: Regenerate. + * generated/cshift0_i16.c: Regenerate. + * generated/cshift0_i2.c: Regenerate. + * generated/cshift0_i4.c: Regenerate. + * generated/cshift0_i8.c: Regenerate. + * generated/cshift0_r10.c: Regenerate. + * generated/cshift0_r16.c: Regenerate. + * generated/cshift0_r4.c: Regenerate. + * generated/cshift0_r8.c: Regenerate. + * generated/cshift1_16.c: Regenerate. + * generated/cshift1_4.c: Regenerate. + * generated/cshift1_8.c: Regenerate. + * generated/eoshift1_16.c: Regenerate. + * generated/eoshift1_4.c: Regenerate. + * generated/eoshift1_8.c: Regenerate. + * generated/eoshift3_16.c: Regenerate. + * generated/eoshift3_4.c: Regenerate. + * generated/eoshift3_8.c: Regenerate. + * generated/exponent_r10.c: Regenerate. + * generated/exponent_r16.c: Regenerate. + * generated/exponent_r4.c: Regenerate. + * generated/exponent_r8.c: Regenerate. + * generated/fraction_r10.c: Regenerate. + * generated/fraction_r16.c: Regenerate. + * generated/fraction_r4.c: Regenerate. + * generated/fraction_r8.c: Regenerate. + * generated/in_pack_c10.c: Regenerate. + * generated/in_pack_c16.c: Regenerate. + * generated/in_pack_c4.c: Regenerate. + * generated/in_pack_c8.c: Regenerate. + * generated/in_pack_i1.c: Regenerate. + * generated/in_pack_i16.c: Regenerate. + * generated/in_pack_i2.c: Regenerate. + * generated/in_pack_i4.c: Regenerate. + * generated/in_pack_i8.c: Regenerate. + * generated/in_pack_r10.c: Regenerate. + * generated/in_pack_r16.c: Regenerate. + * generated/in_pack_r4.c: Regenerate. + * generated/in_pack_r8.c: Regenerate. + * generated/in_unpack_c10.c: Regenerate. + * generated/in_unpack_c16.c: Regenerate. + * generated/in_unpack_c4.c: Regenerate. + * generated/in_unpack_c8.c: Regenerate. + * generated/in_unpack_i1.c: Regenerate. + * generated/in_unpack_i16.c: Regenerate. + * generated/in_unpack_i2.c: Regenerate. + * generated/in_unpack_i4.c: Regenerate. + * generated/in_unpack_i8.c: Regenerate. + * generated/in_unpack_r10.c: Regenerate. + * generated/in_unpack_r16.c: Regenerate. + * generated/in_unpack_r4.c: Regenerate. + * generated/in_unpack_r8.c: Regenerate. + * generated/matmul_c10.c: Regenerate. + * generated/matmul_c16.c: Regenerate. + * generated/matmul_c4.c: Regenerate. + * generated/matmul_c8.c: Regenerate. + * generated/matmul_i1.c: Regenerate. + * generated/matmul_i16.c: Regenerate. + * generated/matmul_i2.c: Regenerate. + * generated/matmul_i4.c: Regenerate. + * generated/matmul_i8.c: Regenerate. + * generated/matmul_l16.c: Regenerate. + * generated/matmul_l4.c: Regenerate. + * generated/matmul_l8.c: Regenerate. + * generated/matmul_r10.c: Regenerate. + * generated/matmul_r16.c: Regenerate. + * generated/matmul_r4.c: Regenerate. + * generated/matmul_r8.c: Regenerate. + * generated/maxloc0_16_i1.c: Regenerate. + * generated/maxloc0_16_i16.c: Regenerate. + * generated/maxloc0_16_i2.c: Regenerate. + * generated/maxloc0_16_i4.c: Regenerate. + * generated/maxloc0_16_i8.c: Regenerate. + * generated/maxloc0_16_r10.c: Regenerate. + * generated/maxloc0_16_r16.c: Regenerate. + * generated/maxloc0_16_r4.c: Regenerate. + * generated/maxloc0_16_r8.c: Regenerate. + * generated/maxloc0_4_i1.c: Regenerate. + * generated/maxloc0_4_i16.c: Regenerate. + * generated/maxloc0_4_i2.c: Regenerate. + * generated/maxloc0_4_i4.c: Regenerate. + * generated/maxloc0_4_i8.c: Regenerate. + * generated/maxloc0_4_r10.c: Regenerate. + * generated/maxloc0_4_r16.c: Regenerate. + * generated/maxloc0_4_r4.c: Regenerate. + * generated/maxloc0_4_r8.c: Regenerate. + * generated/maxloc0_8_i1.c: Regenerate. + * generated/maxloc0_8_i16.c: Regenerate. + * generated/maxloc0_8_i2.c: Regenerate. + * generated/maxloc0_8_i4.c: Regenerate. + * generated/maxloc0_8_i8.c: Regenerate. + * generated/maxloc0_8_r10.c: Regenerate. + * generated/maxloc0_8_r16.c: Regenerate. + * generated/maxloc0_8_r4.c: Regenerate. + * generated/maxloc0_8_r8.c: Regenerate. + * generated/maxloc1_16_i1.c: Regenerate. + * generated/maxloc1_16_i16.c: Regenerate. + * generated/maxloc1_16_i2.c: Regenerate. + * generated/maxloc1_16_i4.c: Regenerate. + * generated/maxloc1_16_i8.c: Regenerate. + * generated/maxloc1_16_r10.c: Regenerate. + * generated/maxloc1_16_r16.c: Regenerate. + * generated/maxloc1_16_r4.c: Regenerate. + * generated/maxloc1_16_r8.c: Regenerate. + * generated/maxloc1_4_i1.c: Regenerate. + * generated/maxloc1_4_i16.c: Regenerate. + * generated/maxloc1_4_i2.c: Regenerate. + * generated/maxloc1_4_i4.c: Regenerate. + * generated/maxloc1_4_i8.c: Regenerate. + * generated/maxloc1_4_r10.c: Regenerate. + * generated/maxloc1_4_r16.c: Regenerate. + * generated/maxloc1_4_r4.c: Regenerate. + * generated/maxloc1_4_r8.c: Regenerate. + * generated/maxloc1_8_i1.c: Regenerate. + * generated/maxloc1_8_i16.c: Regenerate. + * generated/maxloc1_8_i2.c: Regenerate. + * generated/maxloc1_8_i4.c: Regenerate. + * generated/maxloc1_8_i8.c: Regenerate. + * generated/maxloc1_8_r10.c: Regenerate. + * generated/maxloc1_8_r16.c: Regenerate. + * generated/maxloc1_8_r4.c: Regenerate. + * generated/maxloc1_8_r8.c: Regenerate. + * generated/maxval_i1.c: Regenerate. + * generated/maxval_i16.c: Regenerate. + * generated/maxval_i2.c: Regenerate. + * generated/maxval_i4.c: Regenerate. + * generated/maxval_i8.c: Regenerate. + * generated/maxval_r10.c: Regenerate. + * generated/maxval_r16.c: Regenerate. + * generated/maxval_r4.c: Regenerate. + * generated/maxval_r8.c: Regenerate. + * generated/minloc0_16_i1.c: Regenerate. + * generated/minloc0_16_i16.c: Regenerate. + * generated/minloc0_16_i2.c: Regenerate. + * generated/minloc0_16_i4.c: Regenerate. + * generated/minloc0_16_i8.c: Regenerate. + * generated/minloc0_16_r10.c: Regenerate. + * generated/minloc0_16_r16.c: Regenerate. + * generated/minloc0_16_r4.c: Regenerate. + * generated/minloc0_16_r8.c: Regenerate. + * generated/minloc0_4_i1.c: Regenerate. + * generated/minloc0_4_i16.c: Regenerate. + * generated/minloc0_4_i2.c: Regenerate. + * generated/minloc0_4_i4.c: Regenerate. + * generated/minloc0_4_i8.c: Regenerate. + * generated/minloc0_4_r10.c: Regenerate. + * generated/minloc0_4_r16.c: Regenerate. + * generated/minloc0_4_r4.c: Regenerate. + * generated/minloc0_4_r8.c: Regenerate. + * generated/minloc0_8_i1.c: Regenerate. + * generated/minloc0_8_i16.c: Regenerate. + * generated/minloc0_8_i2.c: Regenerate. + * generated/minloc0_8_i4.c: Regenerate. + * generated/minloc0_8_i8.c: Regenerate. + * generated/minloc0_8_r10.c: Regenerate. + * generated/minloc0_8_r16.c: Regenerate. + * generated/minloc0_8_r4.c: Regenerate. + * generated/minloc0_8_r8.c: Regenerate. + * generated/minloc1_16_i1.c: Regenerate. + * generated/minloc1_16_i16.c: Regenerate. + * generated/minloc1_16_i2.c: Regenerate. + * generated/minloc1_16_i4.c: Regenerate. + * generated/minloc1_16_i8.c: Regenerate. + * generated/minloc1_16_r10.c: Regenerate. + * generated/minloc1_16_r16.c: Regenerate. + * generated/minloc1_16_r4.c: Regenerate. + * generated/minloc1_16_r8.c: Regenerate. + * generated/minloc1_4_i1.c: Regenerate. + * generated/minloc1_4_i16.c: Regenerate. + * generated/minloc1_4_i2.c: Regenerate. + * generated/minloc1_4_i4.c: Regenerate. + * generated/minloc1_4_i8.c: Regenerate. + * generated/minloc1_4_r10.c: Regenerate. + * generated/minloc1_4_r16.c: Regenerate. + * generated/minloc1_4_r4.c: Regenerate. + * generated/minloc1_4_r8.c: Regenerate. + * generated/minloc1_8_i1.c: Regenerate. + * generated/minloc1_8_i16.c: Regenerate. + * generated/minloc1_8_i2.c: Regenerate. + * generated/minloc1_8_i4.c: Regenerate. + * generated/minloc1_8_i8.c: Regenerate. + * generated/minloc1_8_r10.c: Regenerate. + * generated/minloc1_8_r16.c: Regenerate. + * generated/minloc1_8_r4.c: Regenerate. + * generated/minloc1_8_r8.c: Regenerate. + * generated/minval_i1.c: Regenerate. + * generated/minval_i16.c: Regenerate. + * generated/minval_i2.c: Regenerate. + * generated/minval_i4.c: Regenerate. + * generated/minval_i8.c: Regenerate. + * generated/minval_r10.c: Regenerate. + * generated/minval_r16.c: Regenerate. + * generated/minval_r4.c: Regenerate. + * generated/minval_r8.c: Regenerate. + * generated/misc_specifics.F90: Regenerate. + * generated/nearest_r10.c: Regenerate. + * generated/nearest_r16.c: Regenerate. + * generated/nearest_r4.c: Regenerate. + * generated/nearest_r8.c: Regenerate. + * generated/pack_c10.c: Regenerate. + * generated/pack_c16.c: Regenerate. + * generated/pack_c4.c: Regenerate. + * generated/pack_c8.c: Regenerate. + * generated/pack_i1.c: Regenerate. + * generated/pack_i16.c: Regenerate. + * generated/pack_i2.c: Regenerate. + * generated/pack_i4.c: Regenerate. + * generated/pack_i8.c: Regenerate. + * generated/pack_r10.c: Regenerate. + * generated/pack_r16.c: Regenerate. + * generated/pack_r4.c: Regenerate. + * generated/pack_r8.c: Regenerate. + * generated/pow_c10_i16.c: Regenerate. + * generated/pow_c10_i4.c: Regenerate. + * generated/pow_c10_i8.c: Regenerate. + * generated/pow_c16_i16.c: Regenerate. + * generated/pow_c16_i4.c: Regenerate. + * generated/pow_c16_i8.c: Regenerate. + * generated/pow_c4_i16.c: Regenerate. + * generated/pow_c4_i4.c: Regenerate. + * generated/pow_c4_i8.c: Regenerate. + * generated/pow_c8_i16.c: Regenerate. + * generated/pow_c8_i4.c: Regenerate. + * generated/pow_c8_i8.c: Regenerate. + * generated/pow_i16_i16.c: Regenerate. + * generated/pow_i16_i4.c: Regenerate. + * generated/pow_i16_i8.c: Regenerate. + * generated/pow_i4_i16.c: Regenerate. + * generated/pow_i4_i4.c: Regenerate. + * generated/pow_i4_i8.c: Regenerate. + * generated/pow_i8_i16.c: Regenerate. + * generated/pow_i8_i4.c: Regenerate. + * generated/pow_i8_i8.c: Regenerate. + * generated/pow_r10_i16.c: Regenerate. + * generated/pow_r10_i8.c: Regenerate. + * generated/pow_r16_i16.c: Regenerate. + * generated/pow_r16_i8.c: Regenerate. + * generated/pow_r4_i16.c: Regenerate. + * generated/pow_r4_i8.c: Regenerate. + * generated/pow_r8_i16.c: Regenerate. + * generated/pow_r8_i8.c: Regenerate. + * generated/product_c10.c: Regenerate. + * generated/product_c16.c: Regenerate. + * generated/product_c4.c: Regenerate. + * generated/product_c8.c: Regenerate. + * generated/product_i1.c: Regenerate. + * generated/product_i16.c: Regenerate. + * generated/product_i2.c: Regenerate. + * generated/product_i4.c: Regenerate. + * generated/product_i8.c: Regenerate. + * generated/product_r10.c: Regenerate. + * generated/product_r16.c: Regenerate. + * generated/product_r4.c: Regenerate. + * generated/product_r8.c: Regenerate. + * generated/reshape_c10.c: Regenerate. + * generated/reshape_c16.c: Regenerate. + * generated/reshape_c4.c: Regenerate. + * generated/reshape_c8.c: Regenerate. + * generated/reshape_i16.c: Regenerate. + * generated/reshape_i4.c: Regenerate. + * generated/reshape_i8.c: Regenerate. + * generated/reshape_r10.c: Regenerate. + * generated/reshape_r16.c: Regenerate. + * generated/reshape_r4.c: Regenerate. + * generated/reshape_r8.c: Regenerate. + * generated/rrspacing_r10.c: Regenerate. + * generated/rrspacing_r16.c: Regenerate. + * generated/rrspacing_r4.c: Regenerate. + * generated/rrspacing_r8.c: Regenerate. + * generated/set_exponent_r10.c: Regenerate. + * generated/set_exponent_r16.c: Regenerate. + * generated/set_exponent_r4.c: Regenerate. + * generated/set_exponent_r8.c: Regenerate. + * generated/shape_i16.c: Regenerate. + * generated/shape_i4.c: Regenerate. + * generated/shape_i8.c: Regenerate. + * generated/spacing_r10.c: Regenerate. + * generated/spacing_r16.c: Regenerate. + * generated/spacing_r4.c: Regenerate. + * generated/spacing_r8.c: Regenerate. + * generated/spread_c10.c: Regenerate. + * generated/spread_c16.c: Regenerate. + * generated/spread_c4.c: Regenerate. + * generated/spread_c8.c: Regenerate. + * generated/spread_i1.c: Regenerate. + * generated/spread_i16.c: Regenerate. + * generated/spread_i2.c: Regenerate. + * generated/spread_i4.c: Regenerate. + * generated/spread_i8.c: Regenerate. + * generated/spread_r10.c: Regenerate. + * generated/spread_r16.c: Regenerate. + * generated/spread_r4.c: Regenerate. + * generated/spread_r8.c: Regenerate. + * generated/sum_c10.c: Regenerate. + * generated/sum_c16.c: Regenerate. + * generated/sum_c4.c: Regenerate. + * generated/sum_c8.c: Regenerate. + * generated/sum_i1.c: Regenerate. + * generated/sum_i16.c: Regenerate. + * generated/sum_i2.c: Regenerate. + * generated/sum_i4.c: Regenerate. + * generated/sum_i8.c: Regenerate. + * generated/sum_r10.c: Regenerate. + * generated/sum_r16.c: Regenerate. + * generated/sum_r4.c: Regenerate. + * generated/sum_r8.c: Regenerate. + * generated/transpose_c10.c: Regenerate. + * generated/transpose_c16.c: Regenerate. + * generated/transpose_c4.c: Regenerate. + * generated/transpose_c8.c: Regenerate. + * generated/transpose_i16.c: Regenerate. + * generated/transpose_i4.c: Regenerate. + * generated/transpose_i8.c: Regenerate. + * generated/transpose_r10.c: Regenerate. + * generated/transpose_r16.c: Regenerate. + * generated/transpose_r4.c: Regenerate. + * generated/transpose_r8.c: Regenerate. + * generated/unpack_c10.c: Regenerate. + * generated/unpack_c16.c: Regenerate. + * generated/unpack_c4.c: Regenerate. + * generated/unpack_c8.c: Regenerate. + * generated/unpack_i1.c: Regenerate. + * generated/unpack_i16.c: Regenerate. + * generated/unpack_i2.c: Regenerate. + * generated/unpack_i4.c: Regenerate. + * generated/unpack_i8.c: Regenerate. + * generated/unpack_r10.c: Regenerate. + * generated/unpack_r16.c: Regenerate. + * generated/unpack_r4.c: Regenerate. + * generated/unpack_r8.c: Regenerate. + +2009-04-08 Janne Blomqvist + + * io/open.c (already_open): Test for POSIX close return value. + * io/unit.c (close_unit_1): Likewise. + * io/unix.c (raw_close): Return 0 for success for preconnected units. + +2009-04-08 Janne Blomqvist + + * runtime/string.c (compare0): Use gfc_charlen_type. + * runtime/error.c (gfc_itoa): Move to io/write.c + (xtoa): Rename to gfc_xtoa. + * runtime/backtrace.c (show_backtrace): Call gfc_xtoa. + * intrinsics/cshift0.c (cshift0): Use index_type for shift arg. + * intrinsics/date_and_time.c (date_and_time): Use index_type. + (itime_i4): Likewise. + (itime_i8): Likewise. + (idate_i4): Likewise. + (idate_i8): Likewise. + (gmtime_i4): Likewise. + (gmtime_i8): Likewise. + (ltime_i4): Likewise. + (ltime_i8): Likewise. + * libgfortran.h (gfc_itoa): Remove prototype. + (xtoa): Rename prototype to gfc_xtoa. + * io/list_read.c (nml_read_obj): Use size_t for string length. + * io/transfer.c (read_block_direct): Change nbytes arg from + pointer to value. + (unformatted_read): Minor cleanup, call read_block_directly properly. + (skip_record): Use ssize_t. + (next_record_w_unf): Avoid stell() call by calling sseek with SEEK_CUR. + (iolength_transfer): Make sure to multiply before cast. + * io/intrinsics.c (fgetc): Remove unnecessary variable. + * io/format.c (format_hash): Use gfc_charlen_type. + * io/write.c (itoa): Move from runtime/error.c:gfc_itoa, rename, + make static. + (write_i): Call with pointer to itoa. + (write_z): Call with pointer to gfc_xtoa. + (write_integer): Pointer to itoa. + (nml_write_obj): Type cleanup, don't call strlen in loop. + +2009-04-06 H.J. Lu + + PR libgfortran/39664 + * io/unix.c (raw_close): Don't close STDOUT_FILENO, + STDERR_FILENO nor STDIN_FILENO. + +2009-04-06 David Edelsohn + + * io/io.h (struct stream): Rename truncate to trunc. + (struncate): Same. + * io/unix.c (raw_init): Rename truncate to trunc. + (buf_init): Same. + (open_internal): Same. + +2009-04-05 Daniel Kraft + + PR fortran/38654 + * io/read.c (read_f): Reworked to speed up floating point parsing. + (convert_real): Use pointer-casting instead of memcpy and temporaries. + +2009-04-05 Jerry DeLisle + + PR libfortran/37754 + * io/io.h (format_hash_entry): New structure for hash table. + (format_hash_table): The hash table itself. + (free_format_data): Revise function prototype. + (free_format_hash_table, init_format_hash, + free_format_hash): New function prototypes. + * io/unit.c (close_unit_1): Use free_format_hash_table. + * io/transfer.c (st_read_done, st_write_done): Free format data if + internal unit. + * io/format.c (free_format_hash_table): New function that frees any + memory allocated previously for cached format data. + (reset_node): New static helper function to reset the format counters + for a format node. + (reset_fnode_counters): New static function recursively calls reset_node + to traverse the fnode tree. + (format_hash): New simple hash function based on XOR, probabalistic, + tosses collisions. + (save_parsed_format): New static function to save the parsed format + data to use again. + (find_parsed_format): New static function searches the hash table + looking for a match. + (free_format_data): Revised to accept pointer to format data rather than + the dtp pointer so that the function can be used in more places. + (format_lex): Editorial. + (parse_format_list): Set flag used to determine of format data hashing + is to be used. Internal units are not persistent enough for this. + (revert): Move to ne location in file. + (parse_format): Use new functions to look for previously parsed + format strings and use them rather than re-parse. If not found, saves + the parsed format data for later use. + +2009-04-05 Jerry DeLisle + + PR libfortran/37754 + * io/transfer.c (formatted_transfer_scalar): Remove this function by + factoring it into two new functions, one for read and one for write, + eliminating all the conditionals for read or write mode. + (formatted transfer_scalar_read): New function. + (formatted transfer_scalar_write): New function. + (formatted_transfer): Use new functions. + +2009-04-05 Janne Blomqvist + + PR libfortran/25561 libfortran/37754 + * io/io.h (struct stream): Define new stream interface function + pointers, and inline functions for accessing it. + (struct fbuf): Use int instead of size_t, remove flushed element. + (mem_alloc_w): New prototype. + (mem_alloc_r): New prototype. + (stream_at_bof): Remove prototype. + (stream_at_eof): Remove prototype. + (file_position): Remove prototype. + (flush): Remove prototype. + (stream_offset): Remove prototype. + (unit_truncate): New prototype. + (read_block_form): Change to return pointer, int* argument. + (hit_eof): New prototype. + (fbuf_init): Change prototype. + (fbuf_reset): Change prototype. + (fbuf_alloc): Change prototype. + (fbuf_flush): Change prototype. + (fbuf_seek): Change prototype. + (fbuf_read): New prototype. + (fbuf_getc_refill): New prototype. + (fbuf_getc): New inline function. + * io/fbuf.c (fbuf_init): Use int, get rid of flushed. + (fbuf_debug): New function. + (fbuf_reset): Flush, and return position offset. + (fbuf_alloc): Simplify, don't flush, just realloc. + (fbuf_flush): Make usable for read mode, salvage remaining bytes. + (fbuf_seek): New whence argument. + (fbuf_read): New function. + (fbuf_getc_refill): New function. + * io/file_pos.c (formatted_backspace): Use new stream interface. + (unformatted_backspace): Likewise. + (st_backspace): Make sure format buffer is reset, use new stream + interface, use unit_truncate. + (st_endfile): Likewise. + (st_rewind): Likewise. + * io/intrinsics.c: Use new stream interface. + * io/list_read.c (push_char): Don't use u.p.scratch, use realloc + to resize. + (free_saved): Don't check u.p.scratch. + (next_char): Use new stream interface, use fbuf_getc() for external files. + (finish_list_read): flush format buffer. + (nml_query): Update to use modified interface:s + * io/open.c (test_endfile): Use new stream interface. + (edit_modes): Likewise. + (new_unit): Likewise, set bytes_left to 1 for stream files. + * io/read.c (read_l): Use new read_block_form interface. + (read_utf8): Likewise. + (read_utf8_char1): Likewise. + (read_default_char1): Likewise. + (read_utf8_char4): Likewise. + (read_default_char4): Likewise. + (read_a): Likewise. + (read_a_char4): Likewise. + (read_decimal): Likewise. + (read_radix): Likewise. + (read_f): Likewise. + * io/transfer.c (read_sf): Use fbuf_read and mem_alloc_r, remove + usage of u.p.line_buffer. + (read_block_form): Update interface to return pointer, use + fbuf_read for direct access. + (read_block_direct): Update to new stream interface. + (write_block): Use mem_alloc_w for internal I/O. + (write_buf): Update to new stream interface. + (formatted_transfer_scalar): Don't use u.p.line_buffer, use + fbuf_seek for external files. + (us_read): Update to new stream interface. + (us_write): Likewise. + (data_transfer_init): Always check if we switch modes and flush. + (skip_record): Use new stream interface, fix comparison. + (next_record_r): Check for and reset u.p.at_eof, use new stream + interface, use fbuf_getc for spacing. + (write_us_marker): Update to new stream interface, don't inline. + (next_record_w_unf): Likewise. + (sset): New function. + (next_record_w): Use new stream interface, use fbuf for printing + newline. + (next_record): Use new stream interface. + (finalize_transfer): Remove sfree call, use new stream interface. + (st_iolength_done): Don't use u.p.scratch. + (st_read): Don't check for end of file. + (st_read_done): Don't use u.p.scratch, use unit_truncate. + (hit_eof): New function. + * io/unit.c (init_units): Always init fbuf for formatted units. + (update_position): Use new stream interface. + (unit_truncate): New function. + (finish_last_advance_record): Use fbuf to print newline. + * io/unix.c: Remove unused SSIZE_MAX macro. + (BUFFER_SIZE): Make static const variable rather than macro. + (struct unix_stream): Remove dirty_offset, len, method, + small_buffer. Order elements by decreasing size. + (struct int_stream): Remove. + (move_pos_offset): Remove usage of dirty_offset. + (reset_stream): Remove. + (do_read): Rename to raw_read, update to match new stream + interface. + (do_write): Rename to raw_write, update to new stream interface. + (raw_seek): New function. + (raw_tell): New function. + (raw_truncate): New function. + (raw_close): New function. + (raw_flush): New function. + (raw_init): New function. + (fd_alloc): Remove. + (fd_alloc_r_at): Remove. + (fd_alloc_w_at): Remove. + (fd_sfree): Remove. + (fd_seek): Remove. + (fd_truncate): Remove. + (fd_sset): Remove. + (fd_read): Remove. + (fd_write): Remove. + (fd_close): Remove. + (fd_open): Remove. + (fd_flush): Rename to buf_flush, update to new stream interface + and unix_stream. + (buf_read): New function. + (buf_write): New function. + (buf_seek): New function. + (buf_tell): New function. + (buf_truncate): New function. + (buf_close): New function. + (buf_init): New function. + (mem_alloc_r_at): Rename to mem_alloc_r, change prototype. + (mem_alloc_w_at): Rename to mem_alloc_w, change prototype. + (mem_read): Change to match new stream interface. + (mem_write): Likewise. + (mem_seek): Likewise. + (mem_tell): Likewise. + (mem_truncate): Likewise. + (mem_close): Likewise. + (mem_flush): New function. + (mem_sfree): Remove. + (empty_internal_buffer): Cast to correct type. + (open_internal): Use correct type, init function pointers. + (fd_to_stream): Test whether to open file as buffered or raw. + (output_stream): Remove mode set. + (error_stream): Likewise. + (flush_all_units_1): Use new stream interface. + (flush_all_units): Likewise. + (stream_at_bof): Remove. + (stream_at_eof): Remove. + (file_position): Remove. + (file_length): Update logic to use stream interface. + (flush): Remove. + (stream_offset): Remove. + * io/write.c (write_utf8_char4): Use int instead of size_t. + (write_x): Extra safety check. + (namelist_write_newline): Use new stream interface. + +2009-03-29 John David Anglin + + PR fortran/33595 + * intrinsics/c99_functions.c (round): Use floor instead of ceil. + Revise checks to round up. + (roundf): Likewise. + +2009-03-28 Daniel Kraft + + * intrinsics/string_intrinsics.c: #include + * intrinsics/string_intrinsics_inc.c (string_trim): Use string_len_trim + instead of calculating the length directly. + (string_len_trim): For KIND=1, speed search up. + +2009-03-24 Jerry DeLisle + + PR libfortran/39528 + * io/list_read.c (list_formatted_read_scalar): Move check for read + completion to just after the check for a repeated value. + +2009-03-08 Jerry DeLisle + + PR libfortran/39402 + * io/write_float.def (output_float): Handle F0.d formatting correctly + for any d when value is 0.0. + +2009-03-01 Ralf Wildenhues + + * configure: Regenerate. + +2009-01-21 Daniel Kraft + + PR fortran/38887 + * runtime/in_unpack_generic.c (internal_unpack): Return instead of + abort when called with empty array. + * m4/in_unpack.m4: Ditto. + * generated/in_unpack_i1.c: Regenerated. + * generated/in_unpack_i2.c: Regenerated. + * generated/in_unpack_i4.c: Regenerated. + * generated/in_unpack_i8.c: Regenerated. + * generated/in_unpack_i16.c: Regenerated. + * generated/in_unpack_r4.c: Regenerated. + * generated/in_unpack_r8.c: Regenerated. + * generated/in_unpack_r10.c: Regenerated. + * generated/in_unpack_r16.c: Regenerated. + * generated/in_unpack_c4.c: Regenerated. + * generated/in_unpack_c8.c: Regenerated. + * generated/in_unpack_c10.c: Regenerated. + * generated/in_unpack_c16.c: Regenerated. + +2009-01-12 Jerry DeLisle + + PR libfortran/38772 + * io/read.c (read_f): Clean up loop conditions for BZ/BN, + allowing proper digit testing. White space fix. + +2009-01-05 Jerry DeLisle + + PR libfortran/38735 + * io/unit.c (get_internal_unit): Set default BLANK= status to NULL for + internal units. + + +Copyright (C) 2009 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/libgfortran/ChangeLog-2010 b/libgfortran/ChangeLog-2010 new file mode 100644 index 000000000..4b8b48603 --- /dev/null +++ b/libgfortran/ChangeLog-2010 @@ -0,0 +1,1013 @@ +2010-12-10 Tobias Burnus + + PR fortran/46540 + * acinclude.m4 (LIBGFOR_CHECK_FLOAT128): Honour + --disable-libquadmath-support. + * configure.ac: Handle --disable-libquadmath-support. + * configure: Regenerate. + +2010-12-06 Dave Korn + + PR target/40125 + PR lto/46695 + * configure.ac: Invoke ACX_LT_HOST_FLAGS. + * Makefile.am (LTLDFLAGS): Use lt_host_flags. + * aclocal.m4: Regenerate. + * configure: Regenerate. + * Makefile.in: Regenerate. + +2010-11-16 Francois-Xavier Coudert + Tobias Burnus + + PR fortran/32049 + * Makefile.am: Add missing pow_r16_i4.c, add transfer128.c, + link libquadmath, if used. + * acinclude.m4 (LIBGFOR_CHECK_FLOAT128): Add. + * configure.ac: Use it, touch spec file. + * gfortran.map: Add pow_r16_i4 and + transfer_(real,complex)128(,write) functions. + * intrinsics/cshift0.c (cshift0): Handle __float128 type. + * intrinsics/erfc_scaled_inc.c: Ditto. + * intrinsics/pack_generic.c (pack): Ditto + * intrinsics/spread_generic.c (spread): Ditto. + * intrinsics/unpack_generic.c (unpack1): Ditto. + * io/read.c (convert_real): Ditto. + * io/transfer.c: Update comments. + * io/transfer128.c: New file. + * io/write_float.def (write_float): Handle __float128 type. + * libgfortran.h: #include quadmath_weak.h, define __builtin_infq + and nanq. + * m4/mtype.m4: Handle __float128 type. + * runtime/in_pack_generic.c (internal_pack): Ditto. + * runtime/in_unpack_generic.c (internal_unpack): Ditto. + * kinds-override.h: New file. + * libgfortran.spec.in: Ditto. + * generated/pow_r16_i4.c: Generated. + * Makefile.in: Regenerate. + * configure: Regenerate. + * config.h: Regenerate. + * bessel_r10.c: Regenerate. + * bessel_r16.c: Regenerate. + * bessel_r4.c: Regenerate. + * bessel_r8.c: Regenerate. + * exponent_r16.c: Regenerate. + * fraction_r16.c: Regenerate. + * nearest_r16.c: Regenerate. + * norm2_r10.c: Regenerate. + * norm2_r16.c: Regenerate. + * norm2_r4.c: Regenerate. + * norm2_r8.c: Regenerate. + * rrspacing_r16.c: Regenerate. + * set_exponent_r16.c: Regenerate. + * spacing_r16.c: Regenerate. + +2010-11-09 Janne Blomqvist + + * io/unix.c (struct unix_stream): Add st_dev and st_ino members. + (fd_to_stream): Avoid unnecessary lseek() call, test isatty() + last. Make a token effort to support block devices. + (compare_file_filename): Use cached stat values. + (find_file0): Likewise. + (find_file): Likewise. + +2010-11-09 Jerry DeLisle + + PR libgfortran/46373 + * io/transfer.c (data_transfer_init): Do not call flush_if_preconnected + if this is an internal unit. + +2010-11-04 Janne Blomqvist + + PR libfortran/44931 + * io/inquire.c (inquire_via_unit): Use stream_ttyname() instead of + calling ttyname() directly. + * io/unix.h (unix_stream): Move struct to unix.c. + * io/unix.c: Move struct unix_stream here. + (stream_ttyname): Don't mark the argument as unused if it is used. + +2010-11-04 Janne Blomqvist + + * io/unix.h (struct unix_stream): Remove prot member. + * io/unix.c: Remove PROT_READ and PROT_WRITE constants. + (fd_to_stream): Remove prot from argument list, don't set prot. + (open_external): Don't set prot flag. + (input_stream): Remove prot from argument list. + (output_stream): Likewise. + (error_stream): Likewise. + +2010-11-03 Janne Blomqvist + + * io/unix.h: Remove empty_internal_buffer prototype. + * io/unix.c (empty_internal_buffer): Remove unused function. + +2010-11-03 Jerry DeLisle + + PR libgfortran/43899 + * runtime/error.c (generate_warning): New function to generate a run + time warning message. Fix some whitespace. + * libgfortran.h: Add prototype for new function. + * io/list_read.c (nml_read_obj): Use new function to warn when a + character namelist object is truncated. Only warn if compiled + with -fbounds-check. + +2010-11-02 Janne Blomqvist + + PR libfortran/45629 + * io/io.h: Remove setjmp.h include. + (st_parameter_dt): Change last_char to int, remove eof_jump. + * io/list_read.c (next_char): Return EOF instead of jumping. + (unget_char): Use int to be able to handle EOF. + (eat_spaces): Handle EOF return from next_char. + (eat_line): Likewise. + (eat_separator): Handle EOF return from next_char, eat_spaces, + eat_line. + (finish_separator): Likewise. + (convert_integer): Likewise. + (read_logical): Likewise. + (read_integer): Likewise. + (read_character): Likewise. + (parse_real): Likewise. + (read_complex): Likewise. + (read_real): Likewise. + (list_formatted_read_scalar): Likewise. + (list_formatted_read): Likewise. + (finish_list_read): Likewise. + (nml_parse_qualifier): Likewise. + (nml_match_name): Likewise. + (nml_get_obj_data): Likewise. + (namelist_read): Likewise. + * io/transfer.c (data_transfer_init): Initialize last_char. + (finalize_transfer): Remove jmp_buf setup. + +2010-10-26 Jerry DeLisle + + PR libgfortran/46010 + * io/list_read.c (nml_parse_qualifier): Add additional conditions for + setting the end index for loop specification. Fix some whitespace. + * io/write.c (write_default_char4): Const-ify the source argument. + +2010-10-21 Thomas Koenig + + PR fortran/46007 + * m4/shape.m4 (shape_'rtype_kind`): Use variable for rank. + Allocate return array if unallocated. + * generated/shape_i4.c: Regenerated. + * generated/shape_i8.c: Regenerated. + * generated/shape_i16.c: Regenerated. + +2010-10-20 Jerry DeLisle + + PR libgfortran/46079 + * runtime/stop.c (stop_numeric_f08): New function. + (stop_numeric): Restore to previous behavior. + * gfortran.map: Add symbol _gfortran_stop_numeric_f08. + +2010-10-18 Jerry DeLisle + + * io/io.h: Remove definition of the BT enumerator. + * libgfortran.h: Replace GFC_DTYPE enumerator with BT. + * intrinsics/iso_c_generated_procs.c: Likewise + * intrinsics/date_and_time.c: Likewise. + * intrinsics/iso_c_binding.c: Likewise. + * io/list_read.c: Likewise. + * io/transfer.c: Likewise. + * io/write.c: Likewise. + +2010-10-16 Thomas Koenig + + PR fortran/20165 + PR fortran/31593 + PR fortran/43665 + * gfortran.map: Add _gfortran_transfer_array_write, + _gfortran_transfer_array_write, _gfortran_transfer_character_write, + _gfortran_transfer_character_wide_write, + _gfortran_transfer_complex_write, + _gfortran_transfer_integer_write, + _gfortran_transfer_logical_write and + _gfortran_transfer_real_write. + * io/transfer.c (transfer_integer_write): Add prototype and + function body as call to the original function, without the + _write. + (transfer_real_write): Likewise. + (transfer_logical_write): Likewise. + (transfer_character_write): Likewise. + (transfer_character_wide_write): Likewise. + (transfer_complex_write): Likewise. + (transfer_array_write): Likewise. + +2010-09-22 Jerry DeLisle + + PR libfortran/45710 + * io/write.c (namelist_write_newline): Pad character array internal + unit records with spaces. + +2010-09-21 Jerry DeLisle + + PR libfortran/45723 + * io/open.c (new_unit): On POSITION_APPEND don't seek if file length is + zero. + +2010-09-14 Jerry DeLisle + + PR libfortran/45532 + * io/list_read.c (nml_get_obj_data): Set first_nl if the previous + is NULL. + +2010-09-12 Francois-Xavier Coudert + + * intrinsics/pack_generic.c (pack): Add missing return and fix + whitespace. + * intrinsics/cshift0.c (cshift0): Fix whitespace. + * intrinsics/unpack_generic.c (unpack1, unpack0): Fix whitespace. + +2010-09-10 Francois-Xavier Coudert + + * runtime/string.c (compare0): Remove. + (find_option): Inline string comparison + +2010-09-09 Francois-Xavier Coudert + + * acinclude.m4 (LIBGFOR_CHECK_FOR_BROKEN_ISFINITE, + LIBGFOR_CHECK_FOR_BROKEN_ISNAN, + LIBGFOR_CHECK_FOR_BROKEN_FPCLASSIFY): Remove. + * configure.ac: Remove above checks. + * libgfortran.h: Define isnan, isinf, isfinite, isnormal and + signbit in terms of the respective built-ins. + * io/write_float.def (WRITE_FLOAT): Use signbit() instead of + __builtin_signbit(). + * intrinsics/c99_functions.c (tgamma): Use isnan() instead of + __builtin_isnan(). + * config.h.in: Regenerate. + * configure: Regenerate. + +2010-09-06 Tobias Burnus + + PR fortran/38282 + * gfortran.map: Add new iany, iall and iparity intrinsics. + * Makefile.am: Ditto. + * m4/iany.m4: New. + * m4/iall.m4: New. + * m4/iparity.m4: New. + * Makefile.in: Regenerate. + * generated/iall_i1.c: Generate. + * generated/iall_i2.c: Generate. + * generated/iall_i4.c: Generate. + * generated/iall_i8.c: Generate. + * generated/iall_i16.c: Generate. + * generated/iany_i1.c: Generate. + * generated/iany_i2.c: Generate. + * generated/iany_i4.c: Generate. + * generated/iany_i8.c: Generate. + * generated/iany_i16.c: Generate. + * generated/iparity_i1.c: Generate. + * generated/iparity_i2.c: Generate. + * generated/iparity_i4.c: Generate. + * generated/iparity_i8.c: Generate. + * generated/iparity_i16.c: Generate. + +2010-09-05 Tobias Burnus + + * m4/bessel.m4: Fix printf warning by casting to (long int). + * generated/bessel_r4.c:Regenerated. + * generated/bessel_r8.c: Regenerated. + * generated/bessel_r10.c: Regenerated. + * generated/bessel_r16.c: Regenerated. + +2010-09-01 Francois-Xavier Coudert + + * intrinsics/execute_command_line.c: New file. + * gfortran.map (_gfortran_execute_command_line_i4, + _gfortran_execute_command_line_i8): New symbols. + * Makefile.am: Add new file intrinsics/execute_command_line.c. + * Makefile.in: Regenerated. + +2010-08-29 Francois-Xavier Coudert + + * m4/mtype.m4 (upcase, hasmathfunc, mathfunc_macro): New macros. + * m4/fraction.m4: Use new macros to support quad-float types. + * m4/set_exponent.m4: Likewise. + * m4/spacing.m4: Likewise. + * m4/exponent.m4: Likewise. + * m4/nearest.m4: Likewise. + * m4/norm2.m4: Likewise. + * m4/bessel.m4: Likewise. + * m4/rrspacing.m4: Likewise. + * generated/bessel_r4.c:Regenerated. + * generated/bessel_r8.c: Regenerated. + * generated/bessel_r10.c: Regenerated. + * generated/bessel_r16.c: Regenerated. + * generated/exponent_r4.c: Regenerated. + * generated/exponent_r8.c: Regenerated. + * generated/exponent_r10.c: Regenerated. + * generated/exponent_r16.c: Regenerated. + * generated/fraction_r4.c: Regenerated. + * generated/fraction_r8.c: Regenerated. + * generated/fraction_r10.c: Regenerated. + * generated/fraction_r16.c: Regenerated. + * generated/nearest_r4.c: Regenerated. + * generated/nearest_r8.c: Regenerated. + * generated/nearest_r10.c: Regenerated. + * generated/nearest_r16.c: Regenerated. + * generated/norm2_r4.c: Regenerated. + * generated/norm2_r8.c: Regenerated. + * generated/norm2_r10.c: Regenerated. + * generated/norm2_r16.c: Regenerated. + * generated/rrspacing_r4.c: Regenerated. + * generated/rrspacing_r8.c: Regenerated. + * generated/rrspacing_r10.c: Regenerated. + * generated/rrspacing_r16.c: Regenerated. + * generated/set_exponent_r4.c: Regenerated. + * generated/set_exponent_r8.c: Regenerated. + * generated/set_exponent_r10.c: Regenerated. + * generated/set_exponent_r16.c: Regenerated. + * generated/spacing_r4.c: Regenerated. + * generated/spacing_r8.c: Regenerated. + * generated/spacing_r10.c: Regenerated. + * generated/spacing_r16.c: Regenerated. + +2010-08-28 Tobias Burnus + + * mk-kinds-h.sh: Disable REAL(16) if REAL(10) is available. + +2010-08-27 Tobias Burnus + + PR fortran/33197 + * libgfortran/m4/ifunction.m4 (FINISH_ARRAY_FUNCTION, + ARRAY_FUNCTION): Allow expression after loop. + * libgfortran/m4/norm2.m4: New for _gfortran_norm2_r{4,8,10,16}. + * libgfortran/m4/parity.m4: New for _gfortran_parity_l{1,2,4,8,16}. + * libgfortran/gfortran.map: Add new functions. + * libgfortran/Makefile.am: Ditto. + * libgfortran/m4/minloc1.m4: Add empty argument for ARRAY_FUNCTION. + * libgfortran/m4/maxloc1.m4: Ditto. + * libgfortran/m4/all.m4: Ditto. + * libgfortran/m4/minval.m4: Ditto. + * libgfortran/m4/maxval.m4: Ditto. + * libgfortran/m4/count.m4: Ditto. + * libgfortran/m4/product.m4: Ditto. + * libgfortran/m4/any.m4: Ditto. + * Makefile.in: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/minloc1_16_r16.c: Regenerated. + * generated/norm2_r4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/parity_l2.c: Regenerated. + * generated/any_l16.c: Regenerated. + * generated/maxval_i2.c: Regenerated. + * generated/any_l2.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/parity_l16.c: Regenerated. + * generated/all_l1.c: Regenerated. + * generated/product_i2.c: Regenerated. + * generated/minloc1_8_r16.c: Regenerated. + * generated/maxloc1_8_r16.c: Regenerated. + * generated/sum_r16.c: Regenerated. + * generated/sum_i1.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/maxloc1_16_r16.c: Regenerated. + * generated/minloc1_16_i4.c: Regenerated. + * generated/maxloc1_16_i4.c: Regenerated. + * generated/maxval_r16.c: Regenerated. + * generated/product_c10.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/all_l2.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/all_l16.c: Regenerated. + * generated/minloc1_16_r10.c: Regenerated. + * generated/sum_i2.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/minval_i16.c: Regenerated. + * generated/parity_l4.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/minloc1_4_i16.c: Regenerated. + * generated/maxloc1_4_i16.c: Regenerated. + * generated/minloc1_8_r10.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/maxloc1_8_r10.c: Regenerated. + * generated/sum_c16.c: Regenerated. + * generated/minloc1_16_r8.c: Regenerated. + * generated/maxloc1_16_r8.c: Regenerated. + * generated/count_4_l.c: Regenerated. + * generated/sum_r10.c: Regenerated. + * generated/count_8_l.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/maxloc1_16_r10.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/maxval_r10.c: Regenerated. + * generated/minval_i1.c: Regenerated. + * generated/maxloc1_4_i1.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/product_i16.c: Regenerated. + * generated/all_l4.c: Regenerated. + * generated/norm2_r16.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/norm2_r8.c: Regenerated. + * generated/minloc1_4_i1.c: Regenerated. + * generated/minval_r16.c: Regenerated. + * generated/minval_i2.c: Regenerated. + * generated/maxloc1_4_i2.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/sum_c10.c: Regenerated. + * generated/minloc1_4_r16.c: Regenerated. + * generated/maxloc1_4_r16.c: Regenerated. + * generated/count_1_l.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_16_i8.c: Regenerated. + * generated/maxloc1_16_i8.c: Regenerated. + * generated/minloc1_4_i2.c: Regenerated. + * generated/maxloc1_8_i1.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/product_r16.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/sum_r8.c: Regenerated. + * generated/norm2_r10.c: Regenerated. + * generated/minloc1_16_i16.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/minloc1_16_i1.c: Regenerated. + * generated/maxloc1_16_i1.c: Regenerated. + * generated/minval_r10.c: Regenerated. + * generated/count_16_l.c: Regenerated. + * generated/parity_l8.c: Regenerated. + * generated/minloc1_8_i1.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_8_i2.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/minloc1_4_r10.c: Regenerated. + * generated/minloc1_8_i16.c: Regenerated. + * generated/maxloc1_4_r10.c: Regenerated. + * generated/maxloc1_8_i16.c: Regenerated. + * generated/minloc1_16_r4.c: Regenerated. + * generated/maxloc1_16_r4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/sum_i16.c: Regenerated. + * generated/count_2_l.c: Regenerated. + * generated/maxloc1_16_i16.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/minloc1_16_i2.c: Regenerated. + * generated/maxloc1_16_i2.c: Regenerated. + * generated/parity_l1.c: Regenerated. + * generated/maxval_i16.c: Regenerated. + * generated/maxval_i1.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/any_l1.c: Regenerated. + * generated/minloc1_8_i2.c: Regenerated. + * generated/product_c16.c: Regenerated. + * generated/product_r10.c: Regenerated. + * generated/product_i1.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + +2010-08-26 Rainer Orth + + * config/fpu-387.h (has_sse): Remove cw_sse, unused. + Use fixed-length asm. + +2010-08-23 Tobias Burnus + + PR fortran/45323 + * io/write.c (nml_write_obj, namelist_write): Cast argument + of toupper to int. + +2010-08-21 Ralf Wildenhues + + * configure: Regenerate. + +2010-08-19 Tobias Burnus + + PR fortran/36158 + PR fortran/33197 + * m4/bessel.m4: Implement bessel_jn and bessel_yn. + * gfortran.map: Add the generated bessel_jn_r{4,8,10,16} + and bessel_yn_r{4,8,10,16}. + * Makefile.am: Add bessel.m4. + * Makefile.in: Regenerated. + * generated/bessel_r4.c: Generated. + * generated/bessel_r16.c: Generated. + * generated/bessel_r8.c: Generated. + * generated/bessel_r10.c: Generated. + +2010-08-19 Jerry DeLisle + + PR libfortran/45108 + * io/list_read.c (namelist_read): If namelist reading fails, use + generate_error and then continue the read loop. + +2010-08-17 Jakub Jelinek + + PR fortran/45308 + * intrinsics/date_and_time.c (date_and_time): Pass __{zone,time,date}_len + instead of {ZONE,TIME,DATE}_LEN as second argument to fstrcpy. Drop + asserts. Adjust comment to the F2003 wording from the F95 wording. + +2010-08-14 Jerry DeLisle + + PR libfortran/44931 + * io/inquire.c (inquire_via_unit): Add special case for __MINGW32__ to + return special file names CONIN$, CONOUT$, and CONERR$. + +2010-08-07 Jerry DeLisle + + PR libfortran/45143 + * io/format.c: Remove fnode storage structure definitions, moving these + to format.h. (parse_format_list): Add check for data descriptors, + taking care of nested formats. Adjust calling parameters to pass a + check flag. (parse_format): Likewise. + * io/format.h: Add structures moved from format.c. + +2010-08-02 Janne Blomqvist + + * io/unit.c (update_position): Don't update the position flag for + non-seekable files, check for stell() error. + +2010-08-01 Janne Blomqvist + + * io/unix.c (file_exists): Use access(2) instead of stat(2) to + test file existence. + (fallback_access): Move up in file, implement F_OK. + +2010-07-31 David Edelsohn + + * io/inquire.c: Include io.h before string.h. + +2010-07-28 Jerry DeLisle + + PR libfortran/44931 + * io/inquire.c (inquire_via_unit): Use ttyname to return actual device + file name for stdin, stdout, and stderr. If ttyname does not succeed + fall back to default names for these units. Include string.h to allow + using strlen function. + * unix.c: Remove typedef of unix_stream structure, move to unix.h. + * unix.h: Add typedef of unix_stream structure so that it is + accessible to inquire.c. + +2010-07-19 Jerry DeLisle + + PR libfortran/44953 + * io/unix.c (mem_alloc_w4): Return gfc_char4_t instead of char type + pointer. (mem_write4): Remove cast to gfc_char4_t. + * io/transfer.c (write_block): Use a gfc_char4_t pointer. + (memset4): New helper function. (next_record_w): Use new helper + function rather than sset for internal units. Don't attempt to pad + with spaces if it is not needed. + * io/unix.h: Update prototype for mem_alloc_w4. + * io/write.c (memset4): Use gfc_char4_t pointer and chracter type. + Don't use multiply by 4 to compute offset. (memcpy4): Likewise. + (write_default_char4): Use a gfc_char4_t pointer and update memset4 + and memcpy calls. (write_a): Likewise. (write_l): Likewise. + (write_boz): Likewise. (write_decimal): Likewise. (write_x): Likewise. + (write_char): Add support for character(kind=4) internal units that + was previously missed. (write_integer): Use a gfc_char4_t pointer and + update memset4 and memcpy calls. (write_character): Likewise. + (write_separator): Add support for character(kind=4) internal units + that was previously missed. + * write_float.def (output_float): Use a gfc_char4_t pointer and + update memset4 and memcpy calls. (write_infnan): Likewise. + (output_float_FMT_G_): Likewise. + +2010-07-16 Jerry DeLisle + + PR libfortran/37077 + * io/read.c (read_default_char4): Add support for reading into a + kind-4 character variable from a character(kind=4) internal unit. + * io/io.h (read_block_form4): Add prototype. + * io/unit.c (get_internal_unit): Add call to fbuf_init. + (free_internal_unit): Add call to fbuf_destroy. (get_unit): Fix + whitespace. + * io/transfer.c (read_sf_internal): Use fbuf_alloc to allocate a string + to recieve the wide characters translated to single byte chracters. + (read_block_form): Fix whitespace. (read_block_form4): New function to + read from a character(kind=4) internal unit into a character(kind=4) + variable. (read_block_direct): Fix whitespace. (write_block): Fix + whitespace. (formatted_transfer_scalar_read): Likewise. + (formatted_transfer_scalar_write): Likewise. + * io/write.c (write_character): Add support for list directed write of + a kind=1 character string to a character(kind=4) internal unit. + +2010-07-14 Jerry DeLisle + + PR libfortran/44934 + * io/file_pos.c (st_endfile): Correctly set unit flags for form. + * io/transfer.c (data_transfer_init): Fix indentation of whitespace. + +2010-07-12 Jerry DeLisle + + PR libfortran/37077 + * io/read.c: Fix comment. + * io/io.h (is_char4_unit): New macro. + * io/unit.c (get_internal_unit): Call new function open_internal4. + * io/unix.c (mem_alloc_r4): New function. (mem_alloc_w4): New function. + (mem_read4): New function, temporary stub. (mem_write4): New function. + (open_internal4): New function to set stream pointers to use the new + mem functions. + * io/transfer.c (write_block): Use new mem_alloc_w4 to access internal + units of kind=4. + * io/unix.h: Add prototypes for open_internal4, mem_alloc_w4, and + mem_alloc_r4. + * io/write.c (memset4): New helper function. (memcpy4): New helper + function. (write_default_char4): Use new helper functions. + (write_a): Likewise. (write_l): Likewise. (write_boz): Likewise. + (write_decimal): Likewise. (write_x): Likewise. + (write_integer): Likewise. + * io/write_float.def (output_float): Add code blocks to handle internal + unit kind=4 output utilizing gfc_char4_t pointers. (write_infnan): Use + new helper functions. (OUTPUT_FLOAT_FMT_G): Update this macro likewise. + +2010-07-12 Rainer Orth + + * config/fpu-387.h [__sun__ && __svr4__] Include , + . + (sigill_caught): New. + (sigill_hdlr): New function + (has_sse) [__sun__ && __svr4__]: Check if SSE instruction causes + SIGILL. + +2010-07-11 Kai Tietz + + PR libfortran/44698 + * io/unix.c (flush_buf): Add _commit for WIN32. + +2010-06-28 Tobias Burnus + + PR fortran/43298 + * list_read.c (parse_real): Do not pass (..) on for NAN(..). + * read.c (convert_real): Fix comment about NAN/INF. + +2010-07-02 Rainer Orth + + * configure.ac (gfortran_use_symver): Only check for Sun-style symbol + versioning on Solaris 2. + * configure: Regenerate. + +2010-07-02 Rainer Orth + + * configure.ac: Check for Sun symbol versioning. + * configure: Regenerate. + + * Makefile.am [LIBGFOR_USE_SYMVER]: Protect version_arg with + LIBGFOR_USE_SYMVER_GNU. + Add version_dep. + [LIBGFOR_USE_SYMVER_SUN]: Handle Sun symbol versioning. + [!LIBGFOR_USE_SYMVER]: Add version_dep. + (libgfortran_la_DEPENDENCIES): Set to $(version_dep). + * Makefile.in: Regenerate. + +2010-06-29 Jerry DeLisle + + PR libfortran/43298 + * io/read.c: Add code to parse and read Inf, Infinity, NaN, and Nan with + optional parenthesis. + +2010-06-28 Tobias Burnus + + PR fortran/43298 + * list_read.c (parse_real, read_real): Support NAN(alphanum). + +2010-06-25 Tobias Burnus + + * intrinsics/selected_real_kind.f90 + (_gfortran_selected_real_kind2008): Add function. + (_gfortran_selected_real_kind): Stub which calls + _gfortran_selected_real_kind2008. + * gfortran.map (GFORTRAN_1.4): Add + _gfortran_selected_real_kind2008. + * mk-srk-inc.sh: Save also RADIX. + +2010-06-25 Tobias Burnus + + * runtime/compile_options.c (init_compile_options): Update + compile_options.allow_std for GFC_STD_F2008_OBS. + * io/transfer.c (formatted_transfer_scalar_read, + formatted_transfer_scalar_write): Fix allow_std check. + * io/list_read.c (nml_parse_qualifier): Ditto. + +2010-06-18 Jerry DeLisle + + PR libfortran/44477 + * io/file_pos.c (st_endfile): Add check for ENDFILE when file is + already positioned after the EOF marker. Use find_or_create_unit + instead of find_unit. If unit is not connected, connect it and create + the file with default settings. + * io/transfer.c (data_transfer_init): Add check for attempted READ or + WRITE when file is already positioned after the EOF marker. + +2010-06-10 Francois-Xavier Coudert + + * intrinsics/selected_char_kind.c (selected_char_kind): Fix + return value for ISO_10646. + +2010-06-09 Francois-Xavier Coudert + + * mk-kinds-h.sh: Define GFC_REAL_*_LITERAL_SUFFIX and + GFC_REAL_*_LITERAL macros for each kind. + * intrinsics/cpu_time.c (cpu_time_4, cpu_time_8, cpu_time_10, + cpu_time_16): Use them. + * intrinsics/random.c (rnumber_4, rnumber_8, rnumber_10, + rnumber_16): Likewise. + +2010-06-09 Francois-Xavier Coudert + + * intrinsics/system_clock.c (system_clock_4, system_clock_8): + Undefine TCK. + +2010-06-04 Thomas Koenig + + PR libfortran/34670 + * intrinsics/date_and_time.c: Replace assert with runtime_error + when VALUE is too small. + +2010-05-20 Jerry DeLisle + + PR fortran/43851 + * runtime/stop.c (stop_string): Make sure nothing is emitted for + blank stop. + +2010-05-19 Jerry DeLisle + + PR fortran/43851 + * runtime/stop.c (error_stop_numeric): New function and updated comment. + Add declaration for stop_numeric and remove declaration for stop_string. + (stop_string): Use for blank STOP. + (stop_numeric): Remove use of special -1 stop code. + * runtime/pause.c (do_pause): Use stop_string for blank stop. + (pause_numeric): Remove use of special -1 pause code. + * gfortran.map: Add new symbol to run-time library. + * libgfortran.h: Move declaration for stop_string to here to make + function visible for do_pause. Remove declaration for stop_numeric. + +2010-05-08 Janne Blomqvist + + * io/unix.h (mem_alloc_r): Fix typo to reduce visibility. + +2010-05-07 Janne Blomqvist + + * libgfortran.h (free_mem): Remove prototype. + * runtime/memory.c (free_mem): Remove function. + * intrinsics/date_and_time.c (secnds): Replace free_mem() with + free(). + * io/fbuf.c (fbuf_destroy): Likewise. + * io/format.c (free_format_hash_table): Likewise. + (save_parsed_format): Likewise. + (free_format_data): Likewise. + * io/list_read.c (free_saved): Likewise. + (free_line): Likewise. + (nml_touch_nodes): Likewise. + (nml_read_obj): Likewise + * io/lock.c (free_ionml): Likewise. + * io/open.c (new_unit): Likewise. + (already_open): Likewise. + * io/unit.c (destroy_unit_mutex): Likewise. + (free_internal_unit): Likewise. + (close_unit_1): Likewise. + * io/unix.c (raw_close): Likewise. + (buf_close): Likewise. + (mem_close): Likewise. + (tempfile): Likewise. + * io/write.c (nml_write_obj): Likewise. + * io/write_float.def (output_float_FMT_G_##): Likewise. + * runtime/error.c (show_locus): Likewise. + +2010-05-04 Ralf Wildenhues + + PR other/43620 + * configure.ac (AM_INIT_AUTOMAKE): Add no-dist. + * configure: Regenerate. + * Makefile.in: Regenerate. + +2010-04-30 Kai Tietz + + PR/43844 + * io/unix.c (raw_truncate): Explicit cast from integer-scalar + to pointer. + (tempfile): Use for mingw GetTempPath and avoid double slash + for path. + +2010-04-24 Kai Tietz + + PR/43844 + * io/unix.c (tempfile): Correct logic for mktemp case. + +2010-04-06 Tobias Burnus + + PR fortran/39997 + * runtime/stop.c (error_stop_string): New function. + * gfortran.map (_gfortran_error_stop_string): Add. + +2010-04-02 Ralf Wildenhues + + * Makefile.in: Regenerate. + * aclocal.m4: Regenerate. + +2010-04-01 Janne Blomqvist + + PR libfortran/43605 + * io/intrinsics.c (gf_ftell): New function, seek to correct offset. + (ftell): Call gf_ftell. + (FTELL_SUB): Likewise. + +2010-04-01 Paul Thomas + + * io/transfer.c : Update copyright. + * io/unix.c : ditto + * io/read.c : ditto + * io/io.h : ditto + * io/unix.h : ditto + * io/inquire.c : ditto + * io/format.c : ditto + * io/list_read.c : ditto + * runtime/error.c : ditto + * libgfortran.h : ditto + * intrinsics/date_and_time.c: ditto + * intrinsics/args.c : ditto + +2010-04-01 Janne Blomqvist + + PR libfortran/43605 + * io/intrinsics.c (ftell): Reset fbuf, correct offset. + (FTELL_SUB): Likewise. + +2010-03-29 Jerry DeLisle + + PR libfortran/43265 + * io/transfer.c (next_record_r): Only call hit_eof for specific + conditions when an EOF is encountered. + +2010-03-29 Tobias Burnus + + PR fortran/43551 + * io/unix.c (buf_write): Set physical_offset after lseek. + +2010-03-25 Jerry DeLisle + + PR libfortran/43517 + * io/read.c (read_x): Return if seen EOR condition. + +2010-03-21 Jerry DeLisle + + PR fortran/43409 + * io/io.h: Fix type of size in st_parameter_inquire structure. + +2010-03-20 Jerry DeLisle + + PR fortran/43409 + * io/unix.h: Add prototype for new function to return file size. + * io/unix.c (file_size): New function. + * io/inquire.c (inquire_via_unit): Use new function. + (inquire_via_filename): Use new function. + +2010-03-17 Jerry DeLisle + + * io/transfer.c (read_sf_internal): Remove stray function declaration + used during debugging. + +2010-03-17 Jerry DeLisle + + PR libfortran/43265 + * io/io.h: Delete prototype for read_sf, making it static. + * io/read.c (read_x): Modify to call hit_eof if PAD="no". + * io/transfer.c (read_sf_internal): New static function extracted from + read_sf for use on internal units only. Handle empty string case. + (read_sf): New factoring of this function, make it static. Add special + conditions for EOF based on ADVANCE="no", PAD="no", and whether any + bytes have been previously read from the record. + (read_block_form): Modify to call read_sf or read_sf_internal. + (next_record_r): Add a done flag similar to next_record_w. Call hit_eof + if internal array unit next record returns finished, meaning an EOF was + found and not done, ie not the last record expected. For external + units call hit_eof if item_count is 1 or there are no pending spaces. + (next_record): Update call to next_record_r. + +2010-03-12 Kai Tietz + + PR/42950 + * io/format.c (parse_format_list): Add to ERROR, WARNING, + SILENT enumerators NOTIFICATION_ prefix. + * runtime/error.c (notification_std): Likewise. + * libgfortran.h (notification): Likewise. + (GFC_LARGEST_BUF): Check for HAVE_GFC_INTEGER_16. + +2010-03-11 Tobias Burnus + + PR fortran/43228 + * io/list_read.c (nml_parse_qualifier): Disable expanded_read + for array sections. + +2010-03-10 Jerry DeLisle + + PR libfortran/43320 + * io/transfer.c (next_record_r): Add hit_eof based on item_count + condition. + +2010-03-09 Jerry DeLisle + + PR libfortran/43265 + * io/read.c: Include fbuf.h and unix.h to enable lower level I/O for + read_x. (read_x): Replace the use of read_sf with equivalent lower level + I/O, eliminating unneeded code and handling EOF and EOR conditions. + * io/io.h: Revise prototype for read_sf. + * io/transfer.c (read_sf): Delete no_error parameter and all uses of it. + (read_block_form): Likewise. + (next_record_r): Delete wrong code call to hit_eof. + +2010-03-08 Kai TIetz + + PR/42950 + * libgfortran.h (_POSIX): Define if __MINGW32__ is defined. + (gfc_printf): Define to gnu_printf for __MINGW32__ case, + otherwise to __printf__. + (gfc_strtof,gfc_strtod,gfc_strtold): Define for mingw case + to POSIX compatible converter functions. + (runtime_error): Use instead gfc_printf as formatter + attribute name. + (runtime_error_at): Likewise. + (runtime_warning_at): Likewise. + (st_printf): Likewise. + * intrinsics/date_and_time.c (localtime_r): Undefine + possible defined macro. + (gmtime_r): Likewise. + * io/read.c (convert_real): Use gfc_strtof, gfc_strtod, + and gfc_strtold. + +2010-02-24 Jerry DeLisle + + PR libfortran/43155 + * io/transfer.c (require_type): Subtract one from item_count for output + of error message. Add comment before formatted_transfer function + explaining why the item_count is off by one. + +2010-02-24 Rainer Orth + + * io/write_float.def (WRITE_FLOAT): Use __builtin_signbit. + +2010-02-22 Jerry DeLisle + + * io/list_read.c (list_formatted_read_scalar): Remove duplicate code. + +2010-02-09 Tobias Burnus + + PR fortran/42996 + * intrinsics/args.c (get_command_argument_i4): Always return + commandline-argument length for length parameter. + +2010-02-06 Jerry DeLisle + + PR libfortran/42742 + * io/format.c (reset_fnode_counters): Use the correct pointer to the + head of the fnode list. (parse_format): Remove previous hack that set + limit on size of format string for caching. + +2010-02-06 Jerry DeLisle + + PR libfortran + * io/transfer.c (read_sf): Handle EOR and EOF conditions for + ADVANCE="no" with PAD="yes" or PAD="no". + +2010-02-03 Jerry DeLisle + + PR libfortran/42901 + * io/list_read.c (nml_get_obj_data): Add new qualifier flag, clean up + code, and adjust logic to set namelist info pointer correctly for array + qualifiers of derived type components. + +2010-01-15 Jerry DeLisle + + PR libfortran/42742 + * io/format.c (parse_format): Set limit on size of format strings that + will be cached. + +2010-01-05 Rainer Orth + + * configure: Regenerate. + +2010-01-03 Janne Blomqvist + + PR libfortran/42420 + * io/unix.c: Defines for MINGW stat and fstat. + (gfstat_t): New typedef. + (id_from_fd): Use gfstat_t instead of struct stat. + (fd_to_stream): Likewise. + (compare_file_filename): Likewise. + (find_file): Likewise. + (file_exists): Likewise. + (inquire_sequential): Likewise. + (inquire_direct): Likewise. + (inquire_formatted): Likewise. + + +Copyright (C) 2010 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am new file mode 100644 index 000000000..d1e6d4f94 --- /dev/null +++ b/libgfortran/Makefile.am @@ -0,0 +1,992 @@ +## Process this file with automake to produce Makefile.in + + +ACLOCAL_AMFLAGS = -I .. -I ../config + +## May be used by toolexeclibdir. +gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER) + +## Symbol versioning (copied from libssp). +if LIBGFOR_USE_SYMVER +if LIBGFOR_USE_SYMVER_GNU +version_arg = -Wl,--version-script=$(srcdir)/gfortran.map +version_dep = $(srcdir)/gfortran.map +endif +if LIBGFOR_USE_SYMVER_SUN +version_arg = -Wl,-M,gfortran.map-sun +version_dep = gfortran.map-sun +gfortran.map-sun : $(srcdir)/gfortran.map \ + $(top_srcdir)/../contrib/make_sunver.pl \ + $(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD) + perl $(top_srcdir)/../contrib/make_sunver.pl \ + $(srcdir)/gfortran.map \ + $(libgfortran_la_OBJECTS:%.lo=.libs/%.o) \ + `echo $(libgfortran_la_LIBADD) | \ + sed 's,/\([^/.]*\)\.la,/.libs/\1.a,g'` \ + > $@ || (rm -f $@ ; exit 1) +endif +else +version_arg = +version_dep = +endif + +LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) \ + $(lt_host_flags) + +toolexeclib_LTLIBRARIES = libgfortran.la +toolexeclib_DATA = libgfortran.spec +libgfortran_la_LINK = $(LINK) $(libgfortran_la_LDFLAGS) +libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` $(LTLDFLAGS) $(LIBQUADLIB) -lm $(extra_ldflags_libgfortran) $(version_arg) +libgfortran_la_DEPENDENCIES = $(version_dep) libgfortran.spec $(LIBQUADLIB_DEP) + +myexeclib_LTLIBRARIES = libgfortranbegin.la +myexeclibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR) +libgfortranbegin_la_SOURCES = fmain.c +libgfortranbegin_la_LDFLAGS = -static +libgfortranbegin_la_LINK = $(LINK) $(libgfortranbegin_la_LDFLAGS) + +## io.h conflicts with a system header on some platforms, so +## use -iquote +AM_CPPFLAGS = -iquote$(srcdir)/io -I$(srcdir)/$(MULTISRCTOP)../gcc \ + -I$(srcdir)/$(MULTISRCTOP)../gcc/config $(LIBQUADINCLUDE) \ + -I$(MULTIBUILDTOP)../../$(host_subdir)/gcc -D_GNU_SOURCE + +# Fortran rules for complex multiplication and division +AM_CFLAGS += -fcx-fortran-rules + +# Use -ffunction-sections -fdata-sections if supported by the compiler +AM_CFLAGS += $(SECTION_FLAGS) + +# Some targets require additional compiler options for IEEE compatibility. +AM_CFLAGS += $(IEEE_FLAGS) + +gfor_io_src= \ +io/close.c \ +io/file_pos.c \ +io/format.c \ +io/inquire.c \ +io/intrinsics.c \ +io/list_read.c \ +io/lock.c \ +io/open.c \ +io/read.c \ +io/size_from_kind.c \ +io/transfer.c \ +io/transfer128.c \ +io/unit.c \ +io/unix.c \ +io/write.c \ +io/fbuf.c + +gfor_io_headers= \ +io/io.h \ +io/fbuf.h \ +io/format.h \ +io/unix.h + +gfor_helper_src= \ +intrinsics/associated.c \ +intrinsics/abort.c \ +intrinsics/access.c \ +intrinsics/args.c \ +intrinsics/bit_intrinsics.c \ +intrinsics/c99_functions.c \ +intrinsics/chdir.c \ +intrinsics/chmod.c \ +intrinsics/clock.c \ +intrinsics/cpu_time.c \ +intrinsics/cshift0.c \ +intrinsics/ctime.c \ +intrinsics/date_and_time.c \ +intrinsics/dtime.c \ +intrinsics/env.c \ +intrinsics/eoshift0.c \ +intrinsics/eoshift2.c \ +intrinsics/erfc_scaled.c \ +intrinsics/etime.c \ +intrinsics/execute_command_line.c \ +intrinsics/exit.c \ +intrinsics/extends_type_of.c \ +intrinsics/fnum.c \ +intrinsics/gerror.c \ +intrinsics/getcwd.c \ +intrinsics/getlog.c \ +intrinsics/getXid.c \ +intrinsics/hostnm.c \ +intrinsics/ierrno.c \ +intrinsics/ishftc.c \ +intrinsics/iso_c_generated_procs.c \ +intrinsics/iso_c_binding.c \ +intrinsics/kill.c \ +intrinsics/link.c \ +intrinsics/malloc.c \ +intrinsics/mvbits.c \ +intrinsics/move_alloc.c \ +intrinsics/pack_generic.c \ +intrinsics/perror.c \ +intrinsics/selected_char_kind.c \ +intrinsics/signal.c \ +intrinsics/size.c \ +intrinsics/sleep.c \ +intrinsics/spread_generic.c \ +intrinsics/string_intrinsics.c \ +intrinsics/system.c \ +intrinsics/rand.c \ +intrinsics/random.c \ +intrinsics/rename.c \ +intrinsics/reshape_generic.c \ +intrinsics/reshape_packed.c \ +intrinsics/selected_int_kind.f90 \ +intrinsics/selected_real_kind.f90 \ +intrinsics/stat.c \ +intrinsics/symlnk.c \ +intrinsics/system_clock.c \ +intrinsics/time.c \ +intrinsics/transpose_generic.c \ +intrinsics/umask.c \ +intrinsics/unlink.c \ +intrinsics/unpack_generic.c \ +runtime/in_pack_generic.c \ +runtime/in_unpack_generic.c + +gfor_src= \ +runtime/backtrace.c \ +runtime/bounds.c \ +runtime/compile_options.c \ +runtime/convert_char.c \ +runtime/environ.c \ +runtime/error.c \ +runtime/fpu.c \ +runtime/main.c \ +runtime/memory.c \ +runtime/pause.c \ +runtime/stop.c \ +runtime/string.c \ +runtime/select.c + +i_all_c= \ +$(srcdir)/generated/all_l1.c \ +$(srcdir)/generated/all_l2.c \ +$(srcdir)/generated/all_l4.c \ +$(srcdir)/generated/all_l8.c \ +$(srcdir)/generated/all_l16.c + +i_any_c= \ +$(srcdir)/generated/any_l1.c \ +$(srcdir)/generated/any_l2.c \ +$(srcdir)/generated/any_l4.c \ +$(srcdir)/generated/any_l8.c \ +$(srcdir)/generated/any_l16.c + +i_bessel_c= \ +$(srcdir)/generated/bessel_r4.c \ +$(srcdir)/generated/bessel_r8.c \ +$(srcdir)/generated/bessel_r10.c \ +$(srcdir)/generated/bessel_r16.c + +i_count_c= \ +$(srcdir)/generated/count_1_l.c \ +$(srcdir)/generated/count_2_l.c \ +$(srcdir)/generated/count_4_l.c \ +$(srcdir)/generated/count_8_l.c \ +$(srcdir)/generated/count_16_l.c + +i_iall_c= \ +$(srcdir)/generated/iall_i1.c \ +$(srcdir)/generated/iall_i2.c \ +$(srcdir)/generated/iall_i4.c \ +$(srcdir)/generated/iall_i8.c \ +$(srcdir)/generated/iall_i16.c + +i_iany_c= \ +$(srcdir)/generated/iany_i1.c \ +$(srcdir)/generated/iany_i2.c \ +$(srcdir)/generated/iany_i4.c \ +$(srcdir)/generated/iany_i8.c \ +$(srcdir)/generated/iany_i16.c + +i_iparity_c= \ +$(srcdir)/generated/iparity_i1.c \ +$(srcdir)/generated/iparity_i2.c \ +$(srcdir)/generated/iparity_i4.c \ +$(srcdir)/generated/iparity_i8.c \ +$(srcdir)/generated/iparity_i16.c + +i_maxloc0_c= \ +$(srcdir)/generated/maxloc0_4_i1.c \ +$(srcdir)/generated/maxloc0_8_i1.c \ +$(srcdir)/generated/maxloc0_16_i1.c \ +$(srcdir)/generated/maxloc0_4_i2.c \ +$(srcdir)/generated/maxloc0_8_i2.c \ +$(srcdir)/generated/maxloc0_16_i2.c \ +$(srcdir)/generated/maxloc0_4_i4.c \ +$(srcdir)/generated/maxloc0_8_i4.c \ +$(srcdir)/generated/maxloc0_16_i4.c \ +$(srcdir)/generated/maxloc0_4_i8.c \ +$(srcdir)/generated/maxloc0_8_i8.c \ +$(srcdir)/generated/maxloc0_16_i8.c \ +$(srcdir)/generated/maxloc0_4_i16.c \ +$(srcdir)/generated/maxloc0_8_i16.c \ +$(srcdir)/generated/maxloc0_16_i16.c \ +$(srcdir)/generated/maxloc0_4_r4.c \ +$(srcdir)/generated/maxloc0_8_r4.c \ +$(srcdir)/generated/maxloc0_16_r4.c \ +$(srcdir)/generated/maxloc0_4_r8.c \ +$(srcdir)/generated/maxloc0_8_r8.c \ +$(srcdir)/generated/maxloc0_16_r8.c \ +$(srcdir)/generated/maxloc0_4_r10.c \ +$(srcdir)/generated/maxloc0_8_r10.c \ +$(srcdir)/generated/maxloc0_16_r10.c \ +$(srcdir)/generated/maxloc0_4_r16.c \ +$(srcdir)/generated/maxloc0_8_r16.c \ +$(srcdir)/generated/maxloc0_16_r16.c + +i_maxloc1_c= \ +$(srcdir)/generated/maxloc1_4_i1.c \ +$(srcdir)/generated/maxloc1_8_i1.c \ +$(srcdir)/generated/maxloc1_16_i1.c \ +$(srcdir)/generated/maxloc1_4_i2.c \ +$(srcdir)/generated/maxloc1_8_i2.c \ +$(srcdir)/generated/maxloc1_16_i2.c \ +$(srcdir)/generated/maxloc1_4_i4.c \ +$(srcdir)/generated/maxloc1_8_i4.c \ +$(srcdir)/generated/maxloc1_16_i4.c \ +$(srcdir)/generated/maxloc1_4_i8.c \ +$(srcdir)/generated/maxloc1_8_i8.c \ +$(srcdir)/generated/maxloc1_16_i8.c \ +$(srcdir)/generated/maxloc1_4_i16.c \ +$(srcdir)/generated/maxloc1_8_i16.c \ +$(srcdir)/generated/maxloc1_16_i16.c \ +$(srcdir)/generated/maxloc1_4_r4.c \ +$(srcdir)/generated/maxloc1_8_r4.c \ +$(srcdir)/generated/maxloc1_16_r4.c \ +$(srcdir)/generated/maxloc1_4_r8.c \ +$(srcdir)/generated/maxloc1_8_r8.c \ +$(srcdir)/generated/maxloc1_16_r8.c \ +$(srcdir)/generated/maxloc1_4_r10.c \ +$(srcdir)/generated/maxloc1_8_r10.c \ +$(srcdir)/generated/maxloc1_16_r10.c \ +$(srcdir)/generated/maxloc1_4_r16.c \ +$(srcdir)/generated/maxloc1_8_r16.c \ +$(srcdir)/generated/maxloc1_16_r16.c + +i_maxval_c= \ +$(srcdir)/generated/maxval_i1.c \ +$(srcdir)/generated/maxval_i2.c \ +$(srcdir)/generated/maxval_i4.c \ +$(srcdir)/generated/maxval_i8.c \ +$(srcdir)/generated/maxval_i16.c \ +$(srcdir)/generated/maxval_r4.c \ +$(srcdir)/generated/maxval_r8.c \ +$(srcdir)/generated/maxval_r10.c \ +$(srcdir)/generated/maxval_r16.c + +i_minloc0_c= \ +$(srcdir)/generated/minloc0_4_i1.c \ +$(srcdir)/generated/minloc0_8_i1.c \ +$(srcdir)/generated/minloc0_16_i1.c \ +$(srcdir)/generated/minloc0_4_i2.c \ +$(srcdir)/generated/minloc0_8_i2.c \ +$(srcdir)/generated/minloc0_16_i2.c \ +$(srcdir)/generated/minloc0_4_i4.c \ +$(srcdir)/generated/minloc0_8_i4.c \ +$(srcdir)/generated/minloc0_16_i4.c \ +$(srcdir)/generated/minloc0_4_i8.c \ +$(srcdir)/generated/minloc0_8_i8.c \ +$(srcdir)/generated/minloc0_16_i8.c \ +$(srcdir)/generated/minloc0_4_i16.c \ +$(srcdir)/generated/minloc0_8_i16.c \ +$(srcdir)/generated/minloc0_16_i16.c \ +$(srcdir)/generated/minloc0_4_r4.c \ +$(srcdir)/generated/minloc0_8_r4.c \ +$(srcdir)/generated/minloc0_16_r4.c \ +$(srcdir)/generated/minloc0_4_r8.c \ +$(srcdir)/generated/minloc0_8_r8.c \ +$(srcdir)/generated/minloc0_16_r8.c \ +$(srcdir)/generated/minloc0_4_r10.c \ +$(srcdir)/generated/minloc0_8_r10.c \ +$(srcdir)/generated/minloc0_16_r10.c \ +$(srcdir)/generated/minloc0_4_r16.c \ +$(srcdir)/generated/minloc0_8_r16.c \ +$(srcdir)/generated/minloc0_16_r16.c + +i_minloc1_c= \ +$(srcdir)/generated/minloc1_4_i1.c \ +$(srcdir)/generated/minloc1_8_i1.c \ +$(srcdir)/generated/minloc1_16_i1.c \ +$(srcdir)/generated/minloc1_4_i2.c \ +$(srcdir)/generated/minloc1_8_i2.c \ +$(srcdir)/generated/minloc1_16_i2.c \ +$(srcdir)/generated/minloc1_4_i4.c \ +$(srcdir)/generated/minloc1_8_i4.c \ +$(srcdir)/generated/minloc1_16_i4.c \ +$(srcdir)/generated/minloc1_4_i8.c \ +$(srcdir)/generated/minloc1_8_i8.c \ +$(srcdir)/generated/minloc1_16_i8.c \ +$(srcdir)/generated/minloc1_4_i16.c \ +$(srcdir)/generated/minloc1_8_i16.c \ +$(srcdir)/generated/minloc1_16_i16.c \ +$(srcdir)/generated/minloc1_4_r4.c \ +$(srcdir)/generated/minloc1_8_r4.c \ +$(srcdir)/generated/minloc1_16_r4.c \ +$(srcdir)/generated/minloc1_4_r8.c \ +$(srcdir)/generated/minloc1_8_r8.c \ +$(srcdir)/generated/minloc1_16_r8.c \ +$(srcdir)/generated/minloc1_4_r10.c \ +$(srcdir)/generated/minloc1_8_r10.c \ +$(srcdir)/generated/minloc1_16_r10.c \ +$(srcdir)/generated/minloc1_4_r16.c \ +$(srcdir)/generated/minloc1_8_r16.c \ +$(srcdir)/generated/minloc1_16_r16.c + +i_minval_c= \ +$(srcdir)/generated/minval_i1.c \ +$(srcdir)/generated/minval_i2.c \ +$(srcdir)/generated/minval_i4.c \ +$(srcdir)/generated/minval_i8.c \ +$(srcdir)/generated/minval_i16.c \ +$(srcdir)/generated/minval_r4.c \ +$(srcdir)/generated/minval_r8.c \ +$(srcdir)/generated/minval_r10.c \ +$(srcdir)/generated/minval_r16.c + +i_norm2_c= \ +$(srcdir)/generated/norm2_r4.c \ +$(srcdir)/generated/norm2_r8.c \ +$(srcdir)/generated/norm2_r10.c \ +$(srcdir)/generated/norm2_r16.c + +i_parity_c = \ +$(srcdir)/generated/parity_l1.c \ +$(srcdir)/generated/parity_l2.c \ +$(srcdir)/generated/parity_l4.c \ +$(srcdir)/generated/parity_l8.c \ +$(srcdir)/generated/parity_l16.c + +i_sum_c= \ +$(srcdir)/generated/sum_i1.c \ +$(srcdir)/generated/sum_i2.c \ +$(srcdir)/generated/sum_i4.c \ +$(srcdir)/generated/sum_i8.c \ +$(srcdir)/generated/sum_i16.c \ +$(srcdir)/generated/sum_r4.c \ +$(srcdir)/generated/sum_r8.c \ +$(srcdir)/generated/sum_r10.c \ +$(srcdir)/generated/sum_r16.c \ +$(srcdir)/generated/sum_c4.c \ +$(srcdir)/generated/sum_c8.c \ +$(srcdir)/generated/sum_c10.c \ +$(srcdir)/generated/sum_c16.c + +i_product_c= \ +$(srcdir)/generated/product_i1.c \ +$(srcdir)/generated/product_i2.c \ +$(srcdir)/generated/product_i4.c \ +$(srcdir)/generated/product_i8.c \ +$(srcdir)/generated/product_i16.c \ +$(srcdir)/generated/product_r4.c \ +$(srcdir)/generated/product_r8.c \ +$(srcdir)/generated/product_r10.c \ +$(srcdir)/generated/product_r16.c \ +$(srcdir)/generated/product_c4.c \ +$(srcdir)/generated/product_c8.c \ +$(srcdir)/generated/product_c10.c \ +$(srcdir)/generated/product_c16.c + +i_matmul_c= \ +$(srcdir)/generated/matmul_i1.c \ +$(srcdir)/generated/matmul_i2.c \ +$(srcdir)/generated/matmul_i4.c \ +$(srcdir)/generated/matmul_i8.c \ +$(srcdir)/generated/matmul_i16.c \ +$(srcdir)/generated/matmul_r4.c \ +$(srcdir)/generated/matmul_r8.c \ +$(srcdir)/generated/matmul_r10.c \ +$(srcdir)/generated/matmul_r16.c \ +$(srcdir)/generated/matmul_c4.c \ +$(srcdir)/generated/matmul_c8.c \ +$(srcdir)/generated/matmul_c10.c \ +$(srcdir)/generated/matmul_c16.c + +i_matmull_c= \ +$(srcdir)/generated/matmul_l4.c \ +$(srcdir)/generated/matmul_l8.c \ +$(srcdir)/generated/matmul_l16.c + +i_transpose_c= \ +$(srcdir)/generated/transpose_i4.c \ +$(srcdir)/generated/transpose_i8.c \ +$(srcdir)/generated/transpose_i16.c \ +$(srcdir)/generated/transpose_r4.c \ +$(srcdir)/generated/transpose_r8.c \ +$(srcdir)/generated/transpose_r10.c \ +$(srcdir)/generated/transpose_r16.c \ +$(srcdir)/generated/transpose_c4.c \ +$(srcdir)/generated/transpose_c8.c \ +$(srcdir)/generated/transpose_c10.c \ +$(srcdir)/generated/transpose_c16.c + +i_shape_c= \ +$(srcdir)/generated/shape_i4.c \ +$(srcdir)/generated/shape_i8.c \ +$(srcdir)/generated/shape_i16.c + +i_reshape_c= \ +$(srcdir)/generated/reshape_i4.c \ +$(srcdir)/generated/reshape_i8.c \ +$(srcdir)/generated/reshape_i16.c \ +$(srcdir)/generated/reshape_r4.c \ +$(srcdir)/generated/reshape_r8.c \ +$(srcdir)/generated/reshape_r10.c \ +$(srcdir)/generated/reshape_r16.c \ +$(srcdir)/generated/reshape_c4.c \ +$(srcdir)/generated/reshape_c8.c \ +$(srcdir)/generated/reshape_c10.c \ +$(srcdir)/generated/reshape_c16.c + +i_eoshift1_c= \ +$(srcdir)/generated/eoshift1_4.c \ +$(srcdir)/generated/eoshift1_8.c \ +$(srcdir)/generated/eoshift1_16.c + +i_eoshift3_c= \ +$(srcdir)/generated/eoshift3_4.c \ +$(srcdir)/generated/eoshift3_8.c \ +$(srcdir)/generated/eoshift3_16.c + +i_cshift0_c= \ +$(srcdir)/generated/cshift0_i1.c \ +$(srcdir)/generated/cshift0_i2.c \ +$(srcdir)/generated/cshift0_i4.c \ +$(srcdir)/generated/cshift0_i8.c \ +$(srcdir)/generated/cshift0_i16.c \ +$(srcdir)/generated/cshift0_r4.c \ +$(srcdir)/generated/cshift0_r8.c \ +$(srcdir)/generated/cshift0_r10.c \ +$(srcdir)/generated/cshift0_r16.c \ +$(srcdir)/generated/cshift0_c4.c \ +$(srcdir)/generated/cshift0_c8.c \ +$(srcdir)/generated/cshift0_c10.c \ +$(srcdir)/generated/cshift0_c16.c + + +i_cshift1_c= \ +$(srcdir)/generated/cshift1_4.c \ +$(srcdir)/generated/cshift1_8.c \ +$(srcdir)/generated/cshift1_16.c + +in_pack_c = \ +$(srcdir)/generated/in_pack_i1.c \ +$(srcdir)/generated/in_pack_i2.c \ +$(srcdir)/generated/in_pack_i4.c \ +$(srcdir)/generated/in_pack_i8.c \ +$(srcdir)/generated/in_pack_i16.c \ +$(srcdir)/generated/in_pack_r4.c \ +$(srcdir)/generated/in_pack_r8.c \ +$(srcdir)/generated/in_pack_r10.c \ +$(srcdir)/generated/in_pack_r16.c \ +$(srcdir)/generated/in_pack_c4.c \ +$(srcdir)/generated/in_pack_c8.c \ +$(srcdir)/generated/in_pack_c10.c \ +$(srcdir)/generated/in_pack_c16.c + +in_unpack_c = \ +$(srcdir)/generated/in_unpack_i1.c \ +$(srcdir)/generated/in_unpack_i2.c \ +$(srcdir)/generated/in_unpack_i4.c \ +$(srcdir)/generated/in_unpack_i8.c \ +$(srcdir)/generated/in_unpack_i16.c \ +$(srcdir)/generated/in_unpack_r4.c \ +$(srcdir)/generated/in_unpack_r8.c \ +$(srcdir)/generated/in_unpack_r10.c \ +$(srcdir)/generated/in_unpack_r16.c \ +$(srcdir)/generated/in_unpack_c4.c \ +$(srcdir)/generated/in_unpack_c8.c \ +$(srcdir)/generated/in_unpack_c10.c \ +$(srcdir)/generated/in_unpack_c16.c + +i_exponent_c = \ +$(srcdir)/generated/exponent_r4.c \ +$(srcdir)/generated/exponent_r8.c \ +$(srcdir)/generated/exponent_r10.c \ +$(srcdir)/generated/exponent_r16.c + +i_spacing_c = \ +$(srcdir)/generated/spacing_r4.c \ +$(srcdir)/generated/spacing_r8.c \ +$(srcdir)/generated/spacing_r10.c \ +$(srcdir)/generated/spacing_r16.c + +i_rrspacing_c = \ +$(srcdir)/generated/rrspacing_r4.c \ +$(srcdir)/generated/rrspacing_r8.c \ +$(srcdir)/generated/rrspacing_r10.c \ +$(srcdir)/generated/rrspacing_r16.c + +i_fraction_c = \ +$(srcdir)/generated/fraction_r4.c \ +$(srcdir)/generated/fraction_r8.c \ +$(srcdir)/generated/fraction_r10.c \ +$(srcdir)/generated/fraction_r16.c + +i_nearest_c = \ +$(srcdir)/generated/nearest_r4.c \ +$(srcdir)/generated/nearest_r8.c \ +$(srcdir)/generated/nearest_r10.c \ +$(srcdir)/generated/nearest_r16.c + +i_set_exponent_c = \ +$(srcdir)/generated/set_exponent_r4.c \ +$(srcdir)/generated/set_exponent_r8.c \ +$(srcdir)/generated/set_exponent_r10.c \ +$(srcdir)/generated/set_exponent_r16.c + +i_pow_c = \ +$(srcdir)/generated/pow_i4_i4.c \ +$(srcdir)/generated/pow_i8_i4.c \ +$(srcdir)/generated/pow_i16_i4.c \ +$(srcdir)/generated/pow_r16_i4.c \ +$(srcdir)/generated/pow_c4_i4.c \ +$(srcdir)/generated/pow_c8_i4.c \ +$(srcdir)/generated/pow_c10_i4.c \ +$(srcdir)/generated/pow_c16_i4.c \ +$(srcdir)/generated/pow_i4_i8.c \ +$(srcdir)/generated/pow_i8_i8.c \ +$(srcdir)/generated/pow_i16_i8.c \ +$(srcdir)/generated/pow_r4_i8.c \ +$(srcdir)/generated/pow_r8_i8.c \ +$(srcdir)/generated/pow_r10_i8.c \ +$(srcdir)/generated/pow_r16_i8.c \ +$(srcdir)/generated/pow_c4_i8.c \ +$(srcdir)/generated/pow_c8_i8.c \ +$(srcdir)/generated/pow_c10_i8.c \ +$(srcdir)/generated/pow_c16_i8.c \ +$(srcdir)/generated/pow_i4_i16.c \ +$(srcdir)/generated/pow_i8_i16.c \ +$(srcdir)/generated/pow_i16_i16.c \ +$(srcdir)/generated/pow_r4_i16.c \ +$(srcdir)/generated/pow_r8_i16.c \ +$(srcdir)/generated/pow_r10_i16.c \ +$(srcdir)/generated/pow_r16_i16.c \ +$(srcdir)/generated/pow_c4_i16.c \ +$(srcdir)/generated/pow_c8_i16.c \ +$(srcdir)/generated/pow_c10_i16.c \ +$(srcdir)/generated/pow_c16_i16.c + +i_pack_c = \ +$(srcdir)/generated/pack_i1.c \ +$(srcdir)/generated/pack_i2.c \ +$(srcdir)/generated/pack_i4.c \ +$(srcdir)/generated/pack_i8.c \ +$(srcdir)/generated/pack_i16.c \ +$(srcdir)/generated/pack_r4.c \ +$(srcdir)/generated/pack_r8.c \ +$(srcdir)/generated/pack_r10.c \ +$(srcdir)/generated/pack_r16.c \ +$(srcdir)/generated/pack_c4.c \ +$(srcdir)/generated/pack_c8.c \ +$(srcdir)/generated/pack_c10.c \ +$(srcdir)/generated/pack_c16.c + +i_unpack_c = \ +$(srcdir)/generated/unpack_i1.c \ +$(srcdir)/generated/unpack_i2.c \ +$(srcdir)/generated/unpack_i4.c \ +$(srcdir)/generated/unpack_i8.c \ +$(srcdir)/generated/unpack_i16.c \ +$(srcdir)/generated/unpack_r4.c \ +$(srcdir)/generated/unpack_r8.c \ +$(srcdir)/generated/unpack_r10.c \ +$(srcdir)/generated/unpack_r16.c \ +$(srcdir)/generated/unpack_c4.c \ +$(srcdir)/generated/unpack_c8.c \ +$(srcdir)/generated/unpack_c10.c \ +$(srcdir)/generated/unpack_c16.c + +i_spread_c = \ +$(srcdir)/generated/spread_i1.c \ +$(srcdir)/generated/spread_i2.c \ +$(srcdir)/generated/spread_i4.c \ +$(srcdir)/generated/spread_i8.c \ +$(srcdir)/generated/spread_i16.c \ +$(srcdir)/generated/spread_r4.c \ +$(srcdir)/generated/spread_r8.c \ +$(srcdir)/generated/spread_r10.c \ +$(srcdir)/generated/spread_r16.c \ +$(srcdir)/generated/spread_c4.c \ +$(srcdir)/generated/spread_c8.c \ +$(srcdir)/generated/spread_c10.c \ +$(srcdir)/generated/spread_c16.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 \ + m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \ + m4/matmul.m4 m4/matmull.m4 m4/ifunction_logical.m4 \ + m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \ + m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \ + m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \ + m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \ + m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4 m4/pack.m4 \ + m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4 \ + m4/iall.m4 m4/iany.m4 m4/iparity.m4 + +gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \ + $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \ + $(i_product_c) $(i_sum_c) $(i_bessel_c) $(i_iall_c) $(i_iany_c) \ + $(i_iparity_c) $(i_norm2_c) $(i_parity_c) \ + $(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \ + $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \ + $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ + $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \ + $(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \ + $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h + +# Machine generated specifics +gfor_built_specific_src= \ +$(srcdir)/generated/_abs_c4.F90 \ +$(srcdir)/generated/_abs_c8.F90 \ +$(srcdir)/generated/_abs_c10.F90 \ +$(srcdir)/generated/_abs_c16.F90 \ +$(srcdir)/generated/_abs_i4.F90 \ +$(srcdir)/generated/_abs_i8.F90 \ +$(srcdir)/generated/_abs_i16.F90 \ +$(srcdir)/generated/_abs_r4.F90 \ +$(srcdir)/generated/_abs_r8.F90 \ +$(srcdir)/generated/_abs_r10.F90 \ +$(srcdir)/generated/_abs_r16.F90 \ +$(srcdir)/generated/_aimag_c4.F90 \ +$(srcdir)/generated/_aimag_c8.F90 \ +$(srcdir)/generated/_aimag_c10.F90 \ +$(srcdir)/generated/_aimag_c16.F90 \ +$(srcdir)/generated/_exp_r4.F90 \ +$(srcdir)/generated/_exp_r8.F90 \ +$(srcdir)/generated/_exp_r10.F90 \ +$(srcdir)/generated/_exp_r16.F90 \ +$(srcdir)/generated/_exp_c4.F90 \ +$(srcdir)/generated/_exp_c8.F90 \ +$(srcdir)/generated/_exp_c10.F90 \ +$(srcdir)/generated/_exp_c16.F90 \ +$(srcdir)/generated/_log_r4.F90 \ +$(srcdir)/generated/_log_r8.F90 \ +$(srcdir)/generated/_log_r10.F90 \ +$(srcdir)/generated/_log_r16.F90 \ +$(srcdir)/generated/_log_c4.F90 \ +$(srcdir)/generated/_log_c8.F90 \ +$(srcdir)/generated/_log_c10.F90 \ +$(srcdir)/generated/_log_c16.F90 \ +$(srcdir)/generated/_log10_r4.F90 \ +$(srcdir)/generated/_log10_r8.F90 \ +$(srcdir)/generated/_log10_r10.F90 \ +$(srcdir)/generated/_log10_r16.F90 \ +$(srcdir)/generated/_sqrt_r4.F90 \ +$(srcdir)/generated/_sqrt_r8.F90 \ +$(srcdir)/generated/_sqrt_r10.F90 \ +$(srcdir)/generated/_sqrt_r16.F90 \ +$(srcdir)/generated/_sqrt_c4.F90 \ +$(srcdir)/generated/_sqrt_c8.F90 \ +$(srcdir)/generated/_sqrt_c10.F90 \ +$(srcdir)/generated/_sqrt_c16.F90 \ +$(srcdir)/generated/_asin_r4.F90 \ +$(srcdir)/generated/_asin_r8.F90 \ +$(srcdir)/generated/_asin_r10.F90 \ +$(srcdir)/generated/_asin_r16.F90 \ +$(srcdir)/generated/_asinh_r4.F90 \ +$(srcdir)/generated/_asinh_r8.F90 \ +$(srcdir)/generated/_asinh_r10.F90 \ +$(srcdir)/generated/_asinh_r16.F90 \ +$(srcdir)/generated/_acos_r4.F90 \ +$(srcdir)/generated/_acos_r8.F90 \ +$(srcdir)/generated/_acos_r10.F90 \ +$(srcdir)/generated/_acos_r16.F90 \ +$(srcdir)/generated/_acosh_r4.F90 \ +$(srcdir)/generated/_acosh_r8.F90 \ +$(srcdir)/generated/_acosh_r10.F90 \ +$(srcdir)/generated/_acosh_r16.F90 \ +$(srcdir)/generated/_atan_r4.F90 \ +$(srcdir)/generated/_atan_r8.F90 \ +$(srcdir)/generated/_atan_r10.F90 \ +$(srcdir)/generated/_atan_r16.F90 \ +$(srcdir)/generated/_atanh_r4.F90 \ +$(srcdir)/generated/_atanh_r8.F90 \ +$(srcdir)/generated/_atanh_r10.F90 \ +$(srcdir)/generated/_atanh_r16.F90 \ +$(srcdir)/generated/_sin_r4.F90 \ +$(srcdir)/generated/_sin_r8.F90 \ +$(srcdir)/generated/_sin_r10.F90 \ +$(srcdir)/generated/_sin_r16.F90 \ +$(srcdir)/generated/_sin_c4.F90 \ +$(srcdir)/generated/_sin_c8.F90 \ +$(srcdir)/generated/_sin_c10.F90 \ +$(srcdir)/generated/_sin_c16.F90 \ +$(srcdir)/generated/_cos_r4.F90 \ +$(srcdir)/generated/_cos_r8.F90 \ +$(srcdir)/generated/_cos_r10.F90 \ +$(srcdir)/generated/_cos_r16.F90 \ +$(srcdir)/generated/_cos_c4.F90 \ +$(srcdir)/generated/_cos_c8.F90 \ +$(srcdir)/generated/_cos_c10.F90 \ +$(srcdir)/generated/_cos_c16.F90 \ +$(srcdir)/generated/_tan_r4.F90 \ +$(srcdir)/generated/_tan_r8.F90 \ +$(srcdir)/generated/_tan_r10.F90 \ +$(srcdir)/generated/_tan_r16.F90 \ +$(srcdir)/generated/_sinh_r4.F90 \ +$(srcdir)/generated/_sinh_r8.F90 \ +$(srcdir)/generated/_sinh_r10.F90 \ +$(srcdir)/generated/_sinh_r16.F90 \ +$(srcdir)/generated/_cosh_r4.F90 \ +$(srcdir)/generated/_cosh_r8.F90 \ +$(srcdir)/generated/_cosh_r10.F90 \ +$(srcdir)/generated/_cosh_r16.F90 \ +$(srcdir)/generated/_tanh_r4.F90 \ +$(srcdir)/generated/_tanh_r8.F90 \ +$(srcdir)/generated/_tanh_r10.F90 \ +$(srcdir)/generated/_tanh_r16.F90 \ +$(srcdir)/generated/_conjg_c4.F90 \ +$(srcdir)/generated/_conjg_c8.F90 \ +$(srcdir)/generated/_conjg_c10.F90 \ +$(srcdir)/generated/_conjg_c16.F90 \ +$(srcdir)/generated/_aint_r4.F90 \ +$(srcdir)/generated/_aint_r8.F90 \ +$(srcdir)/generated/_aint_r10.F90 \ +$(srcdir)/generated/_aint_r16.F90 \ +$(srcdir)/generated/_anint_r4.F90 \ +$(srcdir)/generated/_anint_r8.F90 \ +$(srcdir)/generated/_anint_r10.F90 \ +$(srcdir)/generated/_anint_r16.F90 + +gfor_built_specific2_src= \ +$(srcdir)/generated/_sign_i4.F90 \ +$(srcdir)/generated/_sign_i8.F90 \ +$(srcdir)/generated/_sign_i16.F90 \ +$(srcdir)/generated/_sign_r4.F90 \ +$(srcdir)/generated/_sign_r8.F90 \ +$(srcdir)/generated/_sign_r10.F90 \ +$(srcdir)/generated/_sign_r16.F90 \ +$(srcdir)/generated/_dim_i4.F90 \ +$(srcdir)/generated/_dim_i8.F90 \ +$(srcdir)/generated/_dim_i16.F90 \ +$(srcdir)/generated/_dim_r4.F90 \ +$(srcdir)/generated/_dim_r8.F90 \ +$(srcdir)/generated/_dim_r10.F90 \ +$(srcdir)/generated/_dim_r16.F90 \ +$(srcdir)/generated/_atan2_r4.F90 \ +$(srcdir)/generated/_atan2_r8.F90 \ +$(srcdir)/generated/_atan2_r10.F90 \ +$(srcdir)/generated/_atan2_r16.F90 \ +$(srcdir)/generated/_mod_i4.F90 \ +$(srcdir)/generated/_mod_i8.F90 \ +$(srcdir)/generated/_mod_i16.F90 \ +$(srcdir)/generated/_mod_r4.F90 \ +$(srcdir)/generated/_mod_r8.F90 \ +$(srcdir)/generated/_mod_r10.F90 \ +$(srcdir)/generated/_mod_r16.F90 + +gfor_misc_specifics = $(srcdir)/generated/misc_specifics.F90 + +gfor_specific_src= \ +$(gfor_built_specific_src) \ +$(gfor_built_specific2_src) \ +$(gfor_misc_specifics) \ +intrinsics/dprod_r8.f90 \ +intrinsics/f2c_specifics.F90 + +# Turn on vectorization and loop unrolling for matmul. +$(patsubst %.c,%.lo,$(notdir $(i_matmul_c))): AM_CFLAGS += -ftree-vectorize -funroll-loops +# Logical matmul doesn't vectorize. +$(patsubst %.c,%.lo,$(notdir $(i_matmull_c))): AM_CFLAGS += -funroll-loops + +# Add the -fallow-leading-underscore option when needed +$(patsubst %.F90,%.lo,$(patsubst %.f90,%.lo,$(notdir $(gfor_specific_src)))): AM_FCFLAGS += -fallow-leading-underscore +selected_real_kind.lo selected_int_kind.lo: AM_FCFLAGS += -fallow-leading-underscore + +BUILT_SOURCES=$(gfor_built_src) $(gfor_built_specific_src) \ + $(gfor_built_specific2_src) $(gfor_misc_specifics) + +prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \ + $(gfor_helper_src) $(gfor_io_headers) $(gfor_specific_src) + +if onestep +# dummy sources for libtool +BUILT_SOURCES+=libgfortran_c.c libgfortran_f.f90 +libgfortran_c.c libgfortran_f.f90 libgfortran_F.F90: + echo > $@ +# overrides for libtool perusing the dummy sources +libgfortran_c.o: $(filter %.c,$(prereq_SRC)) + $(COMPILE) -c $^ -o $@ -combine + +libgfortran_c.lo: $(filter %.c,$(prereq_SRC)) + $(LTCOMPILE) -c -o $@ $^ -combine + +#libgfortran_f.o: $(filter %.f %.f90,$(prereq_SRC)) +# $(FCCOMPILE) -c $^ -o $@ -combine + +#libgfortran_f.lo: $(filter %.f %.f90,$(prereq_SRC)) +# $(LTFCCOMPILE) -c -o $@ $^ -combine +# not currently used: +#libgfortran_F.o: $(filter %.F %.F90,$(prereq_SRC)) +# $(PPFCCOMPILE) -c $^ -o $@ -combine +# +#libgfortran_F.lo: +# $(LTPPFCCOMPILE) -c -o $@ $^ -combine + +libgfortran_la_SOURCES = libgfortran_c.c $(filter-out %.c,$(prereq_SRC)) + +else +libgfortran_la_SOURCES = $(prereq_SRC) + +endif + +I_M4_DEPS=m4/iparm.m4 +I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4 +I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4 +I_M4_DEPS2=$(I_M4_DEPS) m4/ifunction_logical.m4 + +kinds.h: $(srcdir)/mk-kinds-h.sh + $(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@ + +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)' > $@ || rm $@ + +selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh + $(SHELL) $(srcdir)/mk-srk-inc.sh '$(FCCOMPILE)' > $@ || rm $@ + +fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER) + cp $(srcdir)/$(FPU_HOST_HEADER) $@ + +## A 'normal' build shouldn't need to regenerate these +## so we only include them in maintainer mode + +if MAINTAINER_MODE +$(i_all_c): m4/all.m4 $(I_M4_DEPS2) + $(M4) -Dfile=$@ -I$(srcdir)/m4 all.m4 > $@ + +$(i_bessel_c): m4/bessel.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 bessel.m4 > $@ + +$(i_any_c): m4/any.m4 $(I_M4_DEPS2) + $(M4) -Dfile=$@ -I$(srcdir)/m4 any.m4 > $@ + +$(i_count_c): m4/count.m4 $(I_M4_DEPS2) + $(M4) -Dfile=$@ -I$(srcdir)/m4 count.m4 > $@ + +$(i_iall_c): m4/iall.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 iall.m4 > $@ + +$(i_iany_c): m4/iany.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 iany.m4 > $@ + +$(i_iparity_c): m4/iparity.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 iparity.m4 > $@ + +$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0) + $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0.m4 > $@ + +$(i_maxloc1_c): m4/maxloc1.m4 $(I_M4_DEPS1) + $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc1.m4 > $@ + +$(i_maxval_c): m4/maxval.m4 $(I_M4_DEPS1) + $(M4) -Dfile=$@ -I$(srcdir)/m4 maxval.m4 > $@ + +$(i_minloc0_c): m4/minloc0.m4 $(I_M4_DEPS0) + $(M4) -Dfile=$@ -I$(srcdir)/m4 minloc0.m4 > $@ + +$(i_minloc1_c): m4/minloc1.m4 $(I_M4_DEPS1) + $(M4) -Dfile=$@ -I$(srcdir)/m4 minloc1.m4 > $@ + +$(i_minval_c): m4/minval.m4 $(I_M4_DEPS1) + $(M4) -Dfile=$@ -I$(srcdir)/m4 minval.m4 > $@ + +$(i_product_c): m4/product.m4 $(I_M4_DEPS1) + $(M4) -Dfile=$@ -I$(srcdir)/m4 product.m4 > $@ + +$(i_sum_c): m4/sum.m4 $(I_M4_DEPS1) + $(M4) -Dfile=$@ -I$(srcdir)/m4 sum.m4 > $@ + +$(i_matmul_c): m4/matmul.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 matmul.m4 > $@ + +$(i_matmull_c): m4/matmull.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 matmull.m4 > $@ + +$(i_norm2_c): m4/norm2.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 norm2.m4 > $@ + +$(i_parity_c): m4/parity.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 parity.m4 > $@ + +$(i_transpose_c): m4/transpose.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 transpose.m4 > $@ + +$(i_shape_c): m4/shape.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 shape.m4 > $@ + +$(i_reshape_c): m4/reshape.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 reshape.m4 > $@ + +$(i_eoshift1_c): m4/eoshift1.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 eoshift1.m4 > $@ + +$(i_eoshift3_c): m4/eoshift3.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 eoshift3.m4 > $@ + +$(i_cshift0_c): m4/cshift0.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 cshift0.m4 > $@ + +$(i_cshift1_c): m4/cshift1.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 cshift1.m4 > $@ + +$(in_pack_c): m4/in_pack.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 in_pack.m4 > $@ + +$(in_unpack_c): m4/in_unpack.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 in_unpack.m4 > $@ + +$(i_exponent_c): m4/exponent.m4 m4/mtype.m4 + $(M4) -Dfile=$@ -I$(srcdir)/m4 exponent.m4 > $@ + +$(i_rrspacing_c): m4/rrspacing.m4 m4/mtype.m4 + $(M4) -Dfile=$@ -I$(srcdir)/m4 rrspacing.m4 > $@ + +$(i_spacing_c): m4/spacing.m4 m4/mtype.m4 + $(M4) -Dfile=$@ -I$(srcdir)/m4 spacing.m4 > $@ + +$(i_fraction_c): m4/fraction.m4 m4/mtype.m4 + $(M4) -Dfile=$@ -I$(srcdir)/m4 fraction.m4 > $@ + +$(i_nearest_c): m4/nearest.m4 m4/mtype.m4 + $(M4) -Dfile=$@ -I$(srcdir)/m4 nearest.m4 > $@ + +$(i_set_exponent_c): m4/set_exponent.m4 m4/mtype.m4 + $(M4) -Dfile=$@ -I$(srcdir)/m4 set_exponent.m4 > $@ + +$(i_pow_c): m4/pow.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 pow.m4 > $@ + +$(i_pack_c): m4/pack.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 pack.m4 > $@ + +$(i_unpack_c): m4/unpack.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 unpack.m4 > $@ + +$(i_spread_c): m4/spread.m4 $(I_M4_DEPS) + $(M4) -Dfile=$@ -I$(srcdir)/m4 spread.m4 > $@ + +$(gfor_built_specific_src): m4/specific.m4 m4/head.m4 + $(M4) -Dfile=$@ -I$(srcdir)/m4 specific.m4 > $@ + +$(gfor_built_specific2_src): m4/specific2.m4 m4/head.m4 + $(M4) -Dfile=$@ -I$(srcdir)/m4 specific2.m4 > $@ + +$(gfor_misc_specifics): m4/misc_specifics.m4 m4/head.m4 + $(M4) -Dfile=$@ -I$(srcdir)/m4 misc_specifics.m4 > $@ +## end of maintainer mode only rules +endif + +EXTRA_DIST = $(m4_files) diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in new file mode 100644 index 000000000..dac8bb84c --- /dev/null +++ b/libgfortran/Makefile.in @@ -0,0 +1,5987 @@ +# Makefile.in generated by automake 1.11.1 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, +# Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + + +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +target_triplet = @target@ + +# dummy sources for libtool +@onestep_TRUE@am__append_1 = libgfortran_c.c libgfortran_f.f90 +subdir = . +DIST_COMMON = ChangeLog $(srcdir)/Makefile.in $(srcdir)/Makefile.am \ + $(top_srcdir)/configure $(am__configure_deps) \ + $(srcdir)/config.h.in $(srcdir)/../mkinstalldirs \ + $(srcdir)/libgfortran.spec.in $(srcdir)/../depcomp +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/../config/depstand.m4 \ + $(top_srcdir)/../config/lead-dot.m4 \ + $(top_srcdir)/../config/lthostflags.m4 \ + $(top_srcdir)/../config/multi.m4 \ + $(top_srcdir)/../config/override.m4 \ + $(top_srcdir)/../config/stdint.m4 \ + $(top_srcdir)/../ltoptions.m4 $(top_srcdir)/../ltsugar.m4 \ + $(top_srcdir)/../ltversion.m4 $(top_srcdir)/../lt~obsolete.m4 \ + $(top_srcdir)/acinclude.m4 $(top_srcdir)/../config/acx.m4 \ + $(top_srcdir)/../config/no-executables.m4 \ + $(top_srcdir)/../libtool.m4 $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ + configure.lineno config.status.lineno +mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs +CONFIG_HEADER = config.h +CONFIG_CLEAN_FILES = libgfortran.spec +CONFIG_CLEAN_VPATH_FILES = +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; +am__install_max = 40 +am__nobase_strip_setup = \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` +am__nobase_strip = \ + for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" +am__nobase_list = $(am__nobase_strip_setup); \ + for p in $$list; do echo "$$p $$p"; done | \ + sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ + $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ + if (++n[$$2] == $(am__install_max)) \ + { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ + END { for (dir in files) print dir, files[dir] }' +am__base_list = \ + sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ + sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' +am__installdirs = "$(DESTDIR)$(myexeclibdir)" \ + "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" +LTLIBRARIES = $(myexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES) +libgfortran_la_LIBADD = +am__objects_1 = backtrace.lo bounds.lo compile_options.lo \ + convert_char.lo environ.lo error.lo fpu.lo main.lo memory.lo \ + pause.lo stop.lo string.lo select.lo +am__objects_2 = all_l1.lo all_l2.lo all_l4.lo all_l8.lo all_l16.lo +am__objects_3 = any_l1.lo any_l2.lo any_l4.lo any_l8.lo any_l16.lo +am__objects_4 = count_1_l.lo count_2_l.lo count_4_l.lo count_8_l.lo \ + count_16_l.lo +am__objects_5 = maxloc0_4_i1.lo maxloc0_8_i1.lo maxloc0_16_i1.lo \ + maxloc0_4_i2.lo maxloc0_8_i2.lo maxloc0_16_i2.lo \ + 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_i1.lo maxloc1_8_i1.lo maxloc1_16_i1.lo \ + maxloc1_4_i2.lo maxloc1_8_i2.lo maxloc1_16_i2.lo \ + 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_i1.lo maxval_i2.lo 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_i1.lo minloc0_8_i1.lo minloc0_16_i1.lo \ + minloc0_4_i2.lo minloc0_8_i2.lo minloc0_16_i2.lo \ + 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_i1.lo minloc1_8_i1.lo minloc1_16_i1.lo \ + minloc1_4_i2.lo minloc1_8_i2.lo minloc1_16_i2.lo \ + 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_i1.lo minval_i2.lo 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_i1.lo product_i2.lo 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_i1.lo sum_i2.lo sum_i4.lo sum_i8.lo sum_i16.lo \ + sum_r4.lo sum_r8.lo sum_r10.lo sum_r16.lo sum_c4.lo sum_c8.lo \ + sum_c10.lo sum_c16.lo +am__objects_13 = bessel_r4.lo bessel_r8.lo bessel_r10.lo bessel_r16.lo +am__objects_14 = iall_i1.lo iall_i2.lo iall_i4.lo iall_i8.lo \ + iall_i16.lo +am__objects_15 = iany_i1.lo iany_i2.lo iany_i4.lo iany_i8.lo \ + iany_i16.lo +am__objects_16 = iparity_i1.lo iparity_i2.lo iparity_i4.lo \ + iparity_i8.lo iparity_i16.lo +am__objects_17 = norm2_r4.lo norm2_r8.lo norm2_r10.lo norm2_r16.lo +am__objects_18 = parity_l1.lo parity_l2.lo parity_l4.lo parity_l8.lo \ + parity_l16.lo +am__objects_19 = matmul_i1.lo matmul_i2.lo matmul_i4.lo matmul_i8.lo \ + matmul_i16.lo matmul_r4.lo matmul_r8.lo matmul_r10.lo \ + matmul_r16.lo matmul_c4.lo matmul_c8.lo matmul_c10.lo \ + matmul_c16.lo +am__objects_20 = matmul_l4.lo matmul_l8.lo matmul_l16.lo +am__objects_21 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \ + transpose_r4.lo transpose_r8.lo transpose_r10.lo \ + transpose_r16.lo transpose_c4.lo transpose_c8.lo \ + transpose_c10.lo transpose_c16.lo +am__objects_22 = shape_i4.lo shape_i8.lo shape_i16.lo +am__objects_23 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo +am__objects_24 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo +am__objects_25 = cshift1_4.lo cshift1_8.lo cshift1_16.lo +am__objects_26 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \ + reshape_r4.lo reshape_r8.lo reshape_r10.lo reshape_r16.lo \ + reshape_c4.lo reshape_c8.lo reshape_c10.lo reshape_c16.lo +am__objects_27 = in_pack_i1.lo in_pack_i2.lo in_pack_i4.lo \ + in_pack_i8.lo in_pack_i16.lo in_pack_r4.lo in_pack_r8.lo \ + in_pack_r10.lo in_pack_r16.lo in_pack_c4.lo in_pack_c8.lo \ + in_pack_c10.lo in_pack_c16.lo +am__objects_28 = in_unpack_i1.lo in_unpack_i2.lo in_unpack_i4.lo \ + in_unpack_i8.lo in_unpack_i16.lo in_unpack_r4.lo \ + in_unpack_r8.lo in_unpack_r10.lo in_unpack_r16.lo \ + in_unpack_c4.lo in_unpack_c8.lo in_unpack_c10.lo \ + in_unpack_c16.lo +am__objects_29 = exponent_r4.lo exponent_r8.lo exponent_r10.lo \ + exponent_r16.lo +am__objects_30 = fraction_r4.lo fraction_r8.lo fraction_r10.lo \ + fraction_r16.lo +am__objects_31 = nearest_r4.lo nearest_r8.lo nearest_r10.lo \ + nearest_r16.lo +am__objects_32 = set_exponent_r4.lo set_exponent_r8.lo \ + set_exponent_r10.lo set_exponent_r16.lo +am__objects_33 = pow_i4_i4.lo pow_i8_i4.lo pow_i16_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_34 = rrspacing_r4.lo rrspacing_r8.lo rrspacing_r10.lo \ + rrspacing_r16.lo +am__objects_35 = spacing_r4.lo spacing_r8.lo spacing_r10.lo \ + spacing_r16.lo +am__objects_36 = pack_i1.lo pack_i2.lo pack_i4.lo pack_i8.lo \ + pack_i16.lo pack_r4.lo pack_r8.lo pack_r10.lo pack_r16.lo \ + pack_c4.lo pack_c8.lo pack_c10.lo pack_c16.lo +am__objects_37 = unpack_i1.lo unpack_i2.lo unpack_i4.lo unpack_i8.lo \ + unpack_i16.lo unpack_r4.lo unpack_r8.lo unpack_r10.lo \ + unpack_r16.lo unpack_c4.lo unpack_c8.lo unpack_c10.lo \ + unpack_c16.lo +am__objects_38 = spread_i1.lo spread_i2.lo spread_i4.lo spread_i8.lo \ + spread_i16.lo spread_r4.lo spread_r8.lo spread_r10.lo \ + spread_r16.lo spread_c4.lo spread_c8.lo spread_c10.lo \ + spread_c16.lo +am__objects_39 = cshift0_i1.lo cshift0_i2.lo cshift0_i4.lo \ + cshift0_i8.lo cshift0_i16.lo cshift0_r4.lo cshift0_r8.lo \ + cshift0_r10.lo cshift0_r16.lo cshift0_c4.lo cshift0_c8.lo \ + cshift0_c10.lo cshift0_c16.lo +am__objects_40 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \ + $(am__objects_5) $(am__objects_6) $(am__objects_7) \ + $(am__objects_8) $(am__objects_9) $(am__objects_10) \ + $(am__objects_11) $(am__objects_12) $(am__objects_13) \ + $(am__objects_14) $(am__objects_15) $(am__objects_16) \ + $(am__objects_17) $(am__objects_18) $(am__objects_19) \ + $(am__objects_20) $(am__objects_21) $(am__objects_22) \ + $(am__objects_23) $(am__objects_24) $(am__objects_25) \ + $(am__objects_26) $(am__objects_27) $(am__objects_28) \ + $(am__objects_29) $(am__objects_30) $(am__objects_31) \ + $(am__objects_32) $(am__objects_33) $(am__objects_34) \ + $(am__objects_35) $(am__objects_36) $(am__objects_37) \ + $(am__objects_38) $(am__objects_39) +am__objects_41 = close.lo file_pos.lo format.lo inquire.lo \ + intrinsics.lo list_read.lo lock.lo open.lo read.lo \ + size_from_kind.lo transfer.lo transfer128.lo unit.lo unix.lo \ + write.lo fbuf.lo +am__objects_42 = associated.lo abort.lo access.lo args.lo \ + bit_intrinsics.lo c99_functions.lo chdir.lo chmod.lo clock.lo \ + cpu_time.lo cshift0.lo ctime.lo date_and_time.lo dtime.lo \ + env.lo eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo \ + execute_command_line.lo exit.lo extends_type_of.lo fnum.lo \ + gerror.lo getcwd.lo getlog.lo getXid.lo hostnm.lo ierrno.lo \ + ishftc.lo iso_c_generated_procs.lo iso_c_binding.lo kill.lo \ + link.lo malloc.lo mvbits.lo move_alloc.lo pack_generic.lo \ + perror.lo selected_char_kind.lo signal.lo size.lo sleep.lo \ + spread_generic.lo string_intrinsics.lo system.lo rand.lo \ + random.lo rename.lo reshape_generic.lo reshape_packed.lo \ + selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \ + system_clock.lo time.lo transpose_generic.lo umask.lo \ + unlink.lo unpack_generic.lo in_pack_generic.lo \ + in_unpack_generic.lo +am__objects_43 = +am__objects_44 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \ + _abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \ + _abs_r10.lo _abs_r16.lo _aimag_c4.lo _aimag_c8.lo \ + _aimag_c10.lo _aimag_c16.lo _exp_r4.lo _exp_r8.lo _exp_r10.lo \ + _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 \ + _asinh_r4.lo _asinh_r8.lo _asinh_r10.lo _asinh_r16.lo \ + _acos_r4.lo _acos_r8.lo _acos_r10.lo _acos_r16.lo _acosh_r4.lo \ + _acosh_r8.lo _acosh_r10.lo _acosh_r16.lo _atan_r4.lo \ + _atan_r8.lo _atan_r10.lo _atan_r16.lo _atanh_r4.lo \ + _atanh_r8.lo _atanh_r10.lo _atanh_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_45 = _sign_i4.lo _sign_i8.lo _sign_i16.lo _sign_r4.lo \ + _sign_r8.lo _sign_r10.lo _sign_r16.lo _dim_i4.lo _dim_i8.lo \ + _dim_i16.lo _dim_r4.lo _dim_r8.lo _dim_r10.lo _dim_r16.lo \ + _atan2_r4.lo _atan2_r8.lo _atan2_r10.lo _atan2_r16.lo \ + _mod_i4.lo _mod_i8.lo _mod_i16.lo _mod_r4.lo _mod_r8.lo \ + _mod_r10.lo _mod_r16.lo +am__objects_46 = misc_specifics.lo +am__objects_47 = $(am__objects_44) $(am__objects_45) $(am__objects_46) \ + dprod_r8.lo f2c_specifics.lo +am__objects_48 = $(am__objects_1) $(am__objects_40) $(am__objects_41) \ + $(am__objects_42) $(am__objects_43) $(am__objects_47) +@onestep_FALSE@am_libgfortran_la_OBJECTS = $(am__objects_48) +@onestep_TRUE@am_libgfortran_la_OBJECTS = libgfortran_c.lo +libgfortran_la_OBJECTS = $(am_libgfortran_la_OBJECTS) +libgfortranbegin_la_LIBADD = +am_libgfortranbegin_la_OBJECTS = fmain.lo +libgfortranbegin_la_OBJECTS = $(am_libgfortranbegin_la_OBJECTS) +DEFAULT_INCLUDES = -I.@am__isrc@ +depcomp = $(SHELL) $(top_srcdir)/../depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +PPFCCOMPILE = $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) +LTPPFCCOMPILE = $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) +FCLD = $(FC) +FCLINK = $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=link $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) $(AM_LDFLAGS) \ + $(LDFLAGS) -o $@ +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +LTCOMPILE = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +CCLD = $(CC) +LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \ + $(LDFLAGS) -o $@ +FCCOMPILE = $(FC) $(AM_FCFLAGS) $(FCFLAGS) +LTFCCOMPILE = $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) +SOURCES = $(libgfortran_la_SOURCES) $(libgfortranbegin_la_SOURCES) +MULTISRCTOP = +MULTIBUILDTOP = +MULTIDIRS = +MULTISUBDIR = +MULTIDO = true +MULTICLEAN = true +DATA = $(toolexeclib_DATA) +ETAGS = etags +CTAGS = ctags +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ + +# Fortran rules for complex multiplication and division + +# Use -ffunction-sections -fdata-sections if supported by the compiler + +# Some targets require additional compiler options for IEEE compatibility. +AM_CFLAGS = @AM_CFLAGS@ -fcx-fortran-rules $(SECTION_FLAGS) \ + $(IEEE_FLAGS) +AM_FCFLAGS = @AM_FCFLAGS@ +AR = @AR@ +AS = @AS@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +FC = @FC@ +FCFLAGS = @FCFLAGS@ +FGREP = @FGREP@ +FPU_HOST_HEADER = @FPU_HOST_HEADER@ +GREP = @GREP@ +IEEE_FLAGS = @IEEE_FLAGS@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBQUADINCLUDE = @LIBQUADINCLUDE@ +LIBQUADLIB = @LIBQUADLIB@ +LIBQUADLIB_DEP = @LIBQUADLIB_DEP@ +LIBQUADSPEC = @LIBQUADSPEC@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +RANLIB = @RANLIB@ +SECTION_FLAGS = @SECTION_FLAGS@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +VERSION = @VERSION@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_FC = @ac_ct_FC@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_libsubdir = @build_libsubdir@ +build_os = @build_os@ +build_subdir = @build_subdir@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +enable_shared = @enable_shared@ +enable_static = @enable_static@ +exec_prefix = @exec_prefix@ +extra_ldflags_libgfortran = @extra_ldflags_libgfortran@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_subdir = @host_subdir@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +lt_host_flags = @lt_host_flags@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +multi_basedir = @multi_basedir@ +oldincludedir = @oldincludedir@ +onestep = @onestep@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target = @target@ +target_alias = @target_alias@ +target_cpu = @target_cpu@ +target_os = @target_os@ +target_subdir = @target_subdir@ +target_vendor = @target_vendor@ +toolexecdir = @toolexecdir@ +toolexeclibdir = @toolexeclibdir@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +ACLOCAL_AMFLAGS = -I .. -I ../config +gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER) +@LIBGFOR_USE_SYMVER_FALSE@version_arg = +@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,--version-script=$(srcdir)/gfortran.map +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,-M,gfortran.map-sun +@LIBGFOR_USE_SYMVER_FALSE@version_dep = +@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = $(srcdir)/gfortran.map +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = gfortran.map-sun +LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) \ + $(lt_host_flags) + +toolexeclib_LTLIBRARIES = libgfortran.la +toolexeclib_DATA = libgfortran.spec +libgfortran_la_LINK = $(LINK) $(libgfortran_la_LDFLAGS) +libgfortran_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` $(LTLDFLAGS) $(LIBQUADLIB) -lm $(extra_ldflags_libgfortran) $(version_arg) +libgfortran_la_DEPENDENCIES = $(version_dep) libgfortran.spec $(LIBQUADLIB_DEP) +myexeclib_LTLIBRARIES = libgfortranbegin.la +myexeclibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR) +libgfortranbegin_la_SOURCES = fmain.c +libgfortranbegin_la_LDFLAGS = -static +libgfortranbegin_la_LINK = $(LINK) $(libgfortranbegin_la_LDFLAGS) +AM_CPPFLAGS = -iquote$(srcdir)/io -I$(srcdir)/$(MULTISRCTOP)../gcc \ + -I$(srcdir)/$(MULTISRCTOP)../gcc/config $(LIBQUADINCLUDE) \ + -I$(MULTIBUILDTOP)../../$(host_subdir)/gcc -D_GNU_SOURCE + +gfor_io_src = \ +io/close.c \ +io/file_pos.c \ +io/format.c \ +io/inquire.c \ +io/intrinsics.c \ +io/list_read.c \ +io/lock.c \ +io/open.c \ +io/read.c \ +io/size_from_kind.c \ +io/transfer.c \ +io/transfer128.c \ +io/unit.c \ +io/unix.c \ +io/write.c \ +io/fbuf.c + +gfor_io_headers = \ +io/io.h \ +io/fbuf.h \ +io/format.h \ +io/unix.h + +gfor_helper_src = \ +intrinsics/associated.c \ +intrinsics/abort.c \ +intrinsics/access.c \ +intrinsics/args.c \ +intrinsics/bit_intrinsics.c \ +intrinsics/c99_functions.c \ +intrinsics/chdir.c \ +intrinsics/chmod.c \ +intrinsics/clock.c \ +intrinsics/cpu_time.c \ +intrinsics/cshift0.c \ +intrinsics/ctime.c \ +intrinsics/date_and_time.c \ +intrinsics/dtime.c \ +intrinsics/env.c \ +intrinsics/eoshift0.c \ +intrinsics/eoshift2.c \ +intrinsics/erfc_scaled.c \ +intrinsics/etime.c \ +intrinsics/execute_command_line.c \ +intrinsics/exit.c \ +intrinsics/extends_type_of.c \ +intrinsics/fnum.c \ +intrinsics/gerror.c \ +intrinsics/getcwd.c \ +intrinsics/getlog.c \ +intrinsics/getXid.c \ +intrinsics/hostnm.c \ +intrinsics/ierrno.c \ +intrinsics/ishftc.c \ +intrinsics/iso_c_generated_procs.c \ +intrinsics/iso_c_binding.c \ +intrinsics/kill.c \ +intrinsics/link.c \ +intrinsics/malloc.c \ +intrinsics/mvbits.c \ +intrinsics/move_alloc.c \ +intrinsics/pack_generic.c \ +intrinsics/perror.c \ +intrinsics/selected_char_kind.c \ +intrinsics/signal.c \ +intrinsics/size.c \ +intrinsics/sleep.c \ +intrinsics/spread_generic.c \ +intrinsics/string_intrinsics.c \ +intrinsics/system.c \ +intrinsics/rand.c \ +intrinsics/random.c \ +intrinsics/rename.c \ +intrinsics/reshape_generic.c \ +intrinsics/reshape_packed.c \ +intrinsics/selected_int_kind.f90 \ +intrinsics/selected_real_kind.f90 \ +intrinsics/stat.c \ +intrinsics/symlnk.c \ +intrinsics/system_clock.c \ +intrinsics/time.c \ +intrinsics/transpose_generic.c \ +intrinsics/umask.c \ +intrinsics/unlink.c \ +intrinsics/unpack_generic.c \ +runtime/in_pack_generic.c \ +runtime/in_unpack_generic.c + +gfor_src = \ +runtime/backtrace.c \ +runtime/bounds.c \ +runtime/compile_options.c \ +runtime/convert_char.c \ +runtime/environ.c \ +runtime/error.c \ +runtime/fpu.c \ +runtime/main.c \ +runtime/memory.c \ +runtime/pause.c \ +runtime/stop.c \ +runtime/string.c \ +runtime/select.c + +i_all_c = \ +$(srcdir)/generated/all_l1.c \ +$(srcdir)/generated/all_l2.c \ +$(srcdir)/generated/all_l4.c \ +$(srcdir)/generated/all_l8.c \ +$(srcdir)/generated/all_l16.c + +i_any_c = \ +$(srcdir)/generated/any_l1.c \ +$(srcdir)/generated/any_l2.c \ +$(srcdir)/generated/any_l4.c \ +$(srcdir)/generated/any_l8.c \ +$(srcdir)/generated/any_l16.c + +i_bessel_c = \ +$(srcdir)/generated/bessel_r4.c \ +$(srcdir)/generated/bessel_r8.c \ +$(srcdir)/generated/bessel_r10.c \ +$(srcdir)/generated/bessel_r16.c + +i_count_c = \ +$(srcdir)/generated/count_1_l.c \ +$(srcdir)/generated/count_2_l.c \ +$(srcdir)/generated/count_4_l.c \ +$(srcdir)/generated/count_8_l.c \ +$(srcdir)/generated/count_16_l.c + +i_iall_c = \ +$(srcdir)/generated/iall_i1.c \ +$(srcdir)/generated/iall_i2.c \ +$(srcdir)/generated/iall_i4.c \ +$(srcdir)/generated/iall_i8.c \ +$(srcdir)/generated/iall_i16.c + +i_iany_c = \ +$(srcdir)/generated/iany_i1.c \ +$(srcdir)/generated/iany_i2.c \ +$(srcdir)/generated/iany_i4.c \ +$(srcdir)/generated/iany_i8.c \ +$(srcdir)/generated/iany_i16.c + +i_iparity_c = \ +$(srcdir)/generated/iparity_i1.c \ +$(srcdir)/generated/iparity_i2.c \ +$(srcdir)/generated/iparity_i4.c \ +$(srcdir)/generated/iparity_i8.c \ +$(srcdir)/generated/iparity_i16.c + +i_maxloc0_c = \ +$(srcdir)/generated/maxloc0_4_i1.c \ +$(srcdir)/generated/maxloc0_8_i1.c \ +$(srcdir)/generated/maxloc0_16_i1.c \ +$(srcdir)/generated/maxloc0_4_i2.c \ +$(srcdir)/generated/maxloc0_8_i2.c \ +$(srcdir)/generated/maxloc0_16_i2.c \ +$(srcdir)/generated/maxloc0_4_i4.c \ +$(srcdir)/generated/maxloc0_8_i4.c \ +$(srcdir)/generated/maxloc0_16_i4.c \ +$(srcdir)/generated/maxloc0_4_i8.c \ +$(srcdir)/generated/maxloc0_8_i8.c \ +$(srcdir)/generated/maxloc0_16_i8.c \ +$(srcdir)/generated/maxloc0_4_i16.c \ +$(srcdir)/generated/maxloc0_8_i16.c \ +$(srcdir)/generated/maxloc0_16_i16.c \ +$(srcdir)/generated/maxloc0_4_r4.c \ +$(srcdir)/generated/maxloc0_8_r4.c \ +$(srcdir)/generated/maxloc0_16_r4.c \ +$(srcdir)/generated/maxloc0_4_r8.c \ +$(srcdir)/generated/maxloc0_8_r8.c \ +$(srcdir)/generated/maxloc0_16_r8.c \ +$(srcdir)/generated/maxloc0_4_r10.c \ +$(srcdir)/generated/maxloc0_8_r10.c \ +$(srcdir)/generated/maxloc0_16_r10.c \ +$(srcdir)/generated/maxloc0_4_r16.c \ +$(srcdir)/generated/maxloc0_8_r16.c \ +$(srcdir)/generated/maxloc0_16_r16.c + +i_maxloc1_c = \ +$(srcdir)/generated/maxloc1_4_i1.c \ +$(srcdir)/generated/maxloc1_8_i1.c \ +$(srcdir)/generated/maxloc1_16_i1.c \ +$(srcdir)/generated/maxloc1_4_i2.c \ +$(srcdir)/generated/maxloc1_8_i2.c \ +$(srcdir)/generated/maxloc1_16_i2.c \ +$(srcdir)/generated/maxloc1_4_i4.c \ +$(srcdir)/generated/maxloc1_8_i4.c \ +$(srcdir)/generated/maxloc1_16_i4.c \ +$(srcdir)/generated/maxloc1_4_i8.c \ +$(srcdir)/generated/maxloc1_8_i8.c \ +$(srcdir)/generated/maxloc1_16_i8.c \ +$(srcdir)/generated/maxloc1_4_i16.c \ +$(srcdir)/generated/maxloc1_8_i16.c \ +$(srcdir)/generated/maxloc1_16_i16.c \ +$(srcdir)/generated/maxloc1_4_r4.c \ +$(srcdir)/generated/maxloc1_8_r4.c \ +$(srcdir)/generated/maxloc1_16_r4.c \ +$(srcdir)/generated/maxloc1_4_r8.c \ +$(srcdir)/generated/maxloc1_8_r8.c \ +$(srcdir)/generated/maxloc1_16_r8.c \ +$(srcdir)/generated/maxloc1_4_r10.c \ +$(srcdir)/generated/maxloc1_8_r10.c \ +$(srcdir)/generated/maxloc1_16_r10.c \ +$(srcdir)/generated/maxloc1_4_r16.c \ +$(srcdir)/generated/maxloc1_8_r16.c \ +$(srcdir)/generated/maxloc1_16_r16.c + +i_maxval_c = \ +$(srcdir)/generated/maxval_i1.c \ +$(srcdir)/generated/maxval_i2.c \ +$(srcdir)/generated/maxval_i4.c \ +$(srcdir)/generated/maxval_i8.c \ +$(srcdir)/generated/maxval_i16.c \ +$(srcdir)/generated/maxval_r4.c \ +$(srcdir)/generated/maxval_r8.c \ +$(srcdir)/generated/maxval_r10.c \ +$(srcdir)/generated/maxval_r16.c + +i_minloc0_c = \ +$(srcdir)/generated/minloc0_4_i1.c \ +$(srcdir)/generated/minloc0_8_i1.c \ +$(srcdir)/generated/minloc0_16_i1.c \ +$(srcdir)/generated/minloc0_4_i2.c \ +$(srcdir)/generated/minloc0_8_i2.c \ +$(srcdir)/generated/minloc0_16_i2.c \ +$(srcdir)/generated/minloc0_4_i4.c \ +$(srcdir)/generated/minloc0_8_i4.c \ +$(srcdir)/generated/minloc0_16_i4.c \ +$(srcdir)/generated/minloc0_4_i8.c \ +$(srcdir)/generated/minloc0_8_i8.c \ +$(srcdir)/generated/minloc0_16_i8.c \ +$(srcdir)/generated/minloc0_4_i16.c \ +$(srcdir)/generated/minloc0_8_i16.c \ +$(srcdir)/generated/minloc0_16_i16.c \ +$(srcdir)/generated/minloc0_4_r4.c \ +$(srcdir)/generated/minloc0_8_r4.c \ +$(srcdir)/generated/minloc0_16_r4.c \ +$(srcdir)/generated/minloc0_4_r8.c \ +$(srcdir)/generated/minloc0_8_r8.c \ +$(srcdir)/generated/minloc0_16_r8.c \ +$(srcdir)/generated/minloc0_4_r10.c \ +$(srcdir)/generated/minloc0_8_r10.c \ +$(srcdir)/generated/minloc0_16_r10.c \ +$(srcdir)/generated/minloc0_4_r16.c \ +$(srcdir)/generated/minloc0_8_r16.c \ +$(srcdir)/generated/minloc0_16_r16.c + +i_minloc1_c = \ +$(srcdir)/generated/minloc1_4_i1.c \ +$(srcdir)/generated/minloc1_8_i1.c \ +$(srcdir)/generated/minloc1_16_i1.c \ +$(srcdir)/generated/minloc1_4_i2.c \ +$(srcdir)/generated/minloc1_8_i2.c \ +$(srcdir)/generated/minloc1_16_i2.c \ +$(srcdir)/generated/minloc1_4_i4.c \ +$(srcdir)/generated/minloc1_8_i4.c \ +$(srcdir)/generated/minloc1_16_i4.c \ +$(srcdir)/generated/minloc1_4_i8.c \ +$(srcdir)/generated/minloc1_8_i8.c \ +$(srcdir)/generated/minloc1_16_i8.c \ +$(srcdir)/generated/minloc1_4_i16.c \ +$(srcdir)/generated/minloc1_8_i16.c \ +$(srcdir)/generated/minloc1_16_i16.c \ +$(srcdir)/generated/minloc1_4_r4.c \ +$(srcdir)/generated/minloc1_8_r4.c \ +$(srcdir)/generated/minloc1_16_r4.c \ +$(srcdir)/generated/minloc1_4_r8.c \ +$(srcdir)/generated/minloc1_8_r8.c \ +$(srcdir)/generated/minloc1_16_r8.c \ +$(srcdir)/generated/minloc1_4_r10.c \ +$(srcdir)/generated/minloc1_8_r10.c \ +$(srcdir)/generated/minloc1_16_r10.c \ +$(srcdir)/generated/minloc1_4_r16.c \ +$(srcdir)/generated/minloc1_8_r16.c \ +$(srcdir)/generated/minloc1_16_r16.c + +i_minval_c = \ +$(srcdir)/generated/minval_i1.c \ +$(srcdir)/generated/minval_i2.c \ +$(srcdir)/generated/minval_i4.c \ +$(srcdir)/generated/minval_i8.c \ +$(srcdir)/generated/minval_i16.c \ +$(srcdir)/generated/minval_r4.c \ +$(srcdir)/generated/minval_r8.c \ +$(srcdir)/generated/minval_r10.c \ +$(srcdir)/generated/minval_r16.c + +i_norm2_c = \ +$(srcdir)/generated/norm2_r4.c \ +$(srcdir)/generated/norm2_r8.c \ +$(srcdir)/generated/norm2_r10.c \ +$(srcdir)/generated/norm2_r16.c + +i_parity_c = \ +$(srcdir)/generated/parity_l1.c \ +$(srcdir)/generated/parity_l2.c \ +$(srcdir)/generated/parity_l4.c \ +$(srcdir)/generated/parity_l8.c \ +$(srcdir)/generated/parity_l16.c + +i_sum_c = \ +$(srcdir)/generated/sum_i1.c \ +$(srcdir)/generated/sum_i2.c \ +$(srcdir)/generated/sum_i4.c \ +$(srcdir)/generated/sum_i8.c \ +$(srcdir)/generated/sum_i16.c \ +$(srcdir)/generated/sum_r4.c \ +$(srcdir)/generated/sum_r8.c \ +$(srcdir)/generated/sum_r10.c \ +$(srcdir)/generated/sum_r16.c \ +$(srcdir)/generated/sum_c4.c \ +$(srcdir)/generated/sum_c8.c \ +$(srcdir)/generated/sum_c10.c \ +$(srcdir)/generated/sum_c16.c + +i_product_c = \ +$(srcdir)/generated/product_i1.c \ +$(srcdir)/generated/product_i2.c \ +$(srcdir)/generated/product_i4.c \ +$(srcdir)/generated/product_i8.c \ +$(srcdir)/generated/product_i16.c \ +$(srcdir)/generated/product_r4.c \ +$(srcdir)/generated/product_r8.c \ +$(srcdir)/generated/product_r10.c \ +$(srcdir)/generated/product_r16.c \ +$(srcdir)/generated/product_c4.c \ +$(srcdir)/generated/product_c8.c \ +$(srcdir)/generated/product_c10.c \ +$(srcdir)/generated/product_c16.c + +i_matmul_c = \ +$(srcdir)/generated/matmul_i1.c \ +$(srcdir)/generated/matmul_i2.c \ +$(srcdir)/generated/matmul_i4.c \ +$(srcdir)/generated/matmul_i8.c \ +$(srcdir)/generated/matmul_i16.c \ +$(srcdir)/generated/matmul_r4.c \ +$(srcdir)/generated/matmul_r8.c \ +$(srcdir)/generated/matmul_r10.c \ +$(srcdir)/generated/matmul_r16.c \ +$(srcdir)/generated/matmul_c4.c \ +$(srcdir)/generated/matmul_c8.c \ +$(srcdir)/generated/matmul_c10.c \ +$(srcdir)/generated/matmul_c16.c + +i_matmull_c = \ +$(srcdir)/generated/matmul_l4.c \ +$(srcdir)/generated/matmul_l8.c \ +$(srcdir)/generated/matmul_l16.c + +i_transpose_c = \ +$(srcdir)/generated/transpose_i4.c \ +$(srcdir)/generated/transpose_i8.c \ +$(srcdir)/generated/transpose_i16.c \ +$(srcdir)/generated/transpose_r4.c \ +$(srcdir)/generated/transpose_r8.c \ +$(srcdir)/generated/transpose_r10.c \ +$(srcdir)/generated/transpose_r16.c \ +$(srcdir)/generated/transpose_c4.c \ +$(srcdir)/generated/transpose_c8.c \ +$(srcdir)/generated/transpose_c10.c \ +$(srcdir)/generated/transpose_c16.c + +i_shape_c = \ +$(srcdir)/generated/shape_i4.c \ +$(srcdir)/generated/shape_i8.c \ +$(srcdir)/generated/shape_i16.c + +i_reshape_c = \ +$(srcdir)/generated/reshape_i4.c \ +$(srcdir)/generated/reshape_i8.c \ +$(srcdir)/generated/reshape_i16.c \ +$(srcdir)/generated/reshape_r4.c \ +$(srcdir)/generated/reshape_r8.c \ +$(srcdir)/generated/reshape_r10.c \ +$(srcdir)/generated/reshape_r16.c \ +$(srcdir)/generated/reshape_c4.c \ +$(srcdir)/generated/reshape_c8.c \ +$(srcdir)/generated/reshape_c10.c \ +$(srcdir)/generated/reshape_c16.c + +i_eoshift1_c = \ +$(srcdir)/generated/eoshift1_4.c \ +$(srcdir)/generated/eoshift1_8.c \ +$(srcdir)/generated/eoshift1_16.c + +i_eoshift3_c = \ +$(srcdir)/generated/eoshift3_4.c \ +$(srcdir)/generated/eoshift3_8.c \ +$(srcdir)/generated/eoshift3_16.c + +i_cshift0_c = \ +$(srcdir)/generated/cshift0_i1.c \ +$(srcdir)/generated/cshift0_i2.c \ +$(srcdir)/generated/cshift0_i4.c \ +$(srcdir)/generated/cshift0_i8.c \ +$(srcdir)/generated/cshift0_i16.c \ +$(srcdir)/generated/cshift0_r4.c \ +$(srcdir)/generated/cshift0_r8.c \ +$(srcdir)/generated/cshift0_r10.c \ +$(srcdir)/generated/cshift0_r16.c \ +$(srcdir)/generated/cshift0_c4.c \ +$(srcdir)/generated/cshift0_c8.c \ +$(srcdir)/generated/cshift0_c10.c \ +$(srcdir)/generated/cshift0_c16.c + +i_cshift1_c = \ +$(srcdir)/generated/cshift1_4.c \ +$(srcdir)/generated/cshift1_8.c \ +$(srcdir)/generated/cshift1_16.c + +in_pack_c = \ +$(srcdir)/generated/in_pack_i1.c \ +$(srcdir)/generated/in_pack_i2.c \ +$(srcdir)/generated/in_pack_i4.c \ +$(srcdir)/generated/in_pack_i8.c \ +$(srcdir)/generated/in_pack_i16.c \ +$(srcdir)/generated/in_pack_r4.c \ +$(srcdir)/generated/in_pack_r8.c \ +$(srcdir)/generated/in_pack_r10.c \ +$(srcdir)/generated/in_pack_r16.c \ +$(srcdir)/generated/in_pack_c4.c \ +$(srcdir)/generated/in_pack_c8.c \ +$(srcdir)/generated/in_pack_c10.c \ +$(srcdir)/generated/in_pack_c16.c + +in_unpack_c = \ +$(srcdir)/generated/in_unpack_i1.c \ +$(srcdir)/generated/in_unpack_i2.c \ +$(srcdir)/generated/in_unpack_i4.c \ +$(srcdir)/generated/in_unpack_i8.c \ +$(srcdir)/generated/in_unpack_i16.c \ +$(srcdir)/generated/in_unpack_r4.c \ +$(srcdir)/generated/in_unpack_r8.c \ +$(srcdir)/generated/in_unpack_r10.c \ +$(srcdir)/generated/in_unpack_r16.c \ +$(srcdir)/generated/in_unpack_c4.c \ +$(srcdir)/generated/in_unpack_c8.c \ +$(srcdir)/generated/in_unpack_c10.c \ +$(srcdir)/generated/in_unpack_c16.c + +i_exponent_c = \ +$(srcdir)/generated/exponent_r4.c \ +$(srcdir)/generated/exponent_r8.c \ +$(srcdir)/generated/exponent_r10.c \ +$(srcdir)/generated/exponent_r16.c + +i_spacing_c = \ +$(srcdir)/generated/spacing_r4.c \ +$(srcdir)/generated/spacing_r8.c \ +$(srcdir)/generated/spacing_r10.c \ +$(srcdir)/generated/spacing_r16.c + +i_rrspacing_c = \ +$(srcdir)/generated/rrspacing_r4.c \ +$(srcdir)/generated/rrspacing_r8.c \ +$(srcdir)/generated/rrspacing_r10.c \ +$(srcdir)/generated/rrspacing_r16.c + +i_fraction_c = \ +$(srcdir)/generated/fraction_r4.c \ +$(srcdir)/generated/fraction_r8.c \ +$(srcdir)/generated/fraction_r10.c \ +$(srcdir)/generated/fraction_r16.c + +i_nearest_c = \ +$(srcdir)/generated/nearest_r4.c \ +$(srcdir)/generated/nearest_r8.c \ +$(srcdir)/generated/nearest_r10.c \ +$(srcdir)/generated/nearest_r16.c + +i_set_exponent_c = \ +$(srcdir)/generated/set_exponent_r4.c \ +$(srcdir)/generated/set_exponent_r8.c \ +$(srcdir)/generated/set_exponent_r10.c \ +$(srcdir)/generated/set_exponent_r16.c + +i_pow_c = \ +$(srcdir)/generated/pow_i4_i4.c \ +$(srcdir)/generated/pow_i8_i4.c \ +$(srcdir)/generated/pow_i16_i4.c \ +$(srcdir)/generated/pow_r16_i4.c \ +$(srcdir)/generated/pow_c4_i4.c \ +$(srcdir)/generated/pow_c8_i4.c \ +$(srcdir)/generated/pow_c10_i4.c \ +$(srcdir)/generated/pow_c16_i4.c \ +$(srcdir)/generated/pow_i4_i8.c \ +$(srcdir)/generated/pow_i8_i8.c \ +$(srcdir)/generated/pow_i16_i8.c \ +$(srcdir)/generated/pow_r4_i8.c \ +$(srcdir)/generated/pow_r8_i8.c \ +$(srcdir)/generated/pow_r10_i8.c \ +$(srcdir)/generated/pow_r16_i8.c \ +$(srcdir)/generated/pow_c4_i8.c \ +$(srcdir)/generated/pow_c8_i8.c \ +$(srcdir)/generated/pow_c10_i8.c \ +$(srcdir)/generated/pow_c16_i8.c \ +$(srcdir)/generated/pow_i4_i16.c \ +$(srcdir)/generated/pow_i8_i16.c \ +$(srcdir)/generated/pow_i16_i16.c \ +$(srcdir)/generated/pow_r4_i16.c \ +$(srcdir)/generated/pow_r8_i16.c \ +$(srcdir)/generated/pow_r10_i16.c \ +$(srcdir)/generated/pow_r16_i16.c \ +$(srcdir)/generated/pow_c4_i16.c \ +$(srcdir)/generated/pow_c8_i16.c \ +$(srcdir)/generated/pow_c10_i16.c \ +$(srcdir)/generated/pow_c16_i16.c + +i_pack_c = \ +$(srcdir)/generated/pack_i1.c \ +$(srcdir)/generated/pack_i2.c \ +$(srcdir)/generated/pack_i4.c \ +$(srcdir)/generated/pack_i8.c \ +$(srcdir)/generated/pack_i16.c \ +$(srcdir)/generated/pack_r4.c \ +$(srcdir)/generated/pack_r8.c \ +$(srcdir)/generated/pack_r10.c \ +$(srcdir)/generated/pack_r16.c \ +$(srcdir)/generated/pack_c4.c \ +$(srcdir)/generated/pack_c8.c \ +$(srcdir)/generated/pack_c10.c \ +$(srcdir)/generated/pack_c16.c + +i_unpack_c = \ +$(srcdir)/generated/unpack_i1.c \ +$(srcdir)/generated/unpack_i2.c \ +$(srcdir)/generated/unpack_i4.c \ +$(srcdir)/generated/unpack_i8.c \ +$(srcdir)/generated/unpack_i16.c \ +$(srcdir)/generated/unpack_r4.c \ +$(srcdir)/generated/unpack_r8.c \ +$(srcdir)/generated/unpack_r10.c \ +$(srcdir)/generated/unpack_r16.c \ +$(srcdir)/generated/unpack_c4.c \ +$(srcdir)/generated/unpack_c8.c \ +$(srcdir)/generated/unpack_c10.c \ +$(srcdir)/generated/unpack_c16.c + +i_spread_c = \ +$(srcdir)/generated/spread_i1.c \ +$(srcdir)/generated/spread_i2.c \ +$(srcdir)/generated/spread_i4.c \ +$(srcdir)/generated/spread_i8.c \ +$(srcdir)/generated/spread_i16.c \ +$(srcdir)/generated/spread_r4.c \ +$(srcdir)/generated/spread_r8.c \ +$(srcdir)/generated/spread_r10.c \ +$(srcdir)/generated/spread_r16.c \ +$(srcdir)/generated/spread_c4.c \ +$(srcdir)/generated/spread_c8.c \ +$(srcdir)/generated/spread_c10.c \ +$(srcdir)/generated/spread_c16.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 \ + m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \ + m4/matmul.m4 m4/matmull.m4 m4/ifunction_logical.m4 \ + m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \ + m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \ + m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \ + m4/fraction.m4 m4/nearest.m4 m4/set_exponent.m4 m4/pow.m4 \ + m4/misc_specifics.m4 m4/rrspacing.m4 m4/spacing.m4 m4/pack.m4 \ + m4/unpack.m4 m4/spread.m4 m4/bessel.m4 m4/norm2.m4 m4/parity.m4 \ + m4/iall.m4 m4/iany.m4 m4/iparity.m4 + +gfor_built_src = $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \ + $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \ + $(i_product_c) $(i_sum_c) $(i_bessel_c) $(i_iall_c) $(i_iany_c) \ + $(i_iparity_c) $(i_norm2_c) $(i_parity_c) \ + $(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \ + $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \ + $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \ + $(i_pow_c) $(i_rrspacing_c) $(i_spacing_c) $(i_pack_c) $(i_unpack_c) \ + $(i_spread_c) selected_int_kind.inc selected_real_kind.inc kinds.h \ + $(i_cshift0_c) kinds.inc c99_protos.inc fpu-target.h + + +# Machine generated specifics +gfor_built_specific_src = \ +$(srcdir)/generated/_abs_c4.F90 \ +$(srcdir)/generated/_abs_c8.F90 \ +$(srcdir)/generated/_abs_c10.F90 \ +$(srcdir)/generated/_abs_c16.F90 \ +$(srcdir)/generated/_abs_i4.F90 \ +$(srcdir)/generated/_abs_i8.F90 \ +$(srcdir)/generated/_abs_i16.F90 \ +$(srcdir)/generated/_abs_r4.F90 \ +$(srcdir)/generated/_abs_r8.F90 \ +$(srcdir)/generated/_abs_r10.F90 \ +$(srcdir)/generated/_abs_r16.F90 \ +$(srcdir)/generated/_aimag_c4.F90 \ +$(srcdir)/generated/_aimag_c8.F90 \ +$(srcdir)/generated/_aimag_c10.F90 \ +$(srcdir)/generated/_aimag_c16.F90 \ +$(srcdir)/generated/_exp_r4.F90 \ +$(srcdir)/generated/_exp_r8.F90 \ +$(srcdir)/generated/_exp_r10.F90 \ +$(srcdir)/generated/_exp_r16.F90 \ +$(srcdir)/generated/_exp_c4.F90 \ +$(srcdir)/generated/_exp_c8.F90 \ +$(srcdir)/generated/_exp_c10.F90 \ +$(srcdir)/generated/_exp_c16.F90 \ +$(srcdir)/generated/_log_r4.F90 \ +$(srcdir)/generated/_log_r8.F90 \ +$(srcdir)/generated/_log_r10.F90 \ +$(srcdir)/generated/_log_r16.F90 \ +$(srcdir)/generated/_log_c4.F90 \ +$(srcdir)/generated/_log_c8.F90 \ +$(srcdir)/generated/_log_c10.F90 \ +$(srcdir)/generated/_log_c16.F90 \ +$(srcdir)/generated/_log10_r4.F90 \ +$(srcdir)/generated/_log10_r8.F90 \ +$(srcdir)/generated/_log10_r10.F90 \ +$(srcdir)/generated/_log10_r16.F90 \ +$(srcdir)/generated/_sqrt_r4.F90 \ +$(srcdir)/generated/_sqrt_r8.F90 \ +$(srcdir)/generated/_sqrt_r10.F90 \ +$(srcdir)/generated/_sqrt_r16.F90 \ +$(srcdir)/generated/_sqrt_c4.F90 \ +$(srcdir)/generated/_sqrt_c8.F90 \ +$(srcdir)/generated/_sqrt_c10.F90 \ +$(srcdir)/generated/_sqrt_c16.F90 \ +$(srcdir)/generated/_asin_r4.F90 \ +$(srcdir)/generated/_asin_r8.F90 \ +$(srcdir)/generated/_asin_r10.F90 \ +$(srcdir)/generated/_asin_r16.F90 \ +$(srcdir)/generated/_asinh_r4.F90 \ +$(srcdir)/generated/_asinh_r8.F90 \ +$(srcdir)/generated/_asinh_r10.F90 \ +$(srcdir)/generated/_asinh_r16.F90 \ +$(srcdir)/generated/_acos_r4.F90 \ +$(srcdir)/generated/_acos_r8.F90 \ +$(srcdir)/generated/_acos_r10.F90 \ +$(srcdir)/generated/_acos_r16.F90 \ +$(srcdir)/generated/_acosh_r4.F90 \ +$(srcdir)/generated/_acosh_r8.F90 \ +$(srcdir)/generated/_acosh_r10.F90 \ +$(srcdir)/generated/_acosh_r16.F90 \ +$(srcdir)/generated/_atan_r4.F90 \ +$(srcdir)/generated/_atan_r8.F90 \ +$(srcdir)/generated/_atan_r10.F90 \ +$(srcdir)/generated/_atan_r16.F90 \ +$(srcdir)/generated/_atanh_r4.F90 \ +$(srcdir)/generated/_atanh_r8.F90 \ +$(srcdir)/generated/_atanh_r10.F90 \ +$(srcdir)/generated/_atanh_r16.F90 \ +$(srcdir)/generated/_sin_r4.F90 \ +$(srcdir)/generated/_sin_r8.F90 \ +$(srcdir)/generated/_sin_r10.F90 \ +$(srcdir)/generated/_sin_r16.F90 \ +$(srcdir)/generated/_sin_c4.F90 \ +$(srcdir)/generated/_sin_c8.F90 \ +$(srcdir)/generated/_sin_c10.F90 \ +$(srcdir)/generated/_sin_c16.F90 \ +$(srcdir)/generated/_cos_r4.F90 \ +$(srcdir)/generated/_cos_r8.F90 \ +$(srcdir)/generated/_cos_r10.F90 \ +$(srcdir)/generated/_cos_r16.F90 \ +$(srcdir)/generated/_cos_c4.F90 \ +$(srcdir)/generated/_cos_c8.F90 \ +$(srcdir)/generated/_cos_c10.F90 \ +$(srcdir)/generated/_cos_c16.F90 \ +$(srcdir)/generated/_tan_r4.F90 \ +$(srcdir)/generated/_tan_r8.F90 \ +$(srcdir)/generated/_tan_r10.F90 \ +$(srcdir)/generated/_tan_r16.F90 \ +$(srcdir)/generated/_sinh_r4.F90 \ +$(srcdir)/generated/_sinh_r8.F90 \ +$(srcdir)/generated/_sinh_r10.F90 \ +$(srcdir)/generated/_sinh_r16.F90 \ +$(srcdir)/generated/_cosh_r4.F90 \ +$(srcdir)/generated/_cosh_r8.F90 \ +$(srcdir)/generated/_cosh_r10.F90 \ +$(srcdir)/generated/_cosh_r16.F90 \ +$(srcdir)/generated/_tanh_r4.F90 \ +$(srcdir)/generated/_tanh_r8.F90 \ +$(srcdir)/generated/_tanh_r10.F90 \ +$(srcdir)/generated/_tanh_r16.F90 \ +$(srcdir)/generated/_conjg_c4.F90 \ +$(srcdir)/generated/_conjg_c8.F90 \ +$(srcdir)/generated/_conjg_c10.F90 \ +$(srcdir)/generated/_conjg_c16.F90 \ +$(srcdir)/generated/_aint_r4.F90 \ +$(srcdir)/generated/_aint_r8.F90 \ +$(srcdir)/generated/_aint_r10.F90 \ +$(srcdir)/generated/_aint_r16.F90 \ +$(srcdir)/generated/_anint_r4.F90 \ +$(srcdir)/generated/_anint_r8.F90 \ +$(srcdir)/generated/_anint_r10.F90 \ +$(srcdir)/generated/_anint_r16.F90 + +gfor_built_specific2_src = \ +$(srcdir)/generated/_sign_i4.F90 \ +$(srcdir)/generated/_sign_i8.F90 \ +$(srcdir)/generated/_sign_i16.F90 \ +$(srcdir)/generated/_sign_r4.F90 \ +$(srcdir)/generated/_sign_r8.F90 \ +$(srcdir)/generated/_sign_r10.F90 \ +$(srcdir)/generated/_sign_r16.F90 \ +$(srcdir)/generated/_dim_i4.F90 \ +$(srcdir)/generated/_dim_i8.F90 \ +$(srcdir)/generated/_dim_i16.F90 \ +$(srcdir)/generated/_dim_r4.F90 \ +$(srcdir)/generated/_dim_r8.F90 \ +$(srcdir)/generated/_dim_r10.F90 \ +$(srcdir)/generated/_dim_r16.F90 \ +$(srcdir)/generated/_atan2_r4.F90 \ +$(srcdir)/generated/_atan2_r8.F90 \ +$(srcdir)/generated/_atan2_r10.F90 \ +$(srcdir)/generated/_atan2_r16.F90 \ +$(srcdir)/generated/_mod_i4.F90 \ +$(srcdir)/generated/_mod_i8.F90 \ +$(srcdir)/generated/_mod_i16.F90 \ +$(srcdir)/generated/_mod_r4.F90 \ +$(srcdir)/generated/_mod_r8.F90 \ +$(srcdir)/generated/_mod_r10.F90 \ +$(srcdir)/generated/_mod_r16.F90 + +gfor_misc_specifics = $(srcdir)/generated/misc_specifics.F90 +gfor_specific_src = \ +$(gfor_built_specific_src) \ +$(gfor_built_specific2_src) \ +$(gfor_misc_specifics) \ +intrinsics/dprod_r8.f90 \ +intrinsics/f2c_specifics.F90 + +BUILT_SOURCES = $(gfor_built_src) $(gfor_built_specific_src) \ + $(gfor_built_specific2_src) $(gfor_misc_specifics) \ + $(am__append_1) +prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \ + $(gfor_helper_src) $(gfor_io_headers) $(gfor_specific_src) + +@onestep_FALSE@libgfortran_la_SOURCES = $(prereq_SRC) + +#libgfortran_f.o: $(filter %.f %.f90,$(prereq_SRC)) +# $(FCCOMPILE) -c $^ -o $@ -combine + +#libgfortran_f.lo: $(filter %.f %.f90,$(prereq_SRC)) +# $(LTFCCOMPILE) -c -o $@ $^ -combine +# not currently used: +#libgfortran_F.o: $(filter %.F %.F90,$(prereq_SRC)) +# $(PPFCCOMPILE) -c $^ -o $@ -combine +# +#libgfortran_F.lo: +# $(LTPPFCCOMPILE) -c -o $@ $^ -combine +@onestep_TRUE@libgfortran_la_SOURCES = libgfortran_c.c $(filter-out %.c,$(prereq_SRC)) +I_M4_DEPS = m4/iparm.m4 +I_M4_DEPS0 = $(I_M4_DEPS) m4/iforeach.m4 +I_M4_DEPS1 = $(I_M4_DEPS) m4/ifunction.m4 +I_M4_DEPS2 = $(I_M4_DEPS) m4/ifunction_logical.m4 +EXTRA_DIST = $(m4_files) +all: $(BUILT_SOURCES) config.h + $(MAKE) $(AM_MAKEFLAGS) all-am + +.SUFFIXES: +.SUFFIXES: .F90 .c .f90 .lo .o .obj +am--refresh: + @: +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + echo ' cd $(srcdir) && $(AUTOMAKE) --foreign'; \ + $(am__cd) $(srcdir) && $(AUTOMAKE) --foreign \ + && exit 0; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + echo ' $(SHELL) ./config.status'; \ + $(SHELL) ./config.status;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + $(SHELL) ./config.status --recheck + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + $(am__cd) $(srcdir) && $(AUTOCONF) +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + $(am__cd) $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS) +$(am__aclocal_m4_deps): + +config.h: stamp-h1 + @if test ! -f $@; then \ + rm -f stamp-h1; \ + $(MAKE) $(AM_MAKEFLAGS) stamp-h1; \ + else :; fi + +stamp-h1: $(srcdir)/config.h.in $(top_builddir)/config.status + @rm -f stamp-h1 + cd $(top_builddir) && $(SHELL) ./config.status config.h +$(srcdir)/config.h.in: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + ($(am__cd) $(top_srcdir) && $(AUTOHEADER)) + rm -f stamp-h1 + touch $@ + +distclean-hdr: + -rm -f config.h stamp-h1 +libgfortran.spec: $(top_builddir)/config.status $(srcdir)/libgfortran.spec.in + cd $(top_builddir) && $(SHELL) ./config.status $@ +install-myexeclibLTLIBRARIES: $(myexeclib_LTLIBRARIES) + @$(NORMAL_INSTALL) + test -z "$(myexeclibdir)" || $(MKDIR_P) "$(DESTDIR)$(myexeclibdir)" + @list='$(myexeclib_LTLIBRARIES)'; test -n "$(myexeclibdir)" || list=; \ + list2=; for p in $$list; do \ + if test -f $$p; then \ + list2="$$list2 $$p"; \ + else :; fi; \ + done; \ + test -z "$$list2" || { \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(myexeclibdir)'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(myexeclibdir)"; \ + } + +uninstall-myexeclibLTLIBRARIES: + @$(NORMAL_UNINSTALL) + @list='$(myexeclib_LTLIBRARIES)'; test -n "$(myexeclibdir)" || list=; \ + for p in $$list; do \ + $(am__strip_dir) \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(myexeclibdir)/$$f'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(myexeclibdir)/$$f"; \ + done + +clean-myexeclibLTLIBRARIES: + -test -z "$(myexeclib_LTLIBRARIES)" || rm -f $(myexeclib_LTLIBRARIES) + @list='$(myexeclib_LTLIBRARIES)'; for p in $$list; do \ + dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \ + test "$$dir" != "$$p" || dir=.; \ + echo "rm -f \"$${dir}/so_locations\""; \ + rm -f "$${dir}/so_locations"; \ + done +install-toolexeclibLTLIBRARIES: $(toolexeclib_LTLIBRARIES) + @$(NORMAL_INSTALL) + test -z "$(toolexeclibdir)" || $(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" + @list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \ + list2=; for p in $$list; do \ + if test -f $$p; then \ + list2="$$list2 $$p"; \ + else :; fi; \ + done; \ + test -z "$$list2" || { \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(toolexeclibdir)'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(toolexeclibdir)"; \ + } + +uninstall-toolexeclibLTLIBRARIES: + @$(NORMAL_UNINSTALL) + @list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \ + for p in $$list; do \ + $(am__strip_dir) \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(toolexeclibdir)/$$f'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(toolexeclibdir)/$$f"; \ + done + +clean-toolexeclibLTLIBRARIES: + -test -z "$(toolexeclib_LTLIBRARIES)" || rm -f $(toolexeclib_LTLIBRARIES) + @list='$(toolexeclib_LTLIBRARIES)'; for p in $$list; do \ + dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \ + test "$$dir" != "$$p" || dir=.; \ + echo "rm -f \"$${dir}/so_locations\""; \ + rm -f "$${dir}/so_locations"; \ + done +libgfortran.la: $(libgfortran_la_OBJECTS) $(libgfortran_la_DEPENDENCIES) + $(libgfortran_la_LINK) -rpath $(toolexeclibdir) $(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD) $(LIBS) +libgfortranbegin.la: $(libgfortranbegin_la_OBJECTS) $(libgfortranbegin_la_DEPENDENCIES) + $(libgfortranbegin_la_LINK) -rpath $(myexeclibdir) $(libgfortranbegin_la_OBJECTS) $(libgfortranbegin_la_LIBADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/abort.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/access.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/all_l8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/args.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/associated.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/backtrace.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bessel_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bessel_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bessel_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bessel_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bit_intrinsics.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bounds.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c99_functions.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chdir.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chmod.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/clock.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/close.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/compile_options.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/convert_char.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_16_l.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_1_l.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_2_l.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_4_l.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/count_8_l.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cpu_time.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift0_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cshift1_8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ctime.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/date_and_time.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtime.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/env.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/environ.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift0.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift1_16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift1_4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift1_8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eoshift3_8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/erfc_scaled.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/error.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/etime.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/execute_command_line.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exit.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/extends_type_of.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fbuf.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/file_pos.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fmain.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fnum.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/format.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fpu.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fraction_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fraction_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fraction_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fraction_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gerror.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getXid.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getcwd.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getlog.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/hostnm.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iall_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iany_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ierrno.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_generic.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_pack_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_generic.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/in_unpack_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/inquire.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/intrinsics.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iparity_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ishftc.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iso_c_binding.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/iso_c_generated_procs.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/kill.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libgfortran_c.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/link.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/list_read.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lock.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/main.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/malloc.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_l16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_l4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_l8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/matmul_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_16_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_4_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc0_8_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_16_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_4_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxloc1_8_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/maxval_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/memory.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_16_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_4_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc0_8_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_16_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_4_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minloc1_8_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/minval_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/move_alloc.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mvbits.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/nearest_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/nearest_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/nearest_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/nearest_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/norm2_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/norm2_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/norm2_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/norm2_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/open.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_generic.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pack_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/parity_l1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/parity_l16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/parity_l2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/parity_l4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/parity_l8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pause.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/perror.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c10_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c10_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c10_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c16_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c16_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c16_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c4_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c4_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c4_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c8_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c8_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_c8_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_i16_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_i16_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_i16_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_i4_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_i4_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_i4_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_i8_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_i8_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_i8_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_r10_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_r10_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_r16_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_r16_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_r16_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_r4_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_r4_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_r8_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pow_r8_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/product_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rand.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/random.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/read.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rename.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_generic.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_packed.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reshape_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rrspacing_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rrspacing_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rrspacing_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rrspacing_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/select.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/selected_char_kind.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/shape_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/shape_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/shape_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/signal.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/size.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/size_from_kind.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sleep.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spacing_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spacing_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spacing_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spacing_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_generic.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spread_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stop.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/string.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/string_intrinsics.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sum_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/symlnk.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/system.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/system_clock.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/time.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transfer.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transfer128.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_generic.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/transpose_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/umask.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unit.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unix.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unlink.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_c10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_c16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_c4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_c8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_generic.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_i1.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_i16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_i2.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_i4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_i8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_r10.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_r16.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_r4.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unpack_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/write.Plo@am__quote@ + +.F90.o: + $(PPFCCOMPILE) -c -o $@ $< + +.F90.obj: + $(PPFCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.F90.lo: + $(LTPPFCCOMPILE) -c -o $@ $< + +_abs_c4.lo: $(srcdir)/generated/_abs_c4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c4.lo `test -f '$(srcdir)/generated/_abs_c4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_c4.F90 + +_abs_c8.lo: $(srcdir)/generated/_abs_c8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c8.lo `test -f '$(srcdir)/generated/_abs_c8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_c8.F90 + +_abs_c10.lo: $(srcdir)/generated/_abs_c10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c10.lo `test -f '$(srcdir)/generated/_abs_c10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_c10.F90 + +_abs_c16.lo: $(srcdir)/generated/_abs_c16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_c16.lo `test -f '$(srcdir)/generated/_abs_c16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_c16.F90 + +_abs_i4.lo: $(srcdir)/generated/_abs_i4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i4.lo `test -f '$(srcdir)/generated/_abs_i4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_i4.F90 + +_abs_i8.lo: $(srcdir)/generated/_abs_i8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i8.lo `test -f '$(srcdir)/generated/_abs_i8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_i8.F90 + +_abs_i16.lo: $(srcdir)/generated/_abs_i16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_i16.lo `test -f '$(srcdir)/generated/_abs_i16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_i16.F90 + +_abs_r4.lo: $(srcdir)/generated/_abs_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r4.lo `test -f '$(srcdir)/generated/_abs_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_r4.F90 + +_abs_r8.lo: $(srcdir)/generated/_abs_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r8.lo `test -f '$(srcdir)/generated/_abs_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_r8.F90 + +_abs_r10.lo: $(srcdir)/generated/_abs_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r10.lo `test -f '$(srcdir)/generated/_abs_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_r10.F90 + +_abs_r16.lo: $(srcdir)/generated/_abs_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _abs_r16.lo `test -f '$(srcdir)/generated/_abs_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_abs_r16.F90 + +_aimag_c4.lo: $(srcdir)/generated/_aimag_c4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aimag_c4.lo `test -f '$(srcdir)/generated/_aimag_c4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_aimag_c4.F90 + +_aimag_c8.lo: $(srcdir)/generated/_aimag_c8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aimag_c8.lo `test -f '$(srcdir)/generated/_aimag_c8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_aimag_c8.F90 + +_aimag_c10.lo: $(srcdir)/generated/_aimag_c10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aimag_c10.lo `test -f '$(srcdir)/generated/_aimag_c10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_aimag_c10.F90 + +_aimag_c16.lo: $(srcdir)/generated/_aimag_c16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aimag_c16.lo `test -f '$(srcdir)/generated/_aimag_c16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_aimag_c16.F90 + +_exp_r4.lo: $(srcdir)/generated/_exp_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r4.lo `test -f '$(srcdir)/generated/_exp_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_exp_r4.F90 + +_exp_r8.lo: $(srcdir)/generated/_exp_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r8.lo `test -f '$(srcdir)/generated/_exp_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_exp_r8.F90 + +_exp_r10.lo: $(srcdir)/generated/_exp_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r10.lo `test -f '$(srcdir)/generated/_exp_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_exp_r10.F90 + +_exp_r16.lo: $(srcdir)/generated/_exp_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_r16.lo `test -f '$(srcdir)/generated/_exp_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_exp_r16.F90 + +_exp_c4.lo: $(srcdir)/generated/_exp_c4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c4.lo `test -f '$(srcdir)/generated/_exp_c4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_exp_c4.F90 + +_exp_c8.lo: $(srcdir)/generated/_exp_c8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c8.lo `test -f '$(srcdir)/generated/_exp_c8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_exp_c8.F90 + +_exp_c10.lo: $(srcdir)/generated/_exp_c10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c10.lo `test -f '$(srcdir)/generated/_exp_c10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_exp_c10.F90 + +_exp_c16.lo: $(srcdir)/generated/_exp_c16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _exp_c16.lo `test -f '$(srcdir)/generated/_exp_c16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_exp_c16.F90 + +_log_r4.lo: $(srcdir)/generated/_log_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r4.lo `test -f '$(srcdir)/generated/_log_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log_r4.F90 + +_log_r8.lo: $(srcdir)/generated/_log_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r8.lo `test -f '$(srcdir)/generated/_log_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log_r8.F90 + +_log_r10.lo: $(srcdir)/generated/_log_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r10.lo `test -f '$(srcdir)/generated/_log_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log_r10.F90 + +_log_r16.lo: $(srcdir)/generated/_log_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_r16.lo `test -f '$(srcdir)/generated/_log_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log_r16.F90 + +_log_c4.lo: $(srcdir)/generated/_log_c4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c4.lo `test -f '$(srcdir)/generated/_log_c4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log_c4.F90 + +_log_c8.lo: $(srcdir)/generated/_log_c8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c8.lo `test -f '$(srcdir)/generated/_log_c8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log_c8.F90 + +_log_c10.lo: $(srcdir)/generated/_log_c10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c10.lo `test -f '$(srcdir)/generated/_log_c10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log_c10.F90 + +_log_c16.lo: $(srcdir)/generated/_log_c16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log_c16.lo `test -f '$(srcdir)/generated/_log_c16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log_c16.F90 + +_log10_r4.lo: $(srcdir)/generated/_log10_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r4.lo `test -f '$(srcdir)/generated/_log10_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log10_r4.F90 + +_log10_r8.lo: $(srcdir)/generated/_log10_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r8.lo `test -f '$(srcdir)/generated/_log10_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log10_r8.F90 + +_log10_r10.lo: $(srcdir)/generated/_log10_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r10.lo `test -f '$(srcdir)/generated/_log10_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log10_r10.F90 + +_log10_r16.lo: $(srcdir)/generated/_log10_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _log10_r16.lo `test -f '$(srcdir)/generated/_log10_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_log10_r16.F90 + +_sqrt_r4.lo: $(srcdir)/generated/_sqrt_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r4.lo `test -f '$(srcdir)/generated/_sqrt_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sqrt_r4.F90 + +_sqrt_r8.lo: $(srcdir)/generated/_sqrt_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r8.lo `test -f '$(srcdir)/generated/_sqrt_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sqrt_r8.F90 + +_sqrt_r10.lo: $(srcdir)/generated/_sqrt_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r10.lo `test -f '$(srcdir)/generated/_sqrt_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sqrt_r10.F90 + +_sqrt_r16.lo: $(srcdir)/generated/_sqrt_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_r16.lo `test -f '$(srcdir)/generated/_sqrt_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sqrt_r16.F90 + +_sqrt_c4.lo: $(srcdir)/generated/_sqrt_c4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c4.lo `test -f '$(srcdir)/generated/_sqrt_c4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sqrt_c4.F90 + +_sqrt_c8.lo: $(srcdir)/generated/_sqrt_c8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c8.lo `test -f '$(srcdir)/generated/_sqrt_c8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sqrt_c8.F90 + +_sqrt_c10.lo: $(srcdir)/generated/_sqrt_c10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c10.lo `test -f '$(srcdir)/generated/_sqrt_c10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sqrt_c10.F90 + +_sqrt_c16.lo: $(srcdir)/generated/_sqrt_c16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sqrt_c16.lo `test -f '$(srcdir)/generated/_sqrt_c16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sqrt_c16.F90 + +_asin_r4.lo: $(srcdir)/generated/_asin_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r4.lo `test -f '$(srcdir)/generated/_asin_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_asin_r4.F90 + +_asin_r8.lo: $(srcdir)/generated/_asin_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r8.lo `test -f '$(srcdir)/generated/_asin_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_asin_r8.F90 + +_asin_r10.lo: $(srcdir)/generated/_asin_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r10.lo `test -f '$(srcdir)/generated/_asin_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_asin_r10.F90 + +_asin_r16.lo: $(srcdir)/generated/_asin_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asin_r16.lo `test -f '$(srcdir)/generated/_asin_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_asin_r16.F90 + +_asinh_r4.lo: $(srcdir)/generated/_asinh_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asinh_r4.lo `test -f '$(srcdir)/generated/_asinh_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_asinh_r4.F90 + +_asinh_r8.lo: $(srcdir)/generated/_asinh_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asinh_r8.lo `test -f '$(srcdir)/generated/_asinh_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_asinh_r8.F90 + +_asinh_r10.lo: $(srcdir)/generated/_asinh_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asinh_r10.lo `test -f '$(srcdir)/generated/_asinh_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_asinh_r10.F90 + +_asinh_r16.lo: $(srcdir)/generated/_asinh_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _asinh_r16.lo `test -f '$(srcdir)/generated/_asinh_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_asinh_r16.F90 + +_acos_r4.lo: $(srcdir)/generated/_acos_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r4.lo `test -f '$(srcdir)/generated/_acos_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_acos_r4.F90 + +_acos_r8.lo: $(srcdir)/generated/_acos_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r8.lo `test -f '$(srcdir)/generated/_acos_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_acos_r8.F90 + +_acos_r10.lo: $(srcdir)/generated/_acos_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r10.lo `test -f '$(srcdir)/generated/_acos_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_acos_r10.F90 + +_acos_r16.lo: $(srcdir)/generated/_acos_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acos_r16.lo `test -f '$(srcdir)/generated/_acos_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_acos_r16.F90 + +_acosh_r4.lo: $(srcdir)/generated/_acosh_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acosh_r4.lo `test -f '$(srcdir)/generated/_acosh_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_acosh_r4.F90 + +_acosh_r8.lo: $(srcdir)/generated/_acosh_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acosh_r8.lo `test -f '$(srcdir)/generated/_acosh_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_acosh_r8.F90 + +_acosh_r10.lo: $(srcdir)/generated/_acosh_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acosh_r10.lo `test -f '$(srcdir)/generated/_acosh_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_acosh_r10.F90 + +_acosh_r16.lo: $(srcdir)/generated/_acosh_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _acosh_r16.lo `test -f '$(srcdir)/generated/_acosh_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_acosh_r16.F90 + +_atan_r4.lo: $(srcdir)/generated/_atan_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r4.lo `test -f '$(srcdir)/generated/_atan_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atan_r4.F90 + +_atan_r8.lo: $(srcdir)/generated/_atan_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r8.lo `test -f '$(srcdir)/generated/_atan_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atan_r8.F90 + +_atan_r10.lo: $(srcdir)/generated/_atan_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r10.lo `test -f '$(srcdir)/generated/_atan_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atan_r10.F90 + +_atan_r16.lo: $(srcdir)/generated/_atan_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan_r16.lo `test -f '$(srcdir)/generated/_atan_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atan_r16.F90 + +_atanh_r4.lo: $(srcdir)/generated/_atanh_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atanh_r4.lo `test -f '$(srcdir)/generated/_atanh_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atanh_r4.F90 + +_atanh_r8.lo: $(srcdir)/generated/_atanh_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atanh_r8.lo `test -f '$(srcdir)/generated/_atanh_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atanh_r8.F90 + +_atanh_r10.lo: $(srcdir)/generated/_atanh_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atanh_r10.lo `test -f '$(srcdir)/generated/_atanh_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atanh_r10.F90 + +_atanh_r16.lo: $(srcdir)/generated/_atanh_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atanh_r16.lo `test -f '$(srcdir)/generated/_atanh_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atanh_r16.F90 + +_sin_r4.lo: $(srcdir)/generated/_sin_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r4.lo `test -f '$(srcdir)/generated/_sin_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sin_r4.F90 + +_sin_r8.lo: $(srcdir)/generated/_sin_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r8.lo `test -f '$(srcdir)/generated/_sin_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sin_r8.F90 + +_sin_r10.lo: $(srcdir)/generated/_sin_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r10.lo `test -f '$(srcdir)/generated/_sin_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sin_r10.F90 + +_sin_r16.lo: $(srcdir)/generated/_sin_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_r16.lo `test -f '$(srcdir)/generated/_sin_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sin_r16.F90 + +_sin_c4.lo: $(srcdir)/generated/_sin_c4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c4.lo `test -f '$(srcdir)/generated/_sin_c4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sin_c4.F90 + +_sin_c8.lo: $(srcdir)/generated/_sin_c8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c8.lo `test -f '$(srcdir)/generated/_sin_c8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sin_c8.F90 + +_sin_c10.lo: $(srcdir)/generated/_sin_c10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c10.lo `test -f '$(srcdir)/generated/_sin_c10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sin_c10.F90 + +_sin_c16.lo: $(srcdir)/generated/_sin_c16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sin_c16.lo `test -f '$(srcdir)/generated/_sin_c16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sin_c16.F90 + +_cos_r4.lo: $(srcdir)/generated/_cos_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r4.lo `test -f '$(srcdir)/generated/_cos_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cos_r4.F90 + +_cos_r8.lo: $(srcdir)/generated/_cos_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r8.lo `test -f '$(srcdir)/generated/_cos_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cos_r8.F90 + +_cos_r10.lo: $(srcdir)/generated/_cos_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r10.lo `test -f '$(srcdir)/generated/_cos_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cos_r10.F90 + +_cos_r16.lo: $(srcdir)/generated/_cos_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_r16.lo `test -f '$(srcdir)/generated/_cos_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cos_r16.F90 + +_cos_c4.lo: $(srcdir)/generated/_cos_c4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c4.lo `test -f '$(srcdir)/generated/_cos_c4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cos_c4.F90 + +_cos_c8.lo: $(srcdir)/generated/_cos_c8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c8.lo `test -f '$(srcdir)/generated/_cos_c8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cos_c8.F90 + +_cos_c10.lo: $(srcdir)/generated/_cos_c10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c10.lo `test -f '$(srcdir)/generated/_cos_c10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cos_c10.F90 + +_cos_c16.lo: $(srcdir)/generated/_cos_c16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cos_c16.lo `test -f '$(srcdir)/generated/_cos_c16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cos_c16.F90 + +_tan_r4.lo: $(srcdir)/generated/_tan_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r4.lo `test -f '$(srcdir)/generated/_tan_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_tan_r4.F90 + +_tan_r8.lo: $(srcdir)/generated/_tan_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r8.lo `test -f '$(srcdir)/generated/_tan_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_tan_r8.F90 + +_tan_r10.lo: $(srcdir)/generated/_tan_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r10.lo `test -f '$(srcdir)/generated/_tan_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_tan_r10.F90 + +_tan_r16.lo: $(srcdir)/generated/_tan_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tan_r16.lo `test -f '$(srcdir)/generated/_tan_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_tan_r16.F90 + +_sinh_r4.lo: $(srcdir)/generated/_sinh_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r4.lo `test -f '$(srcdir)/generated/_sinh_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sinh_r4.F90 + +_sinh_r8.lo: $(srcdir)/generated/_sinh_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r8.lo `test -f '$(srcdir)/generated/_sinh_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sinh_r8.F90 + +_sinh_r10.lo: $(srcdir)/generated/_sinh_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r10.lo `test -f '$(srcdir)/generated/_sinh_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sinh_r10.F90 + +_sinh_r16.lo: $(srcdir)/generated/_sinh_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sinh_r16.lo `test -f '$(srcdir)/generated/_sinh_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sinh_r16.F90 + +_cosh_r4.lo: $(srcdir)/generated/_cosh_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r4.lo `test -f '$(srcdir)/generated/_cosh_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cosh_r4.F90 + +_cosh_r8.lo: $(srcdir)/generated/_cosh_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r8.lo `test -f '$(srcdir)/generated/_cosh_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cosh_r8.F90 + +_cosh_r10.lo: $(srcdir)/generated/_cosh_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r10.lo `test -f '$(srcdir)/generated/_cosh_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cosh_r10.F90 + +_cosh_r16.lo: $(srcdir)/generated/_cosh_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _cosh_r16.lo `test -f '$(srcdir)/generated/_cosh_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_cosh_r16.F90 + +_tanh_r4.lo: $(srcdir)/generated/_tanh_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r4.lo `test -f '$(srcdir)/generated/_tanh_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_tanh_r4.F90 + +_tanh_r8.lo: $(srcdir)/generated/_tanh_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r8.lo `test -f '$(srcdir)/generated/_tanh_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_tanh_r8.F90 + +_tanh_r10.lo: $(srcdir)/generated/_tanh_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r10.lo `test -f '$(srcdir)/generated/_tanh_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_tanh_r10.F90 + +_tanh_r16.lo: $(srcdir)/generated/_tanh_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _tanh_r16.lo `test -f '$(srcdir)/generated/_tanh_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_tanh_r16.F90 + +_conjg_c4.lo: $(srcdir)/generated/_conjg_c4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c4.lo `test -f '$(srcdir)/generated/_conjg_c4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_conjg_c4.F90 + +_conjg_c8.lo: $(srcdir)/generated/_conjg_c8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c8.lo `test -f '$(srcdir)/generated/_conjg_c8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_conjg_c8.F90 + +_conjg_c10.lo: $(srcdir)/generated/_conjg_c10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c10.lo `test -f '$(srcdir)/generated/_conjg_c10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_conjg_c10.F90 + +_conjg_c16.lo: $(srcdir)/generated/_conjg_c16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _conjg_c16.lo `test -f '$(srcdir)/generated/_conjg_c16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_conjg_c16.F90 + +_aint_r4.lo: $(srcdir)/generated/_aint_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r4.lo `test -f '$(srcdir)/generated/_aint_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_aint_r4.F90 + +_aint_r8.lo: $(srcdir)/generated/_aint_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r8.lo `test -f '$(srcdir)/generated/_aint_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_aint_r8.F90 + +_aint_r10.lo: $(srcdir)/generated/_aint_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r10.lo `test -f '$(srcdir)/generated/_aint_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_aint_r10.F90 + +_aint_r16.lo: $(srcdir)/generated/_aint_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _aint_r16.lo `test -f '$(srcdir)/generated/_aint_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_aint_r16.F90 + +_anint_r4.lo: $(srcdir)/generated/_anint_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r4.lo `test -f '$(srcdir)/generated/_anint_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_anint_r4.F90 + +_anint_r8.lo: $(srcdir)/generated/_anint_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r8.lo `test -f '$(srcdir)/generated/_anint_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_anint_r8.F90 + +_anint_r10.lo: $(srcdir)/generated/_anint_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r10.lo `test -f '$(srcdir)/generated/_anint_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_anint_r10.F90 + +_anint_r16.lo: $(srcdir)/generated/_anint_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _anint_r16.lo `test -f '$(srcdir)/generated/_anint_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_anint_r16.F90 + +_sign_i4.lo: $(srcdir)/generated/_sign_i4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i4.lo `test -f '$(srcdir)/generated/_sign_i4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sign_i4.F90 + +_sign_i8.lo: $(srcdir)/generated/_sign_i8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i8.lo `test -f '$(srcdir)/generated/_sign_i8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sign_i8.F90 + +_sign_i16.lo: $(srcdir)/generated/_sign_i16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_i16.lo `test -f '$(srcdir)/generated/_sign_i16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sign_i16.F90 + +_sign_r4.lo: $(srcdir)/generated/_sign_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r4.lo `test -f '$(srcdir)/generated/_sign_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sign_r4.F90 + +_sign_r8.lo: $(srcdir)/generated/_sign_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r8.lo `test -f '$(srcdir)/generated/_sign_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sign_r8.F90 + +_sign_r10.lo: $(srcdir)/generated/_sign_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r10.lo `test -f '$(srcdir)/generated/_sign_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sign_r10.F90 + +_sign_r16.lo: $(srcdir)/generated/_sign_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _sign_r16.lo `test -f '$(srcdir)/generated/_sign_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_sign_r16.F90 + +_dim_i4.lo: $(srcdir)/generated/_dim_i4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i4.lo `test -f '$(srcdir)/generated/_dim_i4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_dim_i4.F90 + +_dim_i8.lo: $(srcdir)/generated/_dim_i8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i8.lo `test -f '$(srcdir)/generated/_dim_i8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_dim_i8.F90 + +_dim_i16.lo: $(srcdir)/generated/_dim_i16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_i16.lo `test -f '$(srcdir)/generated/_dim_i16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_dim_i16.F90 + +_dim_r4.lo: $(srcdir)/generated/_dim_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r4.lo `test -f '$(srcdir)/generated/_dim_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_dim_r4.F90 + +_dim_r8.lo: $(srcdir)/generated/_dim_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r8.lo `test -f '$(srcdir)/generated/_dim_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_dim_r8.F90 + +_dim_r10.lo: $(srcdir)/generated/_dim_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r10.lo `test -f '$(srcdir)/generated/_dim_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_dim_r10.F90 + +_dim_r16.lo: $(srcdir)/generated/_dim_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _dim_r16.lo `test -f '$(srcdir)/generated/_dim_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_dim_r16.F90 + +_atan2_r4.lo: $(srcdir)/generated/_atan2_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r4.lo `test -f '$(srcdir)/generated/_atan2_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atan2_r4.F90 + +_atan2_r8.lo: $(srcdir)/generated/_atan2_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r8.lo `test -f '$(srcdir)/generated/_atan2_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atan2_r8.F90 + +_atan2_r10.lo: $(srcdir)/generated/_atan2_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r10.lo `test -f '$(srcdir)/generated/_atan2_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atan2_r10.F90 + +_atan2_r16.lo: $(srcdir)/generated/_atan2_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _atan2_r16.lo `test -f '$(srcdir)/generated/_atan2_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_atan2_r16.F90 + +_mod_i4.lo: $(srcdir)/generated/_mod_i4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i4.lo `test -f '$(srcdir)/generated/_mod_i4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_mod_i4.F90 + +_mod_i8.lo: $(srcdir)/generated/_mod_i8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i8.lo `test -f '$(srcdir)/generated/_mod_i8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_mod_i8.F90 + +_mod_i16.lo: $(srcdir)/generated/_mod_i16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_i16.lo `test -f '$(srcdir)/generated/_mod_i16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_mod_i16.F90 + +_mod_r4.lo: $(srcdir)/generated/_mod_r4.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r4.lo `test -f '$(srcdir)/generated/_mod_r4.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_mod_r4.F90 + +_mod_r8.lo: $(srcdir)/generated/_mod_r8.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r8.lo `test -f '$(srcdir)/generated/_mod_r8.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_mod_r8.F90 + +_mod_r10.lo: $(srcdir)/generated/_mod_r10.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r10.lo `test -f '$(srcdir)/generated/_mod_r10.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_mod_r10.F90 + +_mod_r16.lo: $(srcdir)/generated/_mod_r16.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o _mod_r16.lo `test -f '$(srcdir)/generated/_mod_r16.F90' || echo '$(srcdir)/'`$(srcdir)/generated/_mod_r16.F90 + +misc_specifics.lo: $(srcdir)/generated/misc_specifics.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_FCFLAGS) $(FCFLAGS) -c -o misc_specifics.lo `test -f '$(srcdir)/generated/misc_specifics.F90' || echo '$(srcdir)/'`$(srcdir)/generated/misc_specifics.F90 + +f2c_specifics.lo: intrinsics/f2c_specifics.F90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --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 + +.c.o: +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(COMPILE) -c $< + +.c.obj: +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'` + +.c.lo: +@am__fastdepCC_TRUE@ $(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $< + +backtrace.lo: runtime/backtrace.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT backtrace.lo -MD -MP -MF $(DEPDIR)/backtrace.Tpo -c -o backtrace.lo `test -f 'runtime/backtrace.c' || echo '$(srcdir)/'`runtime/backtrace.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/backtrace.Tpo $(DEPDIR)/backtrace.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/backtrace.c' object='backtrace.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o backtrace.lo `test -f 'runtime/backtrace.c' || echo '$(srcdir)/'`runtime/backtrace.c + +bounds.lo: runtime/bounds.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT bounds.lo -MD -MP -MF $(DEPDIR)/bounds.Tpo -c -o bounds.lo `test -f 'runtime/bounds.c' || echo '$(srcdir)/'`runtime/bounds.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/bounds.Tpo $(DEPDIR)/bounds.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/bounds.c' object='bounds.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bounds.lo `test -f 'runtime/bounds.c' || echo '$(srcdir)/'`runtime/bounds.c + +compile_options.lo: runtime/compile_options.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT compile_options.lo -MD -MP -MF $(DEPDIR)/compile_options.Tpo -c -o compile_options.lo `test -f 'runtime/compile_options.c' || echo '$(srcdir)/'`runtime/compile_options.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/compile_options.Tpo $(DEPDIR)/compile_options.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/compile_options.c' object='compile_options.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o compile_options.lo `test -f 'runtime/compile_options.c' || echo '$(srcdir)/'`runtime/compile_options.c + +convert_char.lo: runtime/convert_char.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT convert_char.lo -MD -MP -MF $(DEPDIR)/convert_char.Tpo -c -o convert_char.lo `test -f 'runtime/convert_char.c' || echo '$(srcdir)/'`runtime/convert_char.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/convert_char.Tpo $(DEPDIR)/convert_char.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/convert_char.c' object='convert_char.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o convert_char.lo `test -f 'runtime/convert_char.c' || echo '$(srcdir)/'`runtime/convert_char.c + +environ.lo: runtime/environ.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT environ.lo -MD -MP -MF $(DEPDIR)/environ.Tpo -c -o environ.lo `test -f 'runtime/environ.c' || echo '$(srcdir)/'`runtime/environ.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/environ.Tpo $(DEPDIR)/environ.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/environ.c' object='environ.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o environ.lo `test -f 'runtime/environ.c' || echo '$(srcdir)/'`runtime/environ.c + +error.lo: runtime/error.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT error.lo -MD -MP -MF $(DEPDIR)/error.Tpo -c -o error.lo `test -f 'runtime/error.c' || echo '$(srcdir)/'`runtime/error.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/error.Tpo $(DEPDIR)/error.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/error.c' object='error.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o error.lo `test -f 'runtime/error.c' || echo '$(srcdir)/'`runtime/error.c + +fpu.lo: runtime/fpu.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fpu.lo -MD -MP -MF $(DEPDIR)/fpu.Tpo -c -o fpu.lo `test -f 'runtime/fpu.c' || echo '$(srcdir)/'`runtime/fpu.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/fpu.Tpo $(DEPDIR)/fpu.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/fpu.c' object='fpu.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fpu.lo `test -f 'runtime/fpu.c' || echo '$(srcdir)/'`runtime/fpu.c + +main.lo: runtime/main.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT main.lo -MD -MP -MF $(DEPDIR)/main.Tpo -c -o main.lo `test -f 'runtime/main.c' || echo '$(srcdir)/'`runtime/main.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/main.Tpo $(DEPDIR)/main.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/main.c' object='main.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o main.lo `test -f 'runtime/main.c' || echo '$(srcdir)/'`runtime/main.c + +memory.lo: runtime/memory.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT memory.lo -MD -MP -MF $(DEPDIR)/memory.Tpo -c -o memory.lo `test -f 'runtime/memory.c' || echo '$(srcdir)/'`runtime/memory.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/memory.Tpo $(DEPDIR)/memory.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/memory.c' object='memory.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o memory.lo `test -f 'runtime/memory.c' || echo '$(srcdir)/'`runtime/memory.c + +pause.lo: runtime/pause.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pause.lo -MD -MP -MF $(DEPDIR)/pause.Tpo -c -o pause.lo `test -f 'runtime/pause.c' || echo '$(srcdir)/'`runtime/pause.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pause.Tpo $(DEPDIR)/pause.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/pause.c' object='pause.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pause.lo `test -f 'runtime/pause.c' || echo '$(srcdir)/'`runtime/pause.c + +stop.lo: runtime/stop.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT stop.lo -MD -MP -MF $(DEPDIR)/stop.Tpo -c -o stop.lo `test -f 'runtime/stop.c' || echo '$(srcdir)/'`runtime/stop.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/stop.Tpo $(DEPDIR)/stop.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/stop.c' object='stop.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o stop.lo `test -f 'runtime/stop.c' || echo '$(srcdir)/'`runtime/stop.c + +string.lo: runtime/string.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT string.lo -MD -MP -MF $(DEPDIR)/string.Tpo -c -o string.lo `test -f 'runtime/string.c' || echo '$(srcdir)/'`runtime/string.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/string.Tpo $(DEPDIR)/string.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/string.c' object='string.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o string.lo `test -f 'runtime/string.c' || echo '$(srcdir)/'`runtime/string.c + +select.lo: runtime/select.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT select.lo -MD -MP -MF $(DEPDIR)/select.Tpo -c -o select.lo `test -f 'runtime/select.c' || echo '$(srcdir)/'`runtime/select.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/select.Tpo $(DEPDIR)/select.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/select.c' object='select.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o select.lo `test -f 'runtime/select.c' || echo '$(srcdir)/'`runtime/select.c + +all_l1.lo: $(srcdir)/generated/all_l1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l1.lo -MD -MP -MF $(DEPDIR)/all_l1.Tpo -c -o all_l1.lo `test -f '$(srcdir)/generated/all_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/all_l1.Tpo $(DEPDIR)/all_l1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/all_l1.c' object='all_l1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l1.lo `test -f '$(srcdir)/generated/all_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l1.c + +all_l2.lo: $(srcdir)/generated/all_l2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l2.lo -MD -MP -MF $(DEPDIR)/all_l2.Tpo -c -o all_l2.lo `test -f '$(srcdir)/generated/all_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/all_l2.Tpo $(DEPDIR)/all_l2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/all_l2.c' object='all_l2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l2.lo `test -f '$(srcdir)/generated/all_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l2.c + +all_l4.lo: $(srcdir)/generated/all_l4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l4.lo -MD -MP -MF $(DEPDIR)/all_l4.Tpo -c -o all_l4.lo `test -f '$(srcdir)/generated/all_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/all_l4.Tpo $(DEPDIR)/all_l4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/all_l4.c' object='all_l4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l4.lo `test -f '$(srcdir)/generated/all_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l4.c + +all_l8.lo: $(srcdir)/generated/all_l8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l8.lo -MD -MP -MF $(DEPDIR)/all_l8.Tpo -c -o all_l8.lo `test -f '$(srcdir)/generated/all_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/all_l8.Tpo $(DEPDIR)/all_l8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/all_l8.c' object='all_l8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l8.lo `test -f '$(srcdir)/generated/all_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l8.c + +all_l16.lo: $(srcdir)/generated/all_l16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT all_l16.lo -MD -MP -MF $(DEPDIR)/all_l16.Tpo -c -o all_l16.lo `test -f '$(srcdir)/generated/all_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/all_l16.Tpo $(DEPDIR)/all_l16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/all_l16.c' object='all_l16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o all_l16.lo `test -f '$(srcdir)/generated/all_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/all_l16.c + +any_l1.lo: $(srcdir)/generated/any_l1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l1.lo -MD -MP -MF $(DEPDIR)/any_l1.Tpo -c -o any_l1.lo `test -f '$(srcdir)/generated/any_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/any_l1.Tpo $(DEPDIR)/any_l1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/any_l1.c' object='any_l1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l1.lo `test -f '$(srcdir)/generated/any_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l1.c + +any_l2.lo: $(srcdir)/generated/any_l2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l2.lo -MD -MP -MF $(DEPDIR)/any_l2.Tpo -c -o any_l2.lo `test -f '$(srcdir)/generated/any_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/any_l2.Tpo $(DEPDIR)/any_l2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/any_l2.c' object='any_l2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l2.lo `test -f '$(srcdir)/generated/any_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l2.c + +any_l4.lo: $(srcdir)/generated/any_l4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l4.lo -MD -MP -MF $(DEPDIR)/any_l4.Tpo -c -o any_l4.lo `test -f '$(srcdir)/generated/any_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/any_l4.Tpo $(DEPDIR)/any_l4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/any_l4.c' object='any_l4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l4.lo `test -f '$(srcdir)/generated/any_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l4.c + +any_l8.lo: $(srcdir)/generated/any_l8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l8.lo -MD -MP -MF $(DEPDIR)/any_l8.Tpo -c -o any_l8.lo `test -f '$(srcdir)/generated/any_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/any_l8.Tpo $(DEPDIR)/any_l8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/any_l8.c' object='any_l8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l8.lo `test -f '$(srcdir)/generated/any_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l8.c + +any_l16.lo: $(srcdir)/generated/any_l16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT any_l16.lo -MD -MP -MF $(DEPDIR)/any_l16.Tpo -c -o any_l16.lo `test -f '$(srcdir)/generated/any_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/any_l16.Tpo $(DEPDIR)/any_l16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/any_l16.c' object='any_l16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o any_l16.lo `test -f '$(srcdir)/generated/any_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/any_l16.c + +count_1_l.lo: $(srcdir)/generated/count_1_l.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_1_l.lo -MD -MP -MF $(DEPDIR)/count_1_l.Tpo -c -o count_1_l.lo `test -f '$(srcdir)/generated/count_1_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_1_l.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/count_1_l.Tpo $(DEPDIR)/count_1_l.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/count_1_l.c' object='count_1_l.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_1_l.lo `test -f '$(srcdir)/generated/count_1_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_1_l.c + +count_2_l.lo: $(srcdir)/generated/count_2_l.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_2_l.lo -MD -MP -MF $(DEPDIR)/count_2_l.Tpo -c -o count_2_l.lo `test -f '$(srcdir)/generated/count_2_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_2_l.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/count_2_l.Tpo $(DEPDIR)/count_2_l.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/count_2_l.c' object='count_2_l.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_2_l.lo `test -f '$(srcdir)/generated/count_2_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_2_l.c + +count_4_l.lo: $(srcdir)/generated/count_4_l.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_4_l.lo -MD -MP -MF $(DEPDIR)/count_4_l.Tpo -c -o count_4_l.lo `test -f '$(srcdir)/generated/count_4_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/count_4_l.Tpo $(DEPDIR)/count_4_l.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/count_4_l.c' object='count_4_l.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_4_l.lo `test -f '$(srcdir)/generated/count_4_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_4_l.c + +count_8_l.lo: $(srcdir)/generated/count_8_l.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_8_l.lo -MD -MP -MF $(DEPDIR)/count_8_l.Tpo -c -o count_8_l.lo `test -f '$(srcdir)/generated/count_8_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/count_8_l.Tpo $(DEPDIR)/count_8_l.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/count_8_l.c' object='count_8_l.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_8_l.lo `test -f '$(srcdir)/generated/count_8_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_8_l.c + +count_16_l.lo: $(srcdir)/generated/count_16_l.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT count_16_l.lo -MD -MP -MF $(DEPDIR)/count_16_l.Tpo -c -o count_16_l.lo `test -f '$(srcdir)/generated/count_16_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/count_16_l.Tpo $(DEPDIR)/count_16_l.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/count_16_l.c' object='count_16_l.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o count_16_l.lo `test -f '$(srcdir)/generated/count_16_l.c' || echo '$(srcdir)/'`$(srcdir)/generated/count_16_l.c + +maxloc0_4_i1.lo: $(srcdir)/generated/maxloc0_4_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_i1.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_i1.Tpo -c -o maxloc0_4_i1.lo `test -f '$(srcdir)/generated/maxloc0_4_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_i1.Tpo $(DEPDIR)/maxloc0_4_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_i1.c' object='maxloc0_4_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i1.lo `test -f '$(srcdir)/generated/maxloc0_4_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i1.c + +maxloc0_8_i1.lo: $(srcdir)/generated/maxloc0_8_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_i1.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_i1.Tpo -c -o maxloc0_8_i1.lo `test -f '$(srcdir)/generated/maxloc0_8_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_i1.Tpo $(DEPDIR)/maxloc0_8_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_i1.c' object='maxloc0_8_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i1.lo `test -f '$(srcdir)/generated/maxloc0_8_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_i1.c + +maxloc0_16_i1.lo: $(srcdir)/generated/maxloc0_16_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_i1.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_i1.Tpo -c -o maxloc0_16_i1.lo `test -f '$(srcdir)/generated/maxloc0_16_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_i1.Tpo $(DEPDIR)/maxloc0_16_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_i1.c' object='maxloc0_16_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i1.lo `test -f '$(srcdir)/generated/maxloc0_16_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_i1.c + +maxloc0_4_i2.lo: $(srcdir)/generated/maxloc0_4_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_i2.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_i2.Tpo -c -o maxloc0_4_i2.lo `test -f '$(srcdir)/generated/maxloc0_4_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_i2.Tpo $(DEPDIR)/maxloc0_4_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_i2.c' object='maxloc0_4_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i2.lo `test -f '$(srcdir)/generated/maxloc0_4_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i2.c + +maxloc0_8_i2.lo: $(srcdir)/generated/maxloc0_8_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_i2.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_i2.Tpo -c -o maxloc0_8_i2.lo `test -f '$(srcdir)/generated/maxloc0_8_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_i2.Tpo $(DEPDIR)/maxloc0_8_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_i2.c' object='maxloc0_8_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i2.lo `test -f '$(srcdir)/generated/maxloc0_8_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_i2.c + +maxloc0_16_i2.lo: $(srcdir)/generated/maxloc0_16_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_i2.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_i2.Tpo -c -o maxloc0_16_i2.lo `test -f '$(srcdir)/generated/maxloc0_16_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_i2.Tpo $(DEPDIR)/maxloc0_16_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_i2.c' object='maxloc0_16_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i2.lo `test -f '$(srcdir)/generated/maxloc0_16_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_i2.c + +maxloc0_4_i4.lo: $(srcdir)/generated/maxloc0_4_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_i4.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_i4.Tpo -c -o maxloc0_4_i4.lo `test -f '$(srcdir)/generated/maxloc0_4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_i4.Tpo $(DEPDIR)/maxloc0_4_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_i4.c' object='maxloc0_4_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i4.lo `test -f '$(srcdir)/generated/maxloc0_4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i4.c + +maxloc0_8_i4.lo: $(srcdir)/generated/maxloc0_8_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_i4.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_i4.Tpo -c -o maxloc0_8_i4.lo `test -f '$(srcdir)/generated/maxloc0_8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_i4.Tpo $(DEPDIR)/maxloc0_8_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_i4.c' object='maxloc0_8_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i4.lo `test -f '$(srcdir)/generated/maxloc0_8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_i4.c + +maxloc0_16_i4.lo: $(srcdir)/generated/maxloc0_16_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_i4.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_i4.Tpo -c -o maxloc0_16_i4.lo `test -f '$(srcdir)/generated/maxloc0_16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_i4.Tpo $(DEPDIR)/maxloc0_16_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_i4.c' object='maxloc0_16_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i4.lo `test -f '$(srcdir)/generated/maxloc0_16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_i4.c + +maxloc0_4_i8.lo: $(srcdir)/generated/maxloc0_4_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_i8.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_i8.Tpo -c -o maxloc0_4_i8.lo `test -f '$(srcdir)/generated/maxloc0_4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_i8.Tpo $(DEPDIR)/maxloc0_4_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_i8.c' object='maxloc0_4_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i8.lo `test -f '$(srcdir)/generated/maxloc0_4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i8.c + +maxloc0_8_i8.lo: $(srcdir)/generated/maxloc0_8_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_i8.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_i8.Tpo -c -o maxloc0_8_i8.lo `test -f '$(srcdir)/generated/maxloc0_8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_i8.Tpo $(DEPDIR)/maxloc0_8_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_i8.c' object='maxloc0_8_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i8.lo `test -f '$(srcdir)/generated/maxloc0_8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_i8.c + +maxloc0_16_i8.lo: $(srcdir)/generated/maxloc0_16_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_i8.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_i8.Tpo -c -o maxloc0_16_i8.lo `test -f '$(srcdir)/generated/maxloc0_16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_i8.Tpo $(DEPDIR)/maxloc0_16_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_i8.c' object='maxloc0_16_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i8.lo `test -f '$(srcdir)/generated/maxloc0_16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_i8.c + +maxloc0_4_i16.lo: $(srcdir)/generated/maxloc0_4_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_i16.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_i16.Tpo -c -o maxloc0_4_i16.lo `test -f '$(srcdir)/generated/maxloc0_4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_i16.Tpo $(DEPDIR)/maxloc0_4_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_i16.c' object='maxloc0_4_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_i16.lo `test -f '$(srcdir)/generated/maxloc0_4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_i16.c + +maxloc0_8_i16.lo: $(srcdir)/generated/maxloc0_8_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_i16.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_i16.Tpo -c -o maxloc0_8_i16.lo `test -f '$(srcdir)/generated/maxloc0_8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_i16.Tpo $(DEPDIR)/maxloc0_8_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_i16.c' object='maxloc0_8_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_i16.lo `test -f '$(srcdir)/generated/maxloc0_8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_i16.c + +maxloc0_16_i16.lo: $(srcdir)/generated/maxloc0_16_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_i16.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_i16.Tpo -c -o maxloc0_16_i16.lo `test -f '$(srcdir)/generated/maxloc0_16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_i16.Tpo $(DEPDIR)/maxloc0_16_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_i16.c' object='maxloc0_16_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_i16.lo `test -f '$(srcdir)/generated/maxloc0_16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_i16.c + +maxloc0_4_r4.lo: $(srcdir)/generated/maxloc0_4_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_r4.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_r4.Tpo -c -o maxloc0_4_r4.lo `test -f '$(srcdir)/generated/maxloc0_4_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_r4.Tpo $(DEPDIR)/maxloc0_4_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_r4.c' object='maxloc0_4_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r4.lo `test -f '$(srcdir)/generated/maxloc0_4_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_r4.c + +maxloc0_8_r4.lo: $(srcdir)/generated/maxloc0_8_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_r4.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_r4.Tpo -c -o maxloc0_8_r4.lo `test -f '$(srcdir)/generated/maxloc0_8_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_r4.Tpo $(DEPDIR)/maxloc0_8_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_r4.c' object='maxloc0_8_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r4.lo `test -f '$(srcdir)/generated/maxloc0_8_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_r4.c + +maxloc0_16_r4.lo: $(srcdir)/generated/maxloc0_16_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_r4.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_r4.Tpo -c -o maxloc0_16_r4.lo `test -f '$(srcdir)/generated/maxloc0_16_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_r4.Tpo $(DEPDIR)/maxloc0_16_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_r4.c' object='maxloc0_16_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r4.lo `test -f '$(srcdir)/generated/maxloc0_16_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_r4.c + +maxloc0_4_r8.lo: $(srcdir)/generated/maxloc0_4_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_r8.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_r8.Tpo -c -o maxloc0_4_r8.lo `test -f '$(srcdir)/generated/maxloc0_4_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_r8.Tpo $(DEPDIR)/maxloc0_4_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_r8.c' object='maxloc0_4_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r8.lo `test -f '$(srcdir)/generated/maxloc0_4_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_r8.c + +maxloc0_8_r8.lo: $(srcdir)/generated/maxloc0_8_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_r8.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_r8.Tpo -c -o maxloc0_8_r8.lo `test -f '$(srcdir)/generated/maxloc0_8_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_r8.Tpo $(DEPDIR)/maxloc0_8_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_r8.c' object='maxloc0_8_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r8.lo `test -f '$(srcdir)/generated/maxloc0_8_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_r8.c + +maxloc0_16_r8.lo: $(srcdir)/generated/maxloc0_16_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_r8.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_r8.Tpo -c -o maxloc0_16_r8.lo `test -f '$(srcdir)/generated/maxloc0_16_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_r8.Tpo $(DEPDIR)/maxloc0_16_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_r8.c' object='maxloc0_16_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r8.lo `test -f '$(srcdir)/generated/maxloc0_16_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_r8.c + +maxloc0_4_r10.lo: $(srcdir)/generated/maxloc0_4_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_r10.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_r10.Tpo -c -o maxloc0_4_r10.lo `test -f '$(srcdir)/generated/maxloc0_4_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_r10.Tpo $(DEPDIR)/maxloc0_4_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_r10.c' object='maxloc0_4_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r10.lo `test -f '$(srcdir)/generated/maxloc0_4_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_r10.c + +maxloc0_8_r10.lo: $(srcdir)/generated/maxloc0_8_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_r10.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_r10.Tpo -c -o maxloc0_8_r10.lo `test -f '$(srcdir)/generated/maxloc0_8_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_r10.Tpo $(DEPDIR)/maxloc0_8_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_r10.c' object='maxloc0_8_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r10.lo `test -f '$(srcdir)/generated/maxloc0_8_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_r10.c + +maxloc0_16_r10.lo: $(srcdir)/generated/maxloc0_16_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_r10.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_r10.Tpo -c -o maxloc0_16_r10.lo `test -f '$(srcdir)/generated/maxloc0_16_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_r10.Tpo $(DEPDIR)/maxloc0_16_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_r10.c' object='maxloc0_16_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r10.lo `test -f '$(srcdir)/generated/maxloc0_16_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_r10.c + +maxloc0_4_r16.lo: $(srcdir)/generated/maxloc0_4_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_4_r16.lo -MD -MP -MF $(DEPDIR)/maxloc0_4_r16.Tpo -c -o maxloc0_4_r16.lo `test -f '$(srcdir)/generated/maxloc0_4_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_4_r16.Tpo $(DEPDIR)/maxloc0_4_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_4_r16.c' object='maxloc0_4_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_4_r16.lo `test -f '$(srcdir)/generated/maxloc0_4_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_4_r16.c + +maxloc0_8_r16.lo: $(srcdir)/generated/maxloc0_8_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_8_r16.lo -MD -MP -MF $(DEPDIR)/maxloc0_8_r16.Tpo -c -o maxloc0_8_r16.lo `test -f '$(srcdir)/generated/maxloc0_8_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_8_r16.Tpo $(DEPDIR)/maxloc0_8_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_8_r16.c' object='maxloc0_8_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_8_r16.lo `test -f '$(srcdir)/generated/maxloc0_8_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_8_r16.c + +maxloc0_16_r16.lo: $(srcdir)/generated/maxloc0_16_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc0_16_r16.lo -MD -MP -MF $(DEPDIR)/maxloc0_16_r16.Tpo -c -o maxloc0_16_r16.lo `test -f '$(srcdir)/generated/maxloc0_16_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc0_16_r16.Tpo $(DEPDIR)/maxloc0_16_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc0_16_r16.c' object='maxloc0_16_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc0_16_r16.lo `test -f '$(srcdir)/generated/maxloc0_16_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc0_16_r16.c + +maxloc1_4_i1.lo: $(srcdir)/generated/maxloc1_4_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_i1.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_i1.Tpo -c -o maxloc1_4_i1.lo `test -f '$(srcdir)/generated/maxloc1_4_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_i1.Tpo $(DEPDIR)/maxloc1_4_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_i1.c' object='maxloc1_4_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i1.lo `test -f '$(srcdir)/generated/maxloc1_4_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_i1.c + +maxloc1_8_i1.lo: $(srcdir)/generated/maxloc1_8_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_i1.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_i1.Tpo -c -o maxloc1_8_i1.lo `test -f '$(srcdir)/generated/maxloc1_8_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_i1.Tpo $(DEPDIR)/maxloc1_8_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_i1.c' object='maxloc1_8_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i1.lo `test -f '$(srcdir)/generated/maxloc1_8_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_i1.c + +maxloc1_16_i1.lo: $(srcdir)/generated/maxloc1_16_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_i1.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_i1.Tpo -c -o maxloc1_16_i1.lo `test -f '$(srcdir)/generated/maxloc1_16_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_i1.Tpo $(DEPDIR)/maxloc1_16_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_i1.c' object='maxloc1_16_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i1.lo `test -f '$(srcdir)/generated/maxloc1_16_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_i1.c + +maxloc1_4_i2.lo: $(srcdir)/generated/maxloc1_4_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_i2.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_i2.Tpo -c -o maxloc1_4_i2.lo `test -f '$(srcdir)/generated/maxloc1_4_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_i2.Tpo $(DEPDIR)/maxloc1_4_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_i2.c' object='maxloc1_4_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i2.lo `test -f '$(srcdir)/generated/maxloc1_4_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_i2.c + +maxloc1_8_i2.lo: $(srcdir)/generated/maxloc1_8_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_i2.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_i2.Tpo -c -o maxloc1_8_i2.lo `test -f '$(srcdir)/generated/maxloc1_8_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_i2.Tpo $(DEPDIR)/maxloc1_8_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_i2.c' object='maxloc1_8_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i2.lo `test -f '$(srcdir)/generated/maxloc1_8_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_i2.c + +maxloc1_16_i2.lo: $(srcdir)/generated/maxloc1_16_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_i2.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_i2.Tpo -c -o maxloc1_16_i2.lo `test -f '$(srcdir)/generated/maxloc1_16_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_i2.Tpo $(DEPDIR)/maxloc1_16_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_i2.c' object='maxloc1_16_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i2.lo `test -f '$(srcdir)/generated/maxloc1_16_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_i2.c + +maxloc1_4_i4.lo: $(srcdir)/generated/maxloc1_4_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_i4.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_i4.Tpo -c -o maxloc1_4_i4.lo `test -f '$(srcdir)/generated/maxloc1_4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_i4.Tpo $(DEPDIR)/maxloc1_4_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_i4.c' object='maxloc1_4_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i4.lo `test -f '$(srcdir)/generated/maxloc1_4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_i4.c + +maxloc1_8_i4.lo: $(srcdir)/generated/maxloc1_8_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_i4.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_i4.Tpo -c -o maxloc1_8_i4.lo `test -f '$(srcdir)/generated/maxloc1_8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_i4.Tpo $(DEPDIR)/maxloc1_8_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_i4.c' object='maxloc1_8_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i4.lo `test -f '$(srcdir)/generated/maxloc1_8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_i4.c + +maxloc1_16_i4.lo: $(srcdir)/generated/maxloc1_16_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_i4.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_i4.Tpo -c -o maxloc1_16_i4.lo `test -f '$(srcdir)/generated/maxloc1_16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_i4.Tpo $(DEPDIR)/maxloc1_16_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_i4.c' object='maxloc1_16_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i4.lo `test -f '$(srcdir)/generated/maxloc1_16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_i4.c + +maxloc1_4_i8.lo: $(srcdir)/generated/maxloc1_4_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_i8.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_i8.Tpo -c -o maxloc1_4_i8.lo `test -f '$(srcdir)/generated/maxloc1_4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_i8.Tpo $(DEPDIR)/maxloc1_4_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_i8.c' object='maxloc1_4_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i8.lo `test -f '$(srcdir)/generated/maxloc1_4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_i8.c + +maxloc1_8_i8.lo: $(srcdir)/generated/maxloc1_8_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_i8.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_i8.Tpo -c -o maxloc1_8_i8.lo `test -f '$(srcdir)/generated/maxloc1_8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_i8.Tpo $(DEPDIR)/maxloc1_8_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_i8.c' object='maxloc1_8_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i8.lo `test -f '$(srcdir)/generated/maxloc1_8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_i8.c + +maxloc1_16_i8.lo: $(srcdir)/generated/maxloc1_16_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_i8.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_i8.Tpo -c -o maxloc1_16_i8.lo `test -f '$(srcdir)/generated/maxloc1_16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_i8.Tpo $(DEPDIR)/maxloc1_16_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_i8.c' object='maxloc1_16_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i8.lo `test -f '$(srcdir)/generated/maxloc1_16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_i8.c + +maxloc1_4_i16.lo: $(srcdir)/generated/maxloc1_4_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_i16.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_i16.Tpo -c -o maxloc1_4_i16.lo `test -f '$(srcdir)/generated/maxloc1_4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_i16.Tpo $(DEPDIR)/maxloc1_4_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_i16.c' object='maxloc1_4_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_i16.lo `test -f '$(srcdir)/generated/maxloc1_4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_i16.c + +maxloc1_8_i16.lo: $(srcdir)/generated/maxloc1_8_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_i16.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_i16.Tpo -c -o maxloc1_8_i16.lo `test -f '$(srcdir)/generated/maxloc1_8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_i16.Tpo $(DEPDIR)/maxloc1_8_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_i16.c' object='maxloc1_8_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_i16.lo `test -f '$(srcdir)/generated/maxloc1_8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_i16.c + +maxloc1_16_i16.lo: $(srcdir)/generated/maxloc1_16_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_i16.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_i16.Tpo -c -o maxloc1_16_i16.lo `test -f '$(srcdir)/generated/maxloc1_16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_i16.Tpo $(DEPDIR)/maxloc1_16_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_i16.c' object='maxloc1_16_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_i16.lo `test -f '$(srcdir)/generated/maxloc1_16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_i16.c + +maxloc1_4_r4.lo: $(srcdir)/generated/maxloc1_4_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_r4.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_r4.Tpo -c -o maxloc1_4_r4.lo `test -f '$(srcdir)/generated/maxloc1_4_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_r4.Tpo $(DEPDIR)/maxloc1_4_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_r4.c' object='maxloc1_4_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r4.lo `test -f '$(srcdir)/generated/maxloc1_4_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_r4.c + +maxloc1_8_r4.lo: $(srcdir)/generated/maxloc1_8_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_r4.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_r4.Tpo -c -o maxloc1_8_r4.lo `test -f '$(srcdir)/generated/maxloc1_8_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_r4.Tpo $(DEPDIR)/maxloc1_8_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_r4.c' object='maxloc1_8_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r4.lo `test -f '$(srcdir)/generated/maxloc1_8_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_r4.c + +maxloc1_16_r4.lo: $(srcdir)/generated/maxloc1_16_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_r4.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_r4.Tpo -c -o maxloc1_16_r4.lo `test -f '$(srcdir)/generated/maxloc1_16_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_r4.Tpo $(DEPDIR)/maxloc1_16_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_r4.c' object='maxloc1_16_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r4.lo `test -f '$(srcdir)/generated/maxloc1_16_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_r4.c + +maxloc1_4_r8.lo: $(srcdir)/generated/maxloc1_4_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_r8.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_r8.Tpo -c -o maxloc1_4_r8.lo `test -f '$(srcdir)/generated/maxloc1_4_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_r8.Tpo $(DEPDIR)/maxloc1_4_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_r8.c' object='maxloc1_4_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r8.lo `test -f '$(srcdir)/generated/maxloc1_4_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_r8.c + +maxloc1_8_r8.lo: $(srcdir)/generated/maxloc1_8_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_r8.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_r8.Tpo -c -o maxloc1_8_r8.lo `test -f '$(srcdir)/generated/maxloc1_8_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_r8.Tpo $(DEPDIR)/maxloc1_8_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_r8.c' object='maxloc1_8_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r8.lo `test -f '$(srcdir)/generated/maxloc1_8_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_r8.c + +maxloc1_16_r8.lo: $(srcdir)/generated/maxloc1_16_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_r8.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_r8.Tpo -c -o maxloc1_16_r8.lo `test -f '$(srcdir)/generated/maxloc1_16_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_r8.Tpo $(DEPDIR)/maxloc1_16_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_r8.c' object='maxloc1_16_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r8.lo `test -f '$(srcdir)/generated/maxloc1_16_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_r8.c + +maxloc1_4_r10.lo: $(srcdir)/generated/maxloc1_4_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_r10.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_r10.Tpo -c -o maxloc1_4_r10.lo `test -f '$(srcdir)/generated/maxloc1_4_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_r10.Tpo $(DEPDIR)/maxloc1_4_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_r10.c' object='maxloc1_4_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r10.lo `test -f '$(srcdir)/generated/maxloc1_4_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_r10.c + +maxloc1_8_r10.lo: $(srcdir)/generated/maxloc1_8_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_r10.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_r10.Tpo -c -o maxloc1_8_r10.lo `test -f '$(srcdir)/generated/maxloc1_8_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_r10.Tpo $(DEPDIR)/maxloc1_8_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_r10.c' object='maxloc1_8_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r10.lo `test -f '$(srcdir)/generated/maxloc1_8_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_r10.c + +maxloc1_16_r10.lo: $(srcdir)/generated/maxloc1_16_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_r10.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_r10.Tpo -c -o maxloc1_16_r10.lo `test -f '$(srcdir)/generated/maxloc1_16_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_r10.Tpo $(DEPDIR)/maxloc1_16_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_r10.c' object='maxloc1_16_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r10.lo `test -f '$(srcdir)/generated/maxloc1_16_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_r10.c + +maxloc1_4_r16.lo: $(srcdir)/generated/maxloc1_4_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_4_r16.lo -MD -MP -MF $(DEPDIR)/maxloc1_4_r16.Tpo -c -o maxloc1_4_r16.lo `test -f '$(srcdir)/generated/maxloc1_4_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_4_r16.Tpo $(DEPDIR)/maxloc1_4_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_4_r16.c' object='maxloc1_4_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_4_r16.lo `test -f '$(srcdir)/generated/maxloc1_4_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_4_r16.c + +maxloc1_8_r16.lo: $(srcdir)/generated/maxloc1_8_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_8_r16.lo -MD -MP -MF $(DEPDIR)/maxloc1_8_r16.Tpo -c -o maxloc1_8_r16.lo `test -f '$(srcdir)/generated/maxloc1_8_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_8_r16.Tpo $(DEPDIR)/maxloc1_8_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_8_r16.c' object='maxloc1_8_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_8_r16.lo `test -f '$(srcdir)/generated/maxloc1_8_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_8_r16.c + +maxloc1_16_r16.lo: $(srcdir)/generated/maxloc1_16_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxloc1_16_r16.lo -MD -MP -MF $(DEPDIR)/maxloc1_16_r16.Tpo -c -o maxloc1_16_r16.lo `test -f '$(srcdir)/generated/maxloc1_16_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxloc1_16_r16.Tpo $(DEPDIR)/maxloc1_16_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxloc1_16_r16.c' object='maxloc1_16_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxloc1_16_r16.lo `test -f '$(srcdir)/generated/maxloc1_16_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxloc1_16_r16.c + +maxval_i1.lo: $(srcdir)/generated/maxval_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxval_i1.lo -MD -MP -MF $(DEPDIR)/maxval_i1.Tpo -c -o maxval_i1.lo `test -f '$(srcdir)/generated/maxval_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxval_i1.Tpo $(DEPDIR)/maxval_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxval_i1.c' object='maxval_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i1.lo `test -f '$(srcdir)/generated/maxval_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_i1.c + +maxval_i2.lo: $(srcdir)/generated/maxval_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxval_i2.lo -MD -MP -MF $(DEPDIR)/maxval_i2.Tpo -c -o maxval_i2.lo `test -f '$(srcdir)/generated/maxval_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxval_i2.Tpo $(DEPDIR)/maxval_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxval_i2.c' object='maxval_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i2.lo `test -f '$(srcdir)/generated/maxval_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_i2.c + +maxval_i4.lo: $(srcdir)/generated/maxval_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxval_i4.lo -MD -MP -MF $(DEPDIR)/maxval_i4.Tpo -c -o maxval_i4.lo `test -f '$(srcdir)/generated/maxval_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxval_i4.Tpo $(DEPDIR)/maxval_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxval_i4.c' object='maxval_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i4.lo `test -f '$(srcdir)/generated/maxval_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_i4.c + +maxval_i8.lo: $(srcdir)/generated/maxval_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxval_i8.lo -MD -MP -MF $(DEPDIR)/maxval_i8.Tpo -c -o maxval_i8.lo `test -f '$(srcdir)/generated/maxval_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxval_i8.Tpo $(DEPDIR)/maxval_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxval_i8.c' object='maxval_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i8.lo `test -f '$(srcdir)/generated/maxval_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_i8.c + +maxval_i16.lo: $(srcdir)/generated/maxval_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxval_i16.lo -MD -MP -MF $(DEPDIR)/maxval_i16.Tpo -c -o maxval_i16.lo `test -f '$(srcdir)/generated/maxval_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxval_i16.Tpo $(DEPDIR)/maxval_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxval_i16.c' object='maxval_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_i16.lo `test -f '$(srcdir)/generated/maxval_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_i16.c + +maxval_r4.lo: $(srcdir)/generated/maxval_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxval_r4.lo -MD -MP -MF $(DEPDIR)/maxval_r4.Tpo -c -o maxval_r4.lo `test -f '$(srcdir)/generated/maxval_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxval_r4.Tpo $(DEPDIR)/maxval_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxval_r4.c' object='maxval_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r4.lo `test -f '$(srcdir)/generated/maxval_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_r4.c + +maxval_r8.lo: $(srcdir)/generated/maxval_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxval_r8.lo -MD -MP -MF $(DEPDIR)/maxval_r8.Tpo -c -o maxval_r8.lo `test -f '$(srcdir)/generated/maxval_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxval_r8.Tpo $(DEPDIR)/maxval_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxval_r8.c' object='maxval_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r8.lo `test -f '$(srcdir)/generated/maxval_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_r8.c + +maxval_r10.lo: $(srcdir)/generated/maxval_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxval_r10.lo -MD -MP -MF $(DEPDIR)/maxval_r10.Tpo -c -o maxval_r10.lo `test -f '$(srcdir)/generated/maxval_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxval_r10.Tpo $(DEPDIR)/maxval_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxval_r10.c' object='maxval_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r10.lo `test -f '$(srcdir)/generated/maxval_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_r10.c + +maxval_r16.lo: $(srcdir)/generated/maxval_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT maxval_r16.lo -MD -MP -MF $(DEPDIR)/maxval_r16.Tpo -c -o maxval_r16.lo `test -f '$(srcdir)/generated/maxval_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/maxval_r16.Tpo $(DEPDIR)/maxval_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/maxval_r16.c' object='maxval_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o maxval_r16.lo `test -f '$(srcdir)/generated/maxval_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/maxval_r16.c + +minloc0_4_i1.lo: $(srcdir)/generated/minloc0_4_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_i1.lo -MD -MP -MF $(DEPDIR)/minloc0_4_i1.Tpo -c -o minloc0_4_i1.lo `test -f '$(srcdir)/generated/minloc0_4_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_i1.Tpo $(DEPDIR)/minloc0_4_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_i1.c' object='minloc0_4_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i1.lo `test -f '$(srcdir)/generated/minloc0_4_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_i1.c + +minloc0_8_i1.lo: $(srcdir)/generated/minloc0_8_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_i1.lo -MD -MP -MF $(DEPDIR)/minloc0_8_i1.Tpo -c -o minloc0_8_i1.lo `test -f '$(srcdir)/generated/minloc0_8_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_i1.Tpo $(DEPDIR)/minloc0_8_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_i1.c' object='minloc0_8_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i1.lo `test -f '$(srcdir)/generated/minloc0_8_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_i1.c + +minloc0_16_i1.lo: $(srcdir)/generated/minloc0_16_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_i1.lo -MD -MP -MF $(DEPDIR)/minloc0_16_i1.Tpo -c -o minloc0_16_i1.lo `test -f '$(srcdir)/generated/minloc0_16_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_i1.Tpo $(DEPDIR)/minloc0_16_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_i1.c' object='minloc0_16_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i1.lo `test -f '$(srcdir)/generated/minloc0_16_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_i1.c + +minloc0_4_i2.lo: $(srcdir)/generated/minloc0_4_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_i2.lo -MD -MP -MF $(DEPDIR)/minloc0_4_i2.Tpo -c -o minloc0_4_i2.lo `test -f '$(srcdir)/generated/minloc0_4_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_i2.Tpo $(DEPDIR)/minloc0_4_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_i2.c' object='minloc0_4_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i2.lo `test -f '$(srcdir)/generated/minloc0_4_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_i2.c + +minloc0_8_i2.lo: $(srcdir)/generated/minloc0_8_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_i2.lo -MD -MP -MF $(DEPDIR)/minloc0_8_i2.Tpo -c -o minloc0_8_i2.lo `test -f '$(srcdir)/generated/minloc0_8_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_i2.Tpo $(DEPDIR)/minloc0_8_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_i2.c' object='minloc0_8_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i2.lo `test -f '$(srcdir)/generated/minloc0_8_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_i2.c + +minloc0_16_i2.lo: $(srcdir)/generated/minloc0_16_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_i2.lo -MD -MP -MF $(DEPDIR)/minloc0_16_i2.Tpo -c -o minloc0_16_i2.lo `test -f '$(srcdir)/generated/minloc0_16_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_i2.Tpo $(DEPDIR)/minloc0_16_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_i2.c' object='minloc0_16_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i2.lo `test -f '$(srcdir)/generated/minloc0_16_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_i2.c + +minloc0_4_i4.lo: $(srcdir)/generated/minloc0_4_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_i4.lo -MD -MP -MF $(DEPDIR)/minloc0_4_i4.Tpo -c -o minloc0_4_i4.lo `test -f '$(srcdir)/generated/minloc0_4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_i4.Tpo $(DEPDIR)/minloc0_4_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_i4.c' object='minloc0_4_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i4.lo `test -f '$(srcdir)/generated/minloc0_4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_i4.c + +minloc0_8_i4.lo: $(srcdir)/generated/minloc0_8_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_i4.lo -MD -MP -MF $(DEPDIR)/minloc0_8_i4.Tpo -c -o minloc0_8_i4.lo `test -f '$(srcdir)/generated/minloc0_8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_i4.Tpo $(DEPDIR)/minloc0_8_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_i4.c' object='minloc0_8_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i4.lo `test -f '$(srcdir)/generated/minloc0_8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_i4.c + +minloc0_16_i4.lo: $(srcdir)/generated/minloc0_16_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_i4.lo -MD -MP -MF $(DEPDIR)/minloc0_16_i4.Tpo -c -o minloc0_16_i4.lo `test -f '$(srcdir)/generated/minloc0_16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_i4.Tpo $(DEPDIR)/minloc0_16_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_i4.c' object='minloc0_16_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i4.lo `test -f '$(srcdir)/generated/minloc0_16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_i4.c + +minloc0_4_i8.lo: $(srcdir)/generated/minloc0_4_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_i8.lo -MD -MP -MF $(DEPDIR)/minloc0_4_i8.Tpo -c -o minloc0_4_i8.lo `test -f '$(srcdir)/generated/minloc0_4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_i8.Tpo $(DEPDIR)/minloc0_4_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_i8.c' object='minloc0_4_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i8.lo `test -f '$(srcdir)/generated/minloc0_4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_i8.c + +minloc0_8_i8.lo: $(srcdir)/generated/minloc0_8_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_i8.lo -MD -MP -MF $(DEPDIR)/minloc0_8_i8.Tpo -c -o minloc0_8_i8.lo `test -f '$(srcdir)/generated/minloc0_8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_i8.Tpo $(DEPDIR)/minloc0_8_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_i8.c' object='minloc0_8_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i8.lo `test -f '$(srcdir)/generated/minloc0_8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_i8.c + +minloc0_16_i8.lo: $(srcdir)/generated/minloc0_16_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_i8.lo -MD -MP -MF $(DEPDIR)/minloc0_16_i8.Tpo -c -o minloc0_16_i8.lo `test -f '$(srcdir)/generated/minloc0_16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_i8.Tpo $(DEPDIR)/minloc0_16_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_i8.c' object='minloc0_16_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i8.lo `test -f '$(srcdir)/generated/minloc0_16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_i8.c + +minloc0_4_i16.lo: $(srcdir)/generated/minloc0_4_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_i16.lo -MD -MP -MF $(DEPDIR)/minloc0_4_i16.Tpo -c -o minloc0_4_i16.lo `test -f '$(srcdir)/generated/minloc0_4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_i16.Tpo $(DEPDIR)/minloc0_4_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_i16.c' object='minloc0_4_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_i16.lo `test -f '$(srcdir)/generated/minloc0_4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_i16.c + +minloc0_8_i16.lo: $(srcdir)/generated/minloc0_8_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_i16.lo -MD -MP -MF $(DEPDIR)/minloc0_8_i16.Tpo -c -o minloc0_8_i16.lo `test -f '$(srcdir)/generated/minloc0_8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_i16.Tpo $(DEPDIR)/minloc0_8_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_i16.c' object='minloc0_8_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_i16.lo `test -f '$(srcdir)/generated/minloc0_8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_i16.c + +minloc0_16_i16.lo: $(srcdir)/generated/minloc0_16_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_i16.lo -MD -MP -MF $(DEPDIR)/minloc0_16_i16.Tpo -c -o minloc0_16_i16.lo `test -f '$(srcdir)/generated/minloc0_16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_i16.Tpo $(DEPDIR)/minloc0_16_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_i16.c' object='minloc0_16_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_i16.lo `test -f '$(srcdir)/generated/minloc0_16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_i16.c + +minloc0_4_r4.lo: $(srcdir)/generated/minloc0_4_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_r4.lo -MD -MP -MF $(DEPDIR)/minloc0_4_r4.Tpo -c -o minloc0_4_r4.lo `test -f '$(srcdir)/generated/minloc0_4_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_r4.Tpo $(DEPDIR)/minloc0_4_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_r4.c' object='minloc0_4_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r4.lo `test -f '$(srcdir)/generated/minloc0_4_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_r4.c + +minloc0_8_r4.lo: $(srcdir)/generated/minloc0_8_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_r4.lo -MD -MP -MF $(DEPDIR)/minloc0_8_r4.Tpo -c -o minloc0_8_r4.lo `test -f '$(srcdir)/generated/minloc0_8_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_r4.Tpo $(DEPDIR)/minloc0_8_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_r4.c' object='minloc0_8_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r4.lo `test -f '$(srcdir)/generated/minloc0_8_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_r4.c + +minloc0_16_r4.lo: $(srcdir)/generated/minloc0_16_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_r4.lo -MD -MP -MF $(DEPDIR)/minloc0_16_r4.Tpo -c -o minloc0_16_r4.lo `test -f '$(srcdir)/generated/minloc0_16_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_r4.Tpo $(DEPDIR)/minloc0_16_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_r4.c' object='minloc0_16_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r4.lo `test -f '$(srcdir)/generated/minloc0_16_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_r4.c + +minloc0_4_r8.lo: $(srcdir)/generated/minloc0_4_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_r8.lo -MD -MP -MF $(DEPDIR)/minloc0_4_r8.Tpo -c -o minloc0_4_r8.lo `test -f '$(srcdir)/generated/minloc0_4_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_r8.Tpo $(DEPDIR)/minloc0_4_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_r8.c' object='minloc0_4_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r8.lo `test -f '$(srcdir)/generated/minloc0_4_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_r8.c + +minloc0_8_r8.lo: $(srcdir)/generated/minloc0_8_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_r8.lo -MD -MP -MF $(DEPDIR)/minloc0_8_r8.Tpo -c -o minloc0_8_r8.lo `test -f '$(srcdir)/generated/minloc0_8_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_r8.Tpo $(DEPDIR)/minloc0_8_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_r8.c' object='minloc0_8_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r8.lo `test -f '$(srcdir)/generated/minloc0_8_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_r8.c + +minloc0_16_r8.lo: $(srcdir)/generated/minloc0_16_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_r8.lo -MD -MP -MF $(DEPDIR)/minloc0_16_r8.Tpo -c -o minloc0_16_r8.lo `test -f '$(srcdir)/generated/minloc0_16_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_r8.Tpo $(DEPDIR)/minloc0_16_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_r8.c' object='minloc0_16_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r8.lo `test -f '$(srcdir)/generated/minloc0_16_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_r8.c + +minloc0_4_r10.lo: $(srcdir)/generated/minloc0_4_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_r10.lo -MD -MP -MF $(DEPDIR)/minloc0_4_r10.Tpo -c -o minloc0_4_r10.lo `test -f '$(srcdir)/generated/minloc0_4_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_r10.Tpo $(DEPDIR)/minloc0_4_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_r10.c' object='minloc0_4_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r10.lo `test -f '$(srcdir)/generated/minloc0_4_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_r10.c + +minloc0_8_r10.lo: $(srcdir)/generated/minloc0_8_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_r10.lo -MD -MP -MF $(DEPDIR)/minloc0_8_r10.Tpo -c -o minloc0_8_r10.lo `test -f '$(srcdir)/generated/minloc0_8_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_r10.Tpo $(DEPDIR)/minloc0_8_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_r10.c' object='minloc0_8_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r10.lo `test -f '$(srcdir)/generated/minloc0_8_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_r10.c + +minloc0_16_r10.lo: $(srcdir)/generated/minloc0_16_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_r10.lo -MD -MP -MF $(DEPDIR)/minloc0_16_r10.Tpo -c -o minloc0_16_r10.lo `test -f '$(srcdir)/generated/minloc0_16_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_r10.Tpo $(DEPDIR)/minloc0_16_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_r10.c' object='minloc0_16_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r10.lo `test -f '$(srcdir)/generated/minloc0_16_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_r10.c + +minloc0_4_r16.lo: $(srcdir)/generated/minloc0_4_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_4_r16.lo -MD -MP -MF $(DEPDIR)/minloc0_4_r16.Tpo -c -o minloc0_4_r16.lo `test -f '$(srcdir)/generated/minloc0_4_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_4_r16.Tpo $(DEPDIR)/minloc0_4_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_4_r16.c' object='minloc0_4_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_4_r16.lo `test -f '$(srcdir)/generated/minloc0_4_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_4_r16.c + +minloc0_8_r16.lo: $(srcdir)/generated/minloc0_8_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_8_r16.lo -MD -MP -MF $(DEPDIR)/minloc0_8_r16.Tpo -c -o minloc0_8_r16.lo `test -f '$(srcdir)/generated/minloc0_8_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_8_r16.Tpo $(DEPDIR)/minloc0_8_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_8_r16.c' object='minloc0_8_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_8_r16.lo `test -f '$(srcdir)/generated/minloc0_8_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_8_r16.c + +minloc0_16_r16.lo: $(srcdir)/generated/minloc0_16_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc0_16_r16.lo -MD -MP -MF $(DEPDIR)/minloc0_16_r16.Tpo -c -o minloc0_16_r16.lo `test -f '$(srcdir)/generated/minloc0_16_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc0_16_r16.Tpo $(DEPDIR)/minloc0_16_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc0_16_r16.c' object='minloc0_16_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc0_16_r16.lo `test -f '$(srcdir)/generated/minloc0_16_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc0_16_r16.c + +minloc1_4_i1.lo: $(srcdir)/generated/minloc1_4_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_i1.lo -MD -MP -MF $(DEPDIR)/minloc1_4_i1.Tpo -c -o minloc1_4_i1.lo `test -f '$(srcdir)/generated/minloc1_4_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_i1.Tpo $(DEPDIR)/minloc1_4_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_i1.c' object='minloc1_4_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i1.lo `test -f '$(srcdir)/generated/minloc1_4_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_i1.c + +minloc1_8_i1.lo: $(srcdir)/generated/minloc1_8_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_i1.lo -MD -MP -MF $(DEPDIR)/minloc1_8_i1.Tpo -c -o minloc1_8_i1.lo `test -f '$(srcdir)/generated/minloc1_8_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_i1.Tpo $(DEPDIR)/minloc1_8_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_i1.c' object='minloc1_8_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i1.lo `test -f '$(srcdir)/generated/minloc1_8_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_i1.c + +minloc1_16_i1.lo: $(srcdir)/generated/minloc1_16_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_i1.lo -MD -MP -MF $(DEPDIR)/minloc1_16_i1.Tpo -c -o minloc1_16_i1.lo `test -f '$(srcdir)/generated/minloc1_16_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_i1.Tpo $(DEPDIR)/minloc1_16_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_i1.c' object='minloc1_16_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i1.lo `test -f '$(srcdir)/generated/minloc1_16_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_i1.c + +minloc1_4_i2.lo: $(srcdir)/generated/minloc1_4_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_i2.lo -MD -MP -MF $(DEPDIR)/minloc1_4_i2.Tpo -c -o minloc1_4_i2.lo `test -f '$(srcdir)/generated/minloc1_4_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_i2.Tpo $(DEPDIR)/minloc1_4_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_i2.c' object='minloc1_4_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i2.lo `test -f '$(srcdir)/generated/minloc1_4_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_i2.c + +minloc1_8_i2.lo: $(srcdir)/generated/minloc1_8_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_i2.lo -MD -MP -MF $(DEPDIR)/minloc1_8_i2.Tpo -c -o minloc1_8_i2.lo `test -f '$(srcdir)/generated/minloc1_8_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_i2.Tpo $(DEPDIR)/minloc1_8_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_i2.c' object='minloc1_8_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i2.lo `test -f '$(srcdir)/generated/minloc1_8_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_i2.c + +minloc1_16_i2.lo: $(srcdir)/generated/minloc1_16_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_i2.lo -MD -MP -MF $(DEPDIR)/minloc1_16_i2.Tpo -c -o minloc1_16_i2.lo `test -f '$(srcdir)/generated/minloc1_16_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_i2.Tpo $(DEPDIR)/minloc1_16_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_i2.c' object='minloc1_16_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i2.lo `test -f '$(srcdir)/generated/minloc1_16_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_i2.c + +minloc1_4_i4.lo: $(srcdir)/generated/minloc1_4_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_i4.lo -MD -MP -MF $(DEPDIR)/minloc1_4_i4.Tpo -c -o minloc1_4_i4.lo `test -f '$(srcdir)/generated/minloc1_4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_i4.Tpo $(DEPDIR)/minloc1_4_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_i4.c' object='minloc1_4_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i4.lo `test -f '$(srcdir)/generated/minloc1_4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_i4.c + +minloc1_8_i4.lo: $(srcdir)/generated/minloc1_8_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_i4.lo -MD -MP -MF $(DEPDIR)/minloc1_8_i4.Tpo -c -o minloc1_8_i4.lo `test -f '$(srcdir)/generated/minloc1_8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_i4.Tpo $(DEPDIR)/minloc1_8_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_i4.c' object='minloc1_8_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i4.lo `test -f '$(srcdir)/generated/minloc1_8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_i4.c + +minloc1_16_i4.lo: $(srcdir)/generated/minloc1_16_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_i4.lo -MD -MP -MF $(DEPDIR)/minloc1_16_i4.Tpo -c -o minloc1_16_i4.lo `test -f '$(srcdir)/generated/minloc1_16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_i4.Tpo $(DEPDIR)/minloc1_16_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_i4.c' object='minloc1_16_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i4.lo `test -f '$(srcdir)/generated/minloc1_16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_i4.c + +minloc1_4_i8.lo: $(srcdir)/generated/minloc1_4_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_i8.lo -MD -MP -MF $(DEPDIR)/minloc1_4_i8.Tpo -c -o minloc1_4_i8.lo `test -f '$(srcdir)/generated/minloc1_4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_i8.Tpo $(DEPDIR)/minloc1_4_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_i8.c' object='minloc1_4_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i8.lo `test -f '$(srcdir)/generated/minloc1_4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_i8.c + +minloc1_8_i8.lo: $(srcdir)/generated/minloc1_8_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_i8.lo -MD -MP -MF $(DEPDIR)/minloc1_8_i8.Tpo -c -o minloc1_8_i8.lo `test -f '$(srcdir)/generated/minloc1_8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_i8.Tpo $(DEPDIR)/minloc1_8_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_i8.c' object='minloc1_8_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i8.lo `test -f '$(srcdir)/generated/minloc1_8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_i8.c + +minloc1_16_i8.lo: $(srcdir)/generated/minloc1_16_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_i8.lo -MD -MP -MF $(DEPDIR)/minloc1_16_i8.Tpo -c -o minloc1_16_i8.lo `test -f '$(srcdir)/generated/minloc1_16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_i8.Tpo $(DEPDIR)/minloc1_16_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_i8.c' object='minloc1_16_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i8.lo `test -f '$(srcdir)/generated/minloc1_16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_i8.c + +minloc1_4_i16.lo: $(srcdir)/generated/minloc1_4_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_i16.lo -MD -MP -MF $(DEPDIR)/minloc1_4_i16.Tpo -c -o minloc1_4_i16.lo `test -f '$(srcdir)/generated/minloc1_4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_i16.Tpo $(DEPDIR)/minloc1_4_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_i16.c' object='minloc1_4_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_i16.lo `test -f '$(srcdir)/generated/minloc1_4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_i16.c + +minloc1_8_i16.lo: $(srcdir)/generated/minloc1_8_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_i16.lo -MD -MP -MF $(DEPDIR)/minloc1_8_i16.Tpo -c -o minloc1_8_i16.lo `test -f '$(srcdir)/generated/minloc1_8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_i16.Tpo $(DEPDIR)/minloc1_8_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_i16.c' object='minloc1_8_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_i16.lo `test -f '$(srcdir)/generated/minloc1_8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_i16.c + +minloc1_16_i16.lo: $(srcdir)/generated/minloc1_16_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_i16.lo -MD -MP -MF $(DEPDIR)/minloc1_16_i16.Tpo -c -o minloc1_16_i16.lo `test -f '$(srcdir)/generated/minloc1_16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_i16.Tpo $(DEPDIR)/minloc1_16_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_i16.c' object='minloc1_16_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_i16.lo `test -f '$(srcdir)/generated/minloc1_16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_i16.c + +minloc1_4_r4.lo: $(srcdir)/generated/minloc1_4_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_r4.lo -MD -MP -MF $(DEPDIR)/minloc1_4_r4.Tpo -c -o minloc1_4_r4.lo `test -f '$(srcdir)/generated/minloc1_4_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_r4.Tpo $(DEPDIR)/minloc1_4_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_r4.c' object='minloc1_4_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r4.lo `test -f '$(srcdir)/generated/minloc1_4_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_r4.c + +minloc1_8_r4.lo: $(srcdir)/generated/minloc1_8_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_r4.lo -MD -MP -MF $(DEPDIR)/minloc1_8_r4.Tpo -c -o minloc1_8_r4.lo `test -f '$(srcdir)/generated/minloc1_8_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_r4.Tpo $(DEPDIR)/minloc1_8_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_r4.c' object='minloc1_8_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r4.lo `test -f '$(srcdir)/generated/minloc1_8_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_r4.c + +minloc1_16_r4.lo: $(srcdir)/generated/minloc1_16_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_r4.lo -MD -MP -MF $(DEPDIR)/minloc1_16_r4.Tpo -c -o minloc1_16_r4.lo `test -f '$(srcdir)/generated/minloc1_16_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_r4.Tpo $(DEPDIR)/minloc1_16_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_r4.c' object='minloc1_16_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r4.lo `test -f '$(srcdir)/generated/minloc1_16_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_r4.c + +minloc1_4_r8.lo: $(srcdir)/generated/minloc1_4_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_r8.lo -MD -MP -MF $(DEPDIR)/minloc1_4_r8.Tpo -c -o minloc1_4_r8.lo `test -f '$(srcdir)/generated/minloc1_4_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_r8.Tpo $(DEPDIR)/minloc1_4_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_r8.c' object='minloc1_4_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r8.lo `test -f '$(srcdir)/generated/minloc1_4_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_r8.c + +minloc1_8_r8.lo: $(srcdir)/generated/minloc1_8_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_r8.lo -MD -MP -MF $(DEPDIR)/minloc1_8_r8.Tpo -c -o minloc1_8_r8.lo `test -f '$(srcdir)/generated/minloc1_8_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_r8.Tpo $(DEPDIR)/minloc1_8_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_r8.c' object='minloc1_8_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r8.lo `test -f '$(srcdir)/generated/minloc1_8_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_r8.c + +minloc1_16_r8.lo: $(srcdir)/generated/minloc1_16_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_r8.lo -MD -MP -MF $(DEPDIR)/minloc1_16_r8.Tpo -c -o minloc1_16_r8.lo `test -f '$(srcdir)/generated/minloc1_16_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_r8.Tpo $(DEPDIR)/minloc1_16_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_r8.c' object='minloc1_16_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r8.lo `test -f '$(srcdir)/generated/minloc1_16_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_r8.c + +minloc1_4_r10.lo: $(srcdir)/generated/minloc1_4_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_r10.lo -MD -MP -MF $(DEPDIR)/minloc1_4_r10.Tpo -c -o minloc1_4_r10.lo `test -f '$(srcdir)/generated/minloc1_4_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_r10.Tpo $(DEPDIR)/minloc1_4_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_r10.c' object='minloc1_4_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r10.lo `test -f '$(srcdir)/generated/minloc1_4_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_r10.c + +minloc1_8_r10.lo: $(srcdir)/generated/minloc1_8_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_r10.lo -MD -MP -MF $(DEPDIR)/minloc1_8_r10.Tpo -c -o minloc1_8_r10.lo `test -f '$(srcdir)/generated/minloc1_8_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_r10.Tpo $(DEPDIR)/minloc1_8_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_r10.c' object='minloc1_8_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r10.lo `test -f '$(srcdir)/generated/minloc1_8_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_r10.c + +minloc1_16_r10.lo: $(srcdir)/generated/minloc1_16_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_r10.lo -MD -MP -MF $(DEPDIR)/minloc1_16_r10.Tpo -c -o minloc1_16_r10.lo `test -f '$(srcdir)/generated/minloc1_16_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_r10.Tpo $(DEPDIR)/minloc1_16_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_r10.c' object='minloc1_16_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r10.lo `test -f '$(srcdir)/generated/minloc1_16_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_r10.c + +minloc1_4_r16.lo: $(srcdir)/generated/minloc1_4_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_4_r16.lo -MD -MP -MF $(DEPDIR)/minloc1_4_r16.Tpo -c -o minloc1_4_r16.lo `test -f '$(srcdir)/generated/minloc1_4_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_4_r16.Tpo $(DEPDIR)/minloc1_4_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_4_r16.c' object='minloc1_4_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_4_r16.lo `test -f '$(srcdir)/generated/minloc1_4_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_4_r16.c + +minloc1_8_r16.lo: $(srcdir)/generated/minloc1_8_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_8_r16.lo -MD -MP -MF $(DEPDIR)/minloc1_8_r16.Tpo -c -o minloc1_8_r16.lo `test -f '$(srcdir)/generated/minloc1_8_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_8_r16.Tpo $(DEPDIR)/minloc1_8_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_8_r16.c' object='minloc1_8_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_8_r16.lo `test -f '$(srcdir)/generated/minloc1_8_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_8_r16.c + +minloc1_16_r16.lo: $(srcdir)/generated/minloc1_16_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minloc1_16_r16.lo -MD -MP -MF $(DEPDIR)/minloc1_16_r16.Tpo -c -o minloc1_16_r16.lo `test -f '$(srcdir)/generated/minloc1_16_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minloc1_16_r16.Tpo $(DEPDIR)/minloc1_16_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minloc1_16_r16.c' object='minloc1_16_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minloc1_16_r16.lo `test -f '$(srcdir)/generated/minloc1_16_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minloc1_16_r16.c + +minval_i1.lo: $(srcdir)/generated/minval_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minval_i1.lo -MD -MP -MF $(DEPDIR)/minval_i1.Tpo -c -o minval_i1.lo `test -f '$(srcdir)/generated/minval_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minval_i1.Tpo $(DEPDIR)/minval_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minval_i1.c' object='minval_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i1.lo `test -f '$(srcdir)/generated/minval_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_i1.c + +minval_i2.lo: $(srcdir)/generated/minval_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minval_i2.lo -MD -MP -MF $(DEPDIR)/minval_i2.Tpo -c -o minval_i2.lo `test -f '$(srcdir)/generated/minval_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minval_i2.Tpo $(DEPDIR)/minval_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minval_i2.c' object='minval_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i2.lo `test -f '$(srcdir)/generated/minval_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_i2.c + +minval_i4.lo: $(srcdir)/generated/minval_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minval_i4.lo -MD -MP -MF $(DEPDIR)/minval_i4.Tpo -c -o minval_i4.lo `test -f '$(srcdir)/generated/minval_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minval_i4.Tpo $(DEPDIR)/minval_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minval_i4.c' object='minval_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i4.lo `test -f '$(srcdir)/generated/minval_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_i4.c + +minval_i8.lo: $(srcdir)/generated/minval_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minval_i8.lo -MD -MP -MF $(DEPDIR)/minval_i8.Tpo -c -o minval_i8.lo `test -f '$(srcdir)/generated/minval_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minval_i8.Tpo $(DEPDIR)/minval_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minval_i8.c' object='minval_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i8.lo `test -f '$(srcdir)/generated/minval_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_i8.c + +minval_i16.lo: $(srcdir)/generated/minval_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minval_i16.lo -MD -MP -MF $(DEPDIR)/minval_i16.Tpo -c -o minval_i16.lo `test -f '$(srcdir)/generated/minval_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minval_i16.Tpo $(DEPDIR)/minval_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minval_i16.c' object='minval_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_i16.lo `test -f '$(srcdir)/generated/minval_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_i16.c + +minval_r4.lo: $(srcdir)/generated/minval_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minval_r4.lo -MD -MP -MF $(DEPDIR)/minval_r4.Tpo -c -o minval_r4.lo `test -f '$(srcdir)/generated/minval_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minval_r4.Tpo $(DEPDIR)/minval_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minval_r4.c' object='minval_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r4.lo `test -f '$(srcdir)/generated/minval_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_r4.c + +minval_r8.lo: $(srcdir)/generated/minval_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minval_r8.lo -MD -MP -MF $(DEPDIR)/minval_r8.Tpo -c -o minval_r8.lo `test -f '$(srcdir)/generated/minval_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minval_r8.Tpo $(DEPDIR)/minval_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minval_r8.c' object='minval_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r8.lo `test -f '$(srcdir)/generated/minval_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_r8.c + +minval_r10.lo: $(srcdir)/generated/minval_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minval_r10.lo -MD -MP -MF $(DEPDIR)/minval_r10.Tpo -c -o minval_r10.lo `test -f '$(srcdir)/generated/minval_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minval_r10.Tpo $(DEPDIR)/minval_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minval_r10.c' object='minval_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r10.lo `test -f '$(srcdir)/generated/minval_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_r10.c + +minval_r16.lo: $(srcdir)/generated/minval_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT minval_r16.lo -MD -MP -MF $(DEPDIR)/minval_r16.Tpo -c -o minval_r16.lo `test -f '$(srcdir)/generated/minval_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/minval_r16.Tpo $(DEPDIR)/minval_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/minval_r16.c' object='minval_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o minval_r16.lo `test -f '$(srcdir)/generated/minval_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/minval_r16.c + +product_i1.lo: $(srcdir)/generated/product_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_i1.lo -MD -MP -MF $(DEPDIR)/product_i1.Tpo -c -o product_i1.lo `test -f '$(srcdir)/generated/product_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_i1.Tpo $(DEPDIR)/product_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_i1.c' object='product_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i1.lo `test -f '$(srcdir)/generated/product_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_i1.c + +product_i2.lo: $(srcdir)/generated/product_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_i2.lo -MD -MP -MF $(DEPDIR)/product_i2.Tpo -c -o product_i2.lo `test -f '$(srcdir)/generated/product_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_i2.Tpo $(DEPDIR)/product_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_i2.c' object='product_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i2.lo `test -f '$(srcdir)/generated/product_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_i2.c + +product_i4.lo: $(srcdir)/generated/product_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_i4.lo -MD -MP -MF $(DEPDIR)/product_i4.Tpo -c -o product_i4.lo `test -f '$(srcdir)/generated/product_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_i4.Tpo $(DEPDIR)/product_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_i4.c' object='product_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i4.lo `test -f '$(srcdir)/generated/product_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_i4.c + +product_i8.lo: $(srcdir)/generated/product_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_i8.lo -MD -MP -MF $(DEPDIR)/product_i8.Tpo -c -o product_i8.lo `test -f '$(srcdir)/generated/product_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_i8.Tpo $(DEPDIR)/product_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_i8.c' object='product_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i8.lo `test -f '$(srcdir)/generated/product_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_i8.c + +product_i16.lo: $(srcdir)/generated/product_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_i16.lo -MD -MP -MF $(DEPDIR)/product_i16.Tpo -c -o product_i16.lo `test -f '$(srcdir)/generated/product_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_i16.Tpo $(DEPDIR)/product_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_i16.c' object='product_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_i16.lo `test -f '$(srcdir)/generated/product_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_i16.c + +product_r4.lo: $(srcdir)/generated/product_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_r4.lo -MD -MP -MF $(DEPDIR)/product_r4.Tpo -c -o product_r4.lo `test -f '$(srcdir)/generated/product_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_r4.Tpo $(DEPDIR)/product_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_r4.c' object='product_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r4.lo `test -f '$(srcdir)/generated/product_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_r4.c + +product_r8.lo: $(srcdir)/generated/product_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_r8.lo -MD -MP -MF $(DEPDIR)/product_r8.Tpo -c -o product_r8.lo `test -f '$(srcdir)/generated/product_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_r8.Tpo $(DEPDIR)/product_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_r8.c' object='product_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r8.lo `test -f '$(srcdir)/generated/product_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_r8.c + +product_r10.lo: $(srcdir)/generated/product_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_r10.lo -MD -MP -MF $(DEPDIR)/product_r10.Tpo -c -o product_r10.lo `test -f '$(srcdir)/generated/product_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_r10.Tpo $(DEPDIR)/product_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_r10.c' object='product_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r10.lo `test -f '$(srcdir)/generated/product_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_r10.c + +product_r16.lo: $(srcdir)/generated/product_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_r16.lo -MD -MP -MF $(DEPDIR)/product_r16.Tpo -c -o product_r16.lo `test -f '$(srcdir)/generated/product_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_r16.Tpo $(DEPDIR)/product_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_r16.c' object='product_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_r16.lo `test -f '$(srcdir)/generated/product_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_r16.c + +product_c4.lo: $(srcdir)/generated/product_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_c4.lo -MD -MP -MF $(DEPDIR)/product_c4.Tpo -c -o product_c4.lo `test -f '$(srcdir)/generated/product_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_c4.Tpo $(DEPDIR)/product_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_c4.c' object='product_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c4.lo `test -f '$(srcdir)/generated/product_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_c4.c + +product_c8.lo: $(srcdir)/generated/product_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_c8.lo -MD -MP -MF $(DEPDIR)/product_c8.Tpo -c -o product_c8.lo `test -f '$(srcdir)/generated/product_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_c8.Tpo $(DEPDIR)/product_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_c8.c' object='product_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c8.lo `test -f '$(srcdir)/generated/product_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_c8.c + +product_c10.lo: $(srcdir)/generated/product_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_c10.lo -MD -MP -MF $(DEPDIR)/product_c10.Tpo -c -o product_c10.lo `test -f '$(srcdir)/generated/product_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_c10.Tpo $(DEPDIR)/product_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_c10.c' object='product_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c10.lo `test -f '$(srcdir)/generated/product_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_c10.c + +product_c16.lo: $(srcdir)/generated/product_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT product_c16.lo -MD -MP -MF $(DEPDIR)/product_c16.Tpo -c -o product_c16.lo `test -f '$(srcdir)/generated/product_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/product_c16.Tpo $(DEPDIR)/product_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/product_c16.c' object='product_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o product_c16.lo `test -f '$(srcdir)/generated/product_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/product_c16.c + +sum_i1.lo: $(srcdir)/generated/sum_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_i1.lo -MD -MP -MF $(DEPDIR)/sum_i1.Tpo -c -o sum_i1.lo `test -f '$(srcdir)/generated/sum_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_i1.Tpo $(DEPDIR)/sum_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_i1.c' object='sum_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i1.lo `test -f '$(srcdir)/generated/sum_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_i1.c + +sum_i2.lo: $(srcdir)/generated/sum_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_i2.lo -MD -MP -MF $(DEPDIR)/sum_i2.Tpo -c -o sum_i2.lo `test -f '$(srcdir)/generated/sum_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_i2.Tpo $(DEPDIR)/sum_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_i2.c' object='sum_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i2.lo `test -f '$(srcdir)/generated/sum_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_i2.c + +sum_i4.lo: $(srcdir)/generated/sum_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_i4.lo -MD -MP -MF $(DEPDIR)/sum_i4.Tpo -c -o sum_i4.lo `test -f '$(srcdir)/generated/sum_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_i4.Tpo $(DEPDIR)/sum_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_i4.c' object='sum_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i4.lo `test -f '$(srcdir)/generated/sum_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_i4.c + +sum_i8.lo: $(srcdir)/generated/sum_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_i8.lo -MD -MP -MF $(DEPDIR)/sum_i8.Tpo -c -o sum_i8.lo `test -f '$(srcdir)/generated/sum_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_i8.Tpo $(DEPDIR)/sum_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_i8.c' object='sum_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i8.lo `test -f '$(srcdir)/generated/sum_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_i8.c + +sum_i16.lo: $(srcdir)/generated/sum_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_i16.lo -MD -MP -MF $(DEPDIR)/sum_i16.Tpo -c -o sum_i16.lo `test -f '$(srcdir)/generated/sum_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_i16.Tpo $(DEPDIR)/sum_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_i16.c' object='sum_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_i16.lo `test -f '$(srcdir)/generated/sum_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_i16.c + +sum_r4.lo: $(srcdir)/generated/sum_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_r4.lo -MD -MP -MF $(DEPDIR)/sum_r4.Tpo -c -o sum_r4.lo `test -f '$(srcdir)/generated/sum_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_r4.Tpo $(DEPDIR)/sum_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_r4.c' object='sum_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r4.lo `test -f '$(srcdir)/generated/sum_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_r4.c + +sum_r8.lo: $(srcdir)/generated/sum_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_r8.lo -MD -MP -MF $(DEPDIR)/sum_r8.Tpo -c -o sum_r8.lo `test -f '$(srcdir)/generated/sum_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_r8.Tpo $(DEPDIR)/sum_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_r8.c' object='sum_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r8.lo `test -f '$(srcdir)/generated/sum_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_r8.c + +sum_r10.lo: $(srcdir)/generated/sum_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_r10.lo -MD -MP -MF $(DEPDIR)/sum_r10.Tpo -c -o sum_r10.lo `test -f '$(srcdir)/generated/sum_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_r10.Tpo $(DEPDIR)/sum_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_r10.c' object='sum_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r10.lo `test -f '$(srcdir)/generated/sum_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_r10.c + +sum_r16.lo: $(srcdir)/generated/sum_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_r16.lo -MD -MP -MF $(DEPDIR)/sum_r16.Tpo -c -o sum_r16.lo `test -f '$(srcdir)/generated/sum_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_r16.Tpo $(DEPDIR)/sum_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_r16.c' object='sum_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_r16.lo `test -f '$(srcdir)/generated/sum_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_r16.c + +sum_c4.lo: $(srcdir)/generated/sum_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_c4.lo -MD -MP -MF $(DEPDIR)/sum_c4.Tpo -c -o sum_c4.lo `test -f '$(srcdir)/generated/sum_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_c4.Tpo $(DEPDIR)/sum_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_c4.c' object='sum_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c4.lo `test -f '$(srcdir)/generated/sum_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_c4.c + +sum_c8.lo: $(srcdir)/generated/sum_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_c8.lo -MD -MP -MF $(DEPDIR)/sum_c8.Tpo -c -o sum_c8.lo `test -f '$(srcdir)/generated/sum_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_c8.Tpo $(DEPDIR)/sum_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_c8.c' object='sum_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c8.lo `test -f '$(srcdir)/generated/sum_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_c8.c + +sum_c10.lo: $(srcdir)/generated/sum_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_c10.lo -MD -MP -MF $(DEPDIR)/sum_c10.Tpo -c -o sum_c10.lo `test -f '$(srcdir)/generated/sum_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_c10.Tpo $(DEPDIR)/sum_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_c10.c' object='sum_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c10.lo `test -f '$(srcdir)/generated/sum_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_c10.c + +sum_c16.lo: $(srcdir)/generated/sum_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sum_c16.lo -MD -MP -MF $(DEPDIR)/sum_c16.Tpo -c -o sum_c16.lo `test -f '$(srcdir)/generated/sum_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sum_c16.Tpo $(DEPDIR)/sum_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/sum_c16.c' object='sum_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sum_c16.lo `test -f '$(srcdir)/generated/sum_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/sum_c16.c + +bessel_r4.lo: $(srcdir)/generated/bessel_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT bessel_r4.lo -MD -MP -MF $(DEPDIR)/bessel_r4.Tpo -c -o bessel_r4.lo `test -f '$(srcdir)/generated/bessel_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/bessel_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/bessel_r4.Tpo $(DEPDIR)/bessel_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/bessel_r4.c' object='bessel_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bessel_r4.lo `test -f '$(srcdir)/generated/bessel_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/bessel_r4.c + +bessel_r8.lo: $(srcdir)/generated/bessel_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT bessel_r8.lo -MD -MP -MF $(DEPDIR)/bessel_r8.Tpo -c -o bessel_r8.lo `test -f '$(srcdir)/generated/bessel_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/bessel_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/bessel_r8.Tpo $(DEPDIR)/bessel_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/bessel_r8.c' object='bessel_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bessel_r8.lo `test -f '$(srcdir)/generated/bessel_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/bessel_r8.c + +bessel_r10.lo: $(srcdir)/generated/bessel_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT bessel_r10.lo -MD -MP -MF $(DEPDIR)/bessel_r10.Tpo -c -o bessel_r10.lo `test -f '$(srcdir)/generated/bessel_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/bessel_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/bessel_r10.Tpo $(DEPDIR)/bessel_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/bessel_r10.c' object='bessel_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bessel_r10.lo `test -f '$(srcdir)/generated/bessel_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/bessel_r10.c + +bessel_r16.lo: $(srcdir)/generated/bessel_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT bessel_r16.lo -MD -MP -MF $(DEPDIR)/bessel_r16.Tpo -c -o bessel_r16.lo `test -f '$(srcdir)/generated/bessel_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/bessel_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/bessel_r16.Tpo $(DEPDIR)/bessel_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/bessel_r16.c' object='bessel_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bessel_r16.lo `test -f '$(srcdir)/generated/bessel_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/bessel_r16.c + +iall_i1.lo: $(srcdir)/generated/iall_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i1.lo -MD -MP -MF $(DEPDIR)/iall_i1.Tpo -c -o iall_i1.lo `test -f '$(srcdir)/generated/iall_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iall_i1.Tpo $(DEPDIR)/iall_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iall_i1.c' object='iall_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i1.lo `test -f '$(srcdir)/generated/iall_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i1.c + +iall_i2.lo: $(srcdir)/generated/iall_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i2.lo -MD -MP -MF $(DEPDIR)/iall_i2.Tpo -c -o iall_i2.lo `test -f '$(srcdir)/generated/iall_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iall_i2.Tpo $(DEPDIR)/iall_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iall_i2.c' object='iall_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i2.lo `test -f '$(srcdir)/generated/iall_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i2.c + +iall_i4.lo: $(srcdir)/generated/iall_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i4.lo -MD -MP -MF $(DEPDIR)/iall_i4.Tpo -c -o iall_i4.lo `test -f '$(srcdir)/generated/iall_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iall_i4.Tpo $(DEPDIR)/iall_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iall_i4.c' object='iall_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i4.lo `test -f '$(srcdir)/generated/iall_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i4.c + +iall_i8.lo: $(srcdir)/generated/iall_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i8.lo -MD -MP -MF $(DEPDIR)/iall_i8.Tpo -c -o iall_i8.lo `test -f '$(srcdir)/generated/iall_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iall_i8.Tpo $(DEPDIR)/iall_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iall_i8.c' object='iall_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i8.lo `test -f '$(srcdir)/generated/iall_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i8.c + +iall_i16.lo: $(srcdir)/generated/iall_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iall_i16.lo -MD -MP -MF $(DEPDIR)/iall_i16.Tpo -c -o iall_i16.lo `test -f '$(srcdir)/generated/iall_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iall_i16.Tpo $(DEPDIR)/iall_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iall_i16.c' object='iall_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iall_i16.lo `test -f '$(srcdir)/generated/iall_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iall_i16.c + +iany_i1.lo: $(srcdir)/generated/iany_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i1.lo -MD -MP -MF $(DEPDIR)/iany_i1.Tpo -c -o iany_i1.lo `test -f '$(srcdir)/generated/iany_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iany_i1.Tpo $(DEPDIR)/iany_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iany_i1.c' object='iany_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i1.lo `test -f '$(srcdir)/generated/iany_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i1.c + +iany_i2.lo: $(srcdir)/generated/iany_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i2.lo -MD -MP -MF $(DEPDIR)/iany_i2.Tpo -c -o iany_i2.lo `test -f '$(srcdir)/generated/iany_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iany_i2.Tpo $(DEPDIR)/iany_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iany_i2.c' object='iany_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i2.lo `test -f '$(srcdir)/generated/iany_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i2.c + +iany_i4.lo: $(srcdir)/generated/iany_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i4.lo -MD -MP -MF $(DEPDIR)/iany_i4.Tpo -c -o iany_i4.lo `test -f '$(srcdir)/generated/iany_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iany_i4.Tpo $(DEPDIR)/iany_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iany_i4.c' object='iany_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i4.lo `test -f '$(srcdir)/generated/iany_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i4.c + +iany_i8.lo: $(srcdir)/generated/iany_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i8.lo -MD -MP -MF $(DEPDIR)/iany_i8.Tpo -c -o iany_i8.lo `test -f '$(srcdir)/generated/iany_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iany_i8.Tpo $(DEPDIR)/iany_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iany_i8.c' object='iany_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i8.lo `test -f '$(srcdir)/generated/iany_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i8.c + +iany_i16.lo: $(srcdir)/generated/iany_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iany_i16.lo -MD -MP -MF $(DEPDIR)/iany_i16.Tpo -c -o iany_i16.lo `test -f '$(srcdir)/generated/iany_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iany_i16.Tpo $(DEPDIR)/iany_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iany_i16.c' object='iany_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iany_i16.lo `test -f '$(srcdir)/generated/iany_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iany_i16.c + +iparity_i1.lo: $(srcdir)/generated/iparity_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i1.lo -MD -MP -MF $(DEPDIR)/iparity_i1.Tpo -c -o iparity_i1.lo `test -f '$(srcdir)/generated/iparity_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iparity_i1.Tpo $(DEPDIR)/iparity_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iparity_i1.c' object='iparity_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i1.lo `test -f '$(srcdir)/generated/iparity_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i1.c + +iparity_i2.lo: $(srcdir)/generated/iparity_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i2.lo -MD -MP -MF $(DEPDIR)/iparity_i2.Tpo -c -o iparity_i2.lo `test -f '$(srcdir)/generated/iparity_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iparity_i2.Tpo $(DEPDIR)/iparity_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iparity_i2.c' object='iparity_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i2.lo `test -f '$(srcdir)/generated/iparity_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i2.c + +iparity_i4.lo: $(srcdir)/generated/iparity_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i4.lo -MD -MP -MF $(DEPDIR)/iparity_i4.Tpo -c -o iparity_i4.lo `test -f '$(srcdir)/generated/iparity_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iparity_i4.Tpo $(DEPDIR)/iparity_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iparity_i4.c' object='iparity_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i4.lo `test -f '$(srcdir)/generated/iparity_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i4.c + +iparity_i8.lo: $(srcdir)/generated/iparity_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i8.lo -MD -MP -MF $(DEPDIR)/iparity_i8.Tpo -c -o iparity_i8.lo `test -f '$(srcdir)/generated/iparity_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iparity_i8.Tpo $(DEPDIR)/iparity_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iparity_i8.c' object='iparity_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i8.lo `test -f '$(srcdir)/generated/iparity_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i8.c + +iparity_i16.lo: $(srcdir)/generated/iparity_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iparity_i16.lo -MD -MP -MF $(DEPDIR)/iparity_i16.Tpo -c -o iparity_i16.lo `test -f '$(srcdir)/generated/iparity_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iparity_i16.Tpo $(DEPDIR)/iparity_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/iparity_i16.c' object='iparity_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iparity_i16.lo `test -f '$(srcdir)/generated/iparity_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/iparity_i16.c + +norm2_r4.lo: $(srcdir)/generated/norm2_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT norm2_r4.lo -MD -MP -MF $(DEPDIR)/norm2_r4.Tpo -c -o norm2_r4.lo `test -f '$(srcdir)/generated/norm2_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/norm2_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/norm2_r4.Tpo $(DEPDIR)/norm2_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/norm2_r4.c' object='norm2_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o norm2_r4.lo `test -f '$(srcdir)/generated/norm2_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/norm2_r4.c + +norm2_r8.lo: $(srcdir)/generated/norm2_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT norm2_r8.lo -MD -MP -MF $(DEPDIR)/norm2_r8.Tpo -c -o norm2_r8.lo `test -f '$(srcdir)/generated/norm2_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/norm2_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/norm2_r8.Tpo $(DEPDIR)/norm2_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/norm2_r8.c' object='norm2_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o norm2_r8.lo `test -f '$(srcdir)/generated/norm2_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/norm2_r8.c + +norm2_r10.lo: $(srcdir)/generated/norm2_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT norm2_r10.lo -MD -MP -MF $(DEPDIR)/norm2_r10.Tpo -c -o norm2_r10.lo `test -f '$(srcdir)/generated/norm2_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/norm2_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/norm2_r10.Tpo $(DEPDIR)/norm2_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/norm2_r10.c' object='norm2_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o norm2_r10.lo `test -f '$(srcdir)/generated/norm2_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/norm2_r10.c + +norm2_r16.lo: $(srcdir)/generated/norm2_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT norm2_r16.lo -MD -MP -MF $(DEPDIR)/norm2_r16.Tpo -c -o norm2_r16.lo `test -f '$(srcdir)/generated/norm2_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/norm2_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/norm2_r16.Tpo $(DEPDIR)/norm2_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/norm2_r16.c' object='norm2_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o norm2_r16.lo `test -f '$(srcdir)/generated/norm2_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/norm2_r16.c + +parity_l1.lo: $(srcdir)/generated/parity_l1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT parity_l1.lo -MD -MP -MF $(DEPDIR)/parity_l1.Tpo -c -o parity_l1.lo `test -f '$(srcdir)/generated/parity_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/parity_l1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/parity_l1.Tpo $(DEPDIR)/parity_l1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/parity_l1.c' object='parity_l1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o parity_l1.lo `test -f '$(srcdir)/generated/parity_l1.c' || echo '$(srcdir)/'`$(srcdir)/generated/parity_l1.c + +parity_l2.lo: $(srcdir)/generated/parity_l2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT parity_l2.lo -MD -MP -MF $(DEPDIR)/parity_l2.Tpo -c -o parity_l2.lo `test -f '$(srcdir)/generated/parity_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/parity_l2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/parity_l2.Tpo $(DEPDIR)/parity_l2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/parity_l2.c' object='parity_l2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o parity_l2.lo `test -f '$(srcdir)/generated/parity_l2.c' || echo '$(srcdir)/'`$(srcdir)/generated/parity_l2.c + +parity_l4.lo: $(srcdir)/generated/parity_l4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT parity_l4.lo -MD -MP -MF $(DEPDIR)/parity_l4.Tpo -c -o parity_l4.lo `test -f '$(srcdir)/generated/parity_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/parity_l4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/parity_l4.Tpo $(DEPDIR)/parity_l4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/parity_l4.c' object='parity_l4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o parity_l4.lo `test -f '$(srcdir)/generated/parity_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/parity_l4.c + +parity_l8.lo: $(srcdir)/generated/parity_l8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT parity_l8.lo -MD -MP -MF $(DEPDIR)/parity_l8.Tpo -c -o parity_l8.lo `test -f '$(srcdir)/generated/parity_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/parity_l8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/parity_l8.Tpo $(DEPDIR)/parity_l8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/parity_l8.c' object='parity_l8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o parity_l8.lo `test -f '$(srcdir)/generated/parity_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/parity_l8.c + +parity_l16.lo: $(srcdir)/generated/parity_l16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT parity_l16.lo -MD -MP -MF $(DEPDIR)/parity_l16.Tpo -c -o parity_l16.lo `test -f '$(srcdir)/generated/parity_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/parity_l16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/parity_l16.Tpo $(DEPDIR)/parity_l16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/parity_l16.c' object='parity_l16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o parity_l16.lo `test -f '$(srcdir)/generated/parity_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/parity_l16.c + +matmul_i1.lo: $(srcdir)/generated/matmul_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_i1.lo -MD -MP -MF $(DEPDIR)/matmul_i1.Tpo -c -o matmul_i1.lo `test -f '$(srcdir)/generated/matmul_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_i1.Tpo $(DEPDIR)/matmul_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_i1.c' object='matmul_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i1.lo `test -f '$(srcdir)/generated/matmul_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_i1.c + +matmul_i2.lo: $(srcdir)/generated/matmul_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_i2.lo -MD -MP -MF $(DEPDIR)/matmul_i2.Tpo -c -o matmul_i2.lo `test -f '$(srcdir)/generated/matmul_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_i2.Tpo $(DEPDIR)/matmul_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_i2.c' object='matmul_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i2.lo `test -f '$(srcdir)/generated/matmul_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_i2.c + +matmul_i4.lo: $(srcdir)/generated/matmul_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_i4.lo -MD -MP -MF $(DEPDIR)/matmul_i4.Tpo -c -o matmul_i4.lo `test -f '$(srcdir)/generated/matmul_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_i4.Tpo $(DEPDIR)/matmul_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_i4.c' object='matmul_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i4.lo `test -f '$(srcdir)/generated/matmul_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_i4.c + +matmul_i8.lo: $(srcdir)/generated/matmul_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_i8.lo -MD -MP -MF $(DEPDIR)/matmul_i8.Tpo -c -o matmul_i8.lo `test -f '$(srcdir)/generated/matmul_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_i8.Tpo $(DEPDIR)/matmul_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_i8.c' object='matmul_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i8.lo `test -f '$(srcdir)/generated/matmul_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_i8.c + +matmul_i16.lo: $(srcdir)/generated/matmul_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_i16.lo -MD -MP -MF $(DEPDIR)/matmul_i16.Tpo -c -o matmul_i16.lo `test -f '$(srcdir)/generated/matmul_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_i16.Tpo $(DEPDIR)/matmul_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_i16.c' object='matmul_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_i16.lo `test -f '$(srcdir)/generated/matmul_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_i16.c + +matmul_r4.lo: $(srcdir)/generated/matmul_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_r4.lo -MD -MP -MF $(DEPDIR)/matmul_r4.Tpo -c -o matmul_r4.lo `test -f '$(srcdir)/generated/matmul_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_r4.Tpo $(DEPDIR)/matmul_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_r4.c' object='matmul_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r4.lo `test -f '$(srcdir)/generated/matmul_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_r4.c + +matmul_r8.lo: $(srcdir)/generated/matmul_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_r8.lo -MD -MP -MF $(DEPDIR)/matmul_r8.Tpo -c -o matmul_r8.lo `test -f '$(srcdir)/generated/matmul_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_r8.Tpo $(DEPDIR)/matmul_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_r8.c' object='matmul_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r8.lo `test -f '$(srcdir)/generated/matmul_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_r8.c + +matmul_r10.lo: $(srcdir)/generated/matmul_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_r10.lo -MD -MP -MF $(DEPDIR)/matmul_r10.Tpo -c -o matmul_r10.lo `test -f '$(srcdir)/generated/matmul_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_r10.Tpo $(DEPDIR)/matmul_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_r10.c' object='matmul_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r10.lo `test -f '$(srcdir)/generated/matmul_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_r10.c + +matmul_r16.lo: $(srcdir)/generated/matmul_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_r16.lo -MD -MP -MF $(DEPDIR)/matmul_r16.Tpo -c -o matmul_r16.lo `test -f '$(srcdir)/generated/matmul_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_r16.Tpo $(DEPDIR)/matmul_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_r16.c' object='matmul_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_r16.lo `test -f '$(srcdir)/generated/matmul_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_r16.c + +matmul_c4.lo: $(srcdir)/generated/matmul_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_c4.lo -MD -MP -MF $(DEPDIR)/matmul_c4.Tpo -c -o matmul_c4.lo `test -f '$(srcdir)/generated/matmul_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_c4.Tpo $(DEPDIR)/matmul_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_c4.c' object='matmul_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c4.lo `test -f '$(srcdir)/generated/matmul_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_c4.c + +matmul_c8.lo: $(srcdir)/generated/matmul_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_c8.lo -MD -MP -MF $(DEPDIR)/matmul_c8.Tpo -c -o matmul_c8.lo `test -f '$(srcdir)/generated/matmul_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_c8.Tpo $(DEPDIR)/matmul_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_c8.c' object='matmul_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c8.lo `test -f '$(srcdir)/generated/matmul_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_c8.c + +matmul_c10.lo: $(srcdir)/generated/matmul_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_c10.lo -MD -MP -MF $(DEPDIR)/matmul_c10.Tpo -c -o matmul_c10.lo `test -f '$(srcdir)/generated/matmul_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_c10.Tpo $(DEPDIR)/matmul_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_c10.c' object='matmul_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c10.lo `test -f '$(srcdir)/generated/matmul_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_c10.c + +matmul_c16.lo: $(srcdir)/generated/matmul_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_c16.lo -MD -MP -MF $(DEPDIR)/matmul_c16.Tpo -c -o matmul_c16.lo `test -f '$(srcdir)/generated/matmul_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_c16.Tpo $(DEPDIR)/matmul_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_c16.c' object='matmul_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_c16.lo `test -f '$(srcdir)/generated/matmul_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_c16.c + +matmul_l4.lo: $(srcdir)/generated/matmul_l4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_l4.lo -MD -MP -MF $(DEPDIR)/matmul_l4.Tpo -c -o matmul_l4.lo `test -f '$(srcdir)/generated/matmul_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_l4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_l4.Tpo $(DEPDIR)/matmul_l4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_l4.c' object='matmul_l4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l4.lo `test -f '$(srcdir)/generated/matmul_l4.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_l4.c + +matmul_l8.lo: $(srcdir)/generated/matmul_l8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_l8.lo -MD -MP -MF $(DEPDIR)/matmul_l8.Tpo -c -o matmul_l8.lo `test -f '$(srcdir)/generated/matmul_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_l8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_l8.Tpo $(DEPDIR)/matmul_l8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_l8.c' object='matmul_l8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l8.lo `test -f '$(srcdir)/generated/matmul_l8.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_l8.c + +matmul_l16.lo: $(srcdir)/generated/matmul_l16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT matmul_l16.lo -MD -MP -MF $(DEPDIR)/matmul_l16.Tpo -c -o matmul_l16.lo `test -f '$(srcdir)/generated/matmul_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_l16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/matmul_l16.Tpo $(DEPDIR)/matmul_l16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/matmul_l16.c' object='matmul_l16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o matmul_l16.lo `test -f '$(srcdir)/generated/matmul_l16.c' || echo '$(srcdir)/'`$(srcdir)/generated/matmul_l16.c + +transpose_i4.lo: $(srcdir)/generated/transpose_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_i4.lo -MD -MP -MF $(DEPDIR)/transpose_i4.Tpo -c -o transpose_i4.lo `test -f '$(srcdir)/generated/transpose_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_i4.Tpo $(DEPDIR)/transpose_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_i4.c' object='transpose_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i4.lo `test -f '$(srcdir)/generated/transpose_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_i4.c + +transpose_i8.lo: $(srcdir)/generated/transpose_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_i8.lo -MD -MP -MF $(DEPDIR)/transpose_i8.Tpo -c -o transpose_i8.lo `test -f '$(srcdir)/generated/transpose_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_i8.Tpo $(DEPDIR)/transpose_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_i8.c' object='transpose_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i8.lo `test -f '$(srcdir)/generated/transpose_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_i8.c + +transpose_i16.lo: $(srcdir)/generated/transpose_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_i16.lo -MD -MP -MF $(DEPDIR)/transpose_i16.Tpo -c -o transpose_i16.lo `test -f '$(srcdir)/generated/transpose_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_i16.Tpo $(DEPDIR)/transpose_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_i16.c' object='transpose_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i16.lo `test -f '$(srcdir)/generated/transpose_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_i16.c + +transpose_r4.lo: $(srcdir)/generated/transpose_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_r4.lo -MD -MP -MF $(DEPDIR)/transpose_r4.Tpo -c -o transpose_r4.lo `test -f '$(srcdir)/generated/transpose_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_r4.Tpo $(DEPDIR)/transpose_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_r4.c' object='transpose_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_r4.lo `test -f '$(srcdir)/generated/transpose_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_r4.c + +transpose_r8.lo: $(srcdir)/generated/transpose_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_r8.lo -MD -MP -MF $(DEPDIR)/transpose_r8.Tpo -c -o transpose_r8.lo `test -f '$(srcdir)/generated/transpose_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_r8.Tpo $(DEPDIR)/transpose_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_r8.c' object='transpose_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_r8.lo `test -f '$(srcdir)/generated/transpose_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_r8.c + +transpose_r10.lo: $(srcdir)/generated/transpose_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_r10.lo -MD -MP -MF $(DEPDIR)/transpose_r10.Tpo -c -o transpose_r10.lo `test -f '$(srcdir)/generated/transpose_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_r10.Tpo $(DEPDIR)/transpose_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_r10.c' object='transpose_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_r10.lo `test -f '$(srcdir)/generated/transpose_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_r10.c + +transpose_r16.lo: $(srcdir)/generated/transpose_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_r16.lo -MD -MP -MF $(DEPDIR)/transpose_r16.Tpo -c -o transpose_r16.lo `test -f '$(srcdir)/generated/transpose_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_r16.Tpo $(DEPDIR)/transpose_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_r16.c' object='transpose_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_r16.lo `test -f '$(srcdir)/generated/transpose_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_r16.c + +transpose_c4.lo: $(srcdir)/generated/transpose_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_c4.lo -MD -MP -MF $(DEPDIR)/transpose_c4.Tpo -c -o transpose_c4.lo `test -f '$(srcdir)/generated/transpose_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_c4.Tpo $(DEPDIR)/transpose_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_c4.c' object='transpose_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c4.lo `test -f '$(srcdir)/generated/transpose_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_c4.c + +transpose_c8.lo: $(srcdir)/generated/transpose_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_c8.lo -MD -MP -MF $(DEPDIR)/transpose_c8.Tpo -c -o transpose_c8.lo `test -f '$(srcdir)/generated/transpose_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_c8.Tpo $(DEPDIR)/transpose_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_c8.c' object='transpose_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c8.lo `test -f '$(srcdir)/generated/transpose_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_c8.c + +transpose_c10.lo: $(srcdir)/generated/transpose_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_c10.lo -MD -MP -MF $(DEPDIR)/transpose_c10.Tpo -c -o transpose_c10.lo `test -f '$(srcdir)/generated/transpose_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_c10.Tpo $(DEPDIR)/transpose_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_c10.c' object='transpose_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c10.lo `test -f '$(srcdir)/generated/transpose_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_c10.c + +transpose_c16.lo: $(srcdir)/generated/transpose_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_c16.lo -MD -MP -MF $(DEPDIR)/transpose_c16.Tpo -c -o transpose_c16.lo `test -f '$(srcdir)/generated/transpose_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_c16.Tpo $(DEPDIR)/transpose_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/transpose_c16.c' object='transpose_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c16.lo `test -f '$(srcdir)/generated/transpose_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/transpose_c16.c + +shape_i4.lo: $(srcdir)/generated/shape_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT shape_i4.lo -MD -MP -MF $(DEPDIR)/shape_i4.Tpo -c -o shape_i4.lo `test -f '$(srcdir)/generated/shape_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/shape_i4.Tpo $(DEPDIR)/shape_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/shape_i4.c' object='shape_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i4.lo `test -f '$(srcdir)/generated/shape_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i4.c + +shape_i8.lo: $(srcdir)/generated/shape_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT shape_i8.lo -MD -MP -MF $(DEPDIR)/shape_i8.Tpo -c -o shape_i8.lo `test -f '$(srcdir)/generated/shape_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/shape_i8.Tpo $(DEPDIR)/shape_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/shape_i8.c' object='shape_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i8.lo `test -f '$(srcdir)/generated/shape_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i8.c + +shape_i16.lo: $(srcdir)/generated/shape_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT shape_i16.lo -MD -MP -MF $(DEPDIR)/shape_i16.Tpo -c -o shape_i16.lo `test -f '$(srcdir)/generated/shape_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/shape_i16.Tpo $(DEPDIR)/shape_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/shape_i16.c' object='shape_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o shape_i16.lo `test -f '$(srcdir)/generated/shape_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/shape_i16.c + +eoshift1_4.lo: $(srcdir)/generated/eoshift1_4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT eoshift1_4.lo -MD -MP -MF $(DEPDIR)/eoshift1_4.Tpo -c -o eoshift1_4.lo `test -f '$(srcdir)/generated/eoshift1_4.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift1_4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/eoshift1_4.Tpo $(DEPDIR)/eoshift1_4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/eoshift1_4.c' object='eoshift1_4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_4.lo `test -f '$(srcdir)/generated/eoshift1_4.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift1_4.c + +eoshift1_8.lo: $(srcdir)/generated/eoshift1_8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT eoshift1_8.lo -MD -MP -MF $(DEPDIR)/eoshift1_8.Tpo -c -o eoshift1_8.lo `test -f '$(srcdir)/generated/eoshift1_8.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift1_8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/eoshift1_8.Tpo $(DEPDIR)/eoshift1_8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/eoshift1_8.c' object='eoshift1_8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_8.lo `test -f '$(srcdir)/generated/eoshift1_8.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift1_8.c + +eoshift1_16.lo: $(srcdir)/generated/eoshift1_16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT eoshift1_16.lo -MD -MP -MF $(DEPDIR)/eoshift1_16.Tpo -c -o eoshift1_16.lo `test -f '$(srcdir)/generated/eoshift1_16.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift1_16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/eoshift1_16.Tpo $(DEPDIR)/eoshift1_16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/eoshift1_16.c' object='eoshift1_16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift1_16.lo `test -f '$(srcdir)/generated/eoshift1_16.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift1_16.c + +eoshift3_4.lo: $(srcdir)/generated/eoshift3_4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT eoshift3_4.lo -MD -MP -MF $(DEPDIR)/eoshift3_4.Tpo -c -o eoshift3_4.lo `test -f '$(srcdir)/generated/eoshift3_4.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift3_4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/eoshift3_4.Tpo $(DEPDIR)/eoshift3_4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/eoshift3_4.c' object='eoshift3_4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_4.lo `test -f '$(srcdir)/generated/eoshift3_4.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift3_4.c + +eoshift3_8.lo: $(srcdir)/generated/eoshift3_8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT eoshift3_8.lo -MD -MP -MF $(DEPDIR)/eoshift3_8.Tpo -c -o eoshift3_8.lo `test -f '$(srcdir)/generated/eoshift3_8.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift3_8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/eoshift3_8.Tpo $(DEPDIR)/eoshift3_8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/eoshift3_8.c' object='eoshift3_8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_8.lo `test -f '$(srcdir)/generated/eoshift3_8.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift3_8.c + +eoshift3_16.lo: $(srcdir)/generated/eoshift3_16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT eoshift3_16.lo -MD -MP -MF $(DEPDIR)/eoshift3_16.Tpo -c -o eoshift3_16.lo `test -f '$(srcdir)/generated/eoshift3_16.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift3_16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/eoshift3_16.Tpo $(DEPDIR)/eoshift3_16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/eoshift3_16.c' object='eoshift3_16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift3_16.lo `test -f '$(srcdir)/generated/eoshift3_16.c' || echo '$(srcdir)/'`$(srcdir)/generated/eoshift3_16.c + +cshift1_4.lo: $(srcdir)/generated/cshift1_4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift1_4.lo -MD -MP -MF $(DEPDIR)/cshift1_4.Tpo -c -o cshift1_4.lo `test -f '$(srcdir)/generated/cshift1_4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift1_4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift1_4.Tpo $(DEPDIR)/cshift1_4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift1_4.c' object='cshift1_4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_4.lo `test -f '$(srcdir)/generated/cshift1_4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift1_4.c + +cshift1_8.lo: $(srcdir)/generated/cshift1_8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift1_8.lo -MD -MP -MF $(DEPDIR)/cshift1_8.Tpo -c -o cshift1_8.lo `test -f '$(srcdir)/generated/cshift1_8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift1_8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift1_8.Tpo $(DEPDIR)/cshift1_8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift1_8.c' object='cshift1_8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_8.lo `test -f '$(srcdir)/generated/cshift1_8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift1_8.c + +cshift1_16.lo: $(srcdir)/generated/cshift1_16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift1_16.lo -MD -MP -MF $(DEPDIR)/cshift1_16.Tpo -c -o cshift1_16.lo `test -f '$(srcdir)/generated/cshift1_16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift1_16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift1_16.Tpo $(DEPDIR)/cshift1_16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift1_16.c' object='cshift1_16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift1_16.lo `test -f '$(srcdir)/generated/cshift1_16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift1_16.c + +reshape_i4.lo: $(srcdir)/generated/reshape_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_i4.lo -MD -MP -MF $(DEPDIR)/reshape_i4.Tpo -c -o reshape_i4.lo `test -f '$(srcdir)/generated/reshape_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_i4.Tpo $(DEPDIR)/reshape_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_i4.c' object='reshape_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i4.lo `test -f '$(srcdir)/generated/reshape_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_i4.c + +reshape_i8.lo: $(srcdir)/generated/reshape_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_i8.lo -MD -MP -MF $(DEPDIR)/reshape_i8.Tpo -c -o reshape_i8.lo `test -f '$(srcdir)/generated/reshape_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_i8.Tpo $(DEPDIR)/reshape_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_i8.c' object='reshape_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i8.lo `test -f '$(srcdir)/generated/reshape_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_i8.c + +reshape_i16.lo: $(srcdir)/generated/reshape_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_i16.lo -MD -MP -MF $(DEPDIR)/reshape_i16.Tpo -c -o reshape_i16.lo `test -f '$(srcdir)/generated/reshape_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_i16.Tpo $(DEPDIR)/reshape_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_i16.c' object='reshape_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i16.lo `test -f '$(srcdir)/generated/reshape_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_i16.c + +reshape_r4.lo: $(srcdir)/generated/reshape_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_r4.lo -MD -MP -MF $(DEPDIR)/reshape_r4.Tpo -c -o reshape_r4.lo `test -f '$(srcdir)/generated/reshape_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_r4.Tpo $(DEPDIR)/reshape_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_r4.c' object='reshape_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_r4.lo `test -f '$(srcdir)/generated/reshape_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_r4.c + +reshape_r8.lo: $(srcdir)/generated/reshape_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_r8.lo -MD -MP -MF $(DEPDIR)/reshape_r8.Tpo -c -o reshape_r8.lo `test -f '$(srcdir)/generated/reshape_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_r8.Tpo $(DEPDIR)/reshape_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_r8.c' object='reshape_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_r8.lo `test -f '$(srcdir)/generated/reshape_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_r8.c + +reshape_r10.lo: $(srcdir)/generated/reshape_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_r10.lo -MD -MP -MF $(DEPDIR)/reshape_r10.Tpo -c -o reshape_r10.lo `test -f '$(srcdir)/generated/reshape_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_r10.Tpo $(DEPDIR)/reshape_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_r10.c' object='reshape_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_r10.lo `test -f '$(srcdir)/generated/reshape_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_r10.c + +reshape_r16.lo: $(srcdir)/generated/reshape_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_r16.lo -MD -MP -MF $(DEPDIR)/reshape_r16.Tpo -c -o reshape_r16.lo `test -f '$(srcdir)/generated/reshape_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_r16.Tpo $(DEPDIR)/reshape_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_r16.c' object='reshape_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_r16.lo `test -f '$(srcdir)/generated/reshape_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_r16.c + +reshape_c4.lo: $(srcdir)/generated/reshape_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_c4.lo -MD -MP -MF $(DEPDIR)/reshape_c4.Tpo -c -o reshape_c4.lo `test -f '$(srcdir)/generated/reshape_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_c4.Tpo $(DEPDIR)/reshape_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_c4.c' object='reshape_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c4.lo `test -f '$(srcdir)/generated/reshape_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_c4.c + +reshape_c8.lo: $(srcdir)/generated/reshape_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_c8.lo -MD -MP -MF $(DEPDIR)/reshape_c8.Tpo -c -o reshape_c8.lo `test -f '$(srcdir)/generated/reshape_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_c8.Tpo $(DEPDIR)/reshape_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_c8.c' object='reshape_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c8.lo `test -f '$(srcdir)/generated/reshape_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_c8.c + +reshape_c10.lo: $(srcdir)/generated/reshape_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_c10.lo -MD -MP -MF $(DEPDIR)/reshape_c10.Tpo -c -o reshape_c10.lo `test -f '$(srcdir)/generated/reshape_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_c10.Tpo $(DEPDIR)/reshape_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_c10.c' object='reshape_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c10.lo `test -f '$(srcdir)/generated/reshape_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_c10.c + +reshape_c16.lo: $(srcdir)/generated/reshape_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_c16.lo -MD -MP -MF $(DEPDIR)/reshape_c16.Tpo -c -o reshape_c16.lo `test -f '$(srcdir)/generated/reshape_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_c16.Tpo $(DEPDIR)/reshape_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/reshape_c16.c' object='reshape_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c16.lo `test -f '$(srcdir)/generated/reshape_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/reshape_c16.c + +in_pack_i1.lo: $(srcdir)/generated/in_pack_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i1.lo -MD -MP -MF $(DEPDIR)/in_pack_i1.Tpo -c -o in_pack_i1.lo `test -f '$(srcdir)/generated/in_pack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_i1.Tpo $(DEPDIR)/in_pack_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_i1.c' object='in_pack_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i1.lo `test -f '$(srcdir)/generated/in_pack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i1.c + +in_pack_i2.lo: $(srcdir)/generated/in_pack_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i2.lo -MD -MP -MF $(DEPDIR)/in_pack_i2.Tpo -c -o in_pack_i2.lo `test -f '$(srcdir)/generated/in_pack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_i2.Tpo $(DEPDIR)/in_pack_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_i2.c' object='in_pack_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i2.lo `test -f '$(srcdir)/generated/in_pack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i2.c + +in_pack_i4.lo: $(srcdir)/generated/in_pack_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i4.lo -MD -MP -MF $(DEPDIR)/in_pack_i4.Tpo -c -o in_pack_i4.lo `test -f '$(srcdir)/generated/in_pack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_i4.Tpo $(DEPDIR)/in_pack_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_i4.c' object='in_pack_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i4.lo `test -f '$(srcdir)/generated/in_pack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i4.c + +in_pack_i8.lo: $(srcdir)/generated/in_pack_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i8.lo -MD -MP -MF $(DEPDIR)/in_pack_i8.Tpo -c -o in_pack_i8.lo `test -f '$(srcdir)/generated/in_pack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_i8.Tpo $(DEPDIR)/in_pack_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_i8.c' object='in_pack_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i8.lo `test -f '$(srcdir)/generated/in_pack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i8.c + +in_pack_i16.lo: $(srcdir)/generated/in_pack_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_i16.lo -MD -MP -MF $(DEPDIR)/in_pack_i16.Tpo -c -o in_pack_i16.lo `test -f '$(srcdir)/generated/in_pack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_i16.Tpo $(DEPDIR)/in_pack_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_i16.c' object='in_pack_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_i16.lo `test -f '$(srcdir)/generated/in_pack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_i16.c + +in_pack_r4.lo: $(srcdir)/generated/in_pack_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r4.lo -MD -MP -MF $(DEPDIR)/in_pack_r4.Tpo -c -o in_pack_r4.lo `test -f '$(srcdir)/generated/in_pack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_r4.Tpo $(DEPDIR)/in_pack_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r4.c' object='in_pack_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r4.lo `test -f '$(srcdir)/generated/in_pack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r4.c + +in_pack_r8.lo: $(srcdir)/generated/in_pack_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r8.lo -MD -MP -MF $(DEPDIR)/in_pack_r8.Tpo -c -o in_pack_r8.lo `test -f '$(srcdir)/generated/in_pack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_r8.Tpo $(DEPDIR)/in_pack_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r8.c' object='in_pack_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r8.lo `test -f '$(srcdir)/generated/in_pack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r8.c + +in_pack_r10.lo: $(srcdir)/generated/in_pack_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r10.lo -MD -MP -MF $(DEPDIR)/in_pack_r10.Tpo -c -o in_pack_r10.lo `test -f '$(srcdir)/generated/in_pack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_r10.Tpo $(DEPDIR)/in_pack_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r10.c' object='in_pack_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r10.lo `test -f '$(srcdir)/generated/in_pack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r10.c + +in_pack_r16.lo: $(srcdir)/generated/in_pack_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_r16.lo -MD -MP -MF $(DEPDIR)/in_pack_r16.Tpo -c -o in_pack_r16.lo `test -f '$(srcdir)/generated/in_pack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_r16.Tpo $(DEPDIR)/in_pack_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_r16.c' object='in_pack_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_r16.lo `test -f '$(srcdir)/generated/in_pack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_r16.c + +in_pack_c4.lo: $(srcdir)/generated/in_pack_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_c4.lo -MD -MP -MF $(DEPDIR)/in_pack_c4.Tpo -c -o in_pack_c4.lo `test -f '$(srcdir)/generated/in_pack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_c4.Tpo $(DEPDIR)/in_pack_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_c4.c' object='in_pack_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c4.lo `test -f '$(srcdir)/generated/in_pack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c4.c + +in_pack_c8.lo: $(srcdir)/generated/in_pack_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_c8.lo -MD -MP -MF $(DEPDIR)/in_pack_c8.Tpo -c -o in_pack_c8.lo `test -f '$(srcdir)/generated/in_pack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_c8.Tpo $(DEPDIR)/in_pack_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_c8.c' object='in_pack_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c8.lo `test -f '$(srcdir)/generated/in_pack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c8.c + +in_pack_c10.lo: $(srcdir)/generated/in_pack_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_c10.lo -MD -MP -MF $(DEPDIR)/in_pack_c10.Tpo -c -o in_pack_c10.lo `test -f '$(srcdir)/generated/in_pack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_c10.Tpo $(DEPDIR)/in_pack_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_c10.c' object='in_pack_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c10.lo `test -f '$(srcdir)/generated/in_pack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c10.c + +in_pack_c16.lo: $(srcdir)/generated/in_pack_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_c16.lo -MD -MP -MF $(DEPDIR)/in_pack_c16.Tpo -c -o in_pack_c16.lo `test -f '$(srcdir)/generated/in_pack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_c16.Tpo $(DEPDIR)/in_pack_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_pack_c16.c' object='in_pack_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_c16.lo `test -f '$(srcdir)/generated/in_pack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_pack_c16.c + +in_unpack_i1.lo: $(srcdir)/generated/in_unpack_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i1.lo -MD -MP -MF $(DEPDIR)/in_unpack_i1.Tpo -c -o in_unpack_i1.lo `test -f '$(srcdir)/generated/in_unpack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_i1.Tpo $(DEPDIR)/in_unpack_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_i1.c' object='in_unpack_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i1.lo `test -f '$(srcdir)/generated/in_unpack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i1.c + +in_unpack_i2.lo: $(srcdir)/generated/in_unpack_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i2.lo -MD -MP -MF $(DEPDIR)/in_unpack_i2.Tpo -c -o in_unpack_i2.lo `test -f '$(srcdir)/generated/in_unpack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_i2.Tpo $(DEPDIR)/in_unpack_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_i2.c' object='in_unpack_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i2.lo `test -f '$(srcdir)/generated/in_unpack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i2.c + +in_unpack_i4.lo: $(srcdir)/generated/in_unpack_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i4.lo -MD -MP -MF $(DEPDIR)/in_unpack_i4.Tpo -c -o in_unpack_i4.lo `test -f '$(srcdir)/generated/in_unpack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_i4.Tpo $(DEPDIR)/in_unpack_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_i4.c' object='in_unpack_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i4.lo `test -f '$(srcdir)/generated/in_unpack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i4.c + +in_unpack_i8.lo: $(srcdir)/generated/in_unpack_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i8.lo -MD -MP -MF $(DEPDIR)/in_unpack_i8.Tpo -c -o in_unpack_i8.lo `test -f '$(srcdir)/generated/in_unpack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_i8.Tpo $(DEPDIR)/in_unpack_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_i8.c' object='in_unpack_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i8.lo `test -f '$(srcdir)/generated/in_unpack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i8.c + +in_unpack_i16.lo: $(srcdir)/generated/in_unpack_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_i16.lo -MD -MP -MF $(DEPDIR)/in_unpack_i16.Tpo -c -o in_unpack_i16.lo `test -f '$(srcdir)/generated/in_unpack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_i16.Tpo $(DEPDIR)/in_unpack_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_i16.c' object='in_unpack_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_i16.lo `test -f '$(srcdir)/generated/in_unpack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_i16.c + +in_unpack_r4.lo: $(srcdir)/generated/in_unpack_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r4.lo -MD -MP -MF $(DEPDIR)/in_unpack_r4.Tpo -c -o in_unpack_r4.lo `test -f '$(srcdir)/generated/in_unpack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_r4.Tpo $(DEPDIR)/in_unpack_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r4.c' object='in_unpack_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r4.lo `test -f '$(srcdir)/generated/in_unpack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r4.c + +in_unpack_r8.lo: $(srcdir)/generated/in_unpack_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r8.lo -MD -MP -MF $(DEPDIR)/in_unpack_r8.Tpo -c -o in_unpack_r8.lo `test -f '$(srcdir)/generated/in_unpack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_r8.Tpo $(DEPDIR)/in_unpack_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r8.c' object='in_unpack_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r8.lo `test -f '$(srcdir)/generated/in_unpack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r8.c + +in_unpack_r10.lo: $(srcdir)/generated/in_unpack_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r10.lo -MD -MP -MF $(DEPDIR)/in_unpack_r10.Tpo -c -o in_unpack_r10.lo `test -f '$(srcdir)/generated/in_unpack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_r10.Tpo $(DEPDIR)/in_unpack_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r10.c' object='in_unpack_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r10.lo `test -f '$(srcdir)/generated/in_unpack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r10.c + +in_unpack_r16.lo: $(srcdir)/generated/in_unpack_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_r16.lo -MD -MP -MF $(DEPDIR)/in_unpack_r16.Tpo -c -o in_unpack_r16.lo `test -f '$(srcdir)/generated/in_unpack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_r16.Tpo $(DEPDIR)/in_unpack_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_r16.c' object='in_unpack_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_r16.lo `test -f '$(srcdir)/generated/in_unpack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_r16.c + +in_unpack_c4.lo: $(srcdir)/generated/in_unpack_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_c4.lo -MD -MP -MF $(DEPDIR)/in_unpack_c4.Tpo -c -o in_unpack_c4.lo `test -f '$(srcdir)/generated/in_unpack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_c4.Tpo $(DEPDIR)/in_unpack_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_c4.c' object='in_unpack_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c4.lo `test -f '$(srcdir)/generated/in_unpack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_c4.c + +in_unpack_c8.lo: $(srcdir)/generated/in_unpack_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_c8.lo -MD -MP -MF $(DEPDIR)/in_unpack_c8.Tpo -c -o in_unpack_c8.lo `test -f '$(srcdir)/generated/in_unpack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_c8.Tpo $(DEPDIR)/in_unpack_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_c8.c' object='in_unpack_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c8.lo `test -f '$(srcdir)/generated/in_unpack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_c8.c + +in_unpack_c10.lo: $(srcdir)/generated/in_unpack_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_c10.lo -MD -MP -MF $(DEPDIR)/in_unpack_c10.Tpo -c -o in_unpack_c10.lo `test -f '$(srcdir)/generated/in_unpack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_c10.Tpo $(DEPDIR)/in_unpack_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_c10.c' object='in_unpack_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c10.lo `test -f '$(srcdir)/generated/in_unpack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_c10.c + +in_unpack_c16.lo: $(srcdir)/generated/in_unpack_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_c16.lo -MD -MP -MF $(DEPDIR)/in_unpack_c16.Tpo -c -o in_unpack_c16.lo `test -f '$(srcdir)/generated/in_unpack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_c16.Tpo $(DEPDIR)/in_unpack_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/in_unpack_c16.c' object='in_unpack_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_c16.lo `test -f '$(srcdir)/generated/in_unpack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/in_unpack_c16.c + +exponent_r4.lo: $(srcdir)/generated/exponent_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT exponent_r4.lo -MD -MP -MF $(DEPDIR)/exponent_r4.Tpo -c -o exponent_r4.lo `test -f '$(srcdir)/generated/exponent_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/exponent_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/exponent_r4.Tpo $(DEPDIR)/exponent_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/exponent_r4.c' object='exponent_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r4.lo `test -f '$(srcdir)/generated/exponent_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/exponent_r4.c + +exponent_r8.lo: $(srcdir)/generated/exponent_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT exponent_r8.lo -MD -MP -MF $(DEPDIR)/exponent_r8.Tpo -c -o exponent_r8.lo `test -f '$(srcdir)/generated/exponent_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/exponent_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/exponent_r8.Tpo $(DEPDIR)/exponent_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/exponent_r8.c' object='exponent_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r8.lo `test -f '$(srcdir)/generated/exponent_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/exponent_r8.c + +exponent_r10.lo: $(srcdir)/generated/exponent_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT exponent_r10.lo -MD -MP -MF $(DEPDIR)/exponent_r10.Tpo -c -o exponent_r10.lo `test -f '$(srcdir)/generated/exponent_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/exponent_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/exponent_r10.Tpo $(DEPDIR)/exponent_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/exponent_r10.c' object='exponent_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r10.lo `test -f '$(srcdir)/generated/exponent_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/exponent_r10.c + +exponent_r16.lo: $(srcdir)/generated/exponent_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT exponent_r16.lo -MD -MP -MF $(DEPDIR)/exponent_r16.Tpo -c -o exponent_r16.lo `test -f '$(srcdir)/generated/exponent_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/exponent_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/exponent_r16.Tpo $(DEPDIR)/exponent_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/exponent_r16.c' object='exponent_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exponent_r16.lo `test -f '$(srcdir)/generated/exponent_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/exponent_r16.c + +fraction_r4.lo: $(srcdir)/generated/fraction_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fraction_r4.lo -MD -MP -MF $(DEPDIR)/fraction_r4.Tpo -c -o fraction_r4.lo `test -f '$(srcdir)/generated/fraction_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/fraction_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/fraction_r4.Tpo $(DEPDIR)/fraction_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/fraction_r4.c' object='fraction_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r4.lo `test -f '$(srcdir)/generated/fraction_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/fraction_r4.c + +fraction_r8.lo: $(srcdir)/generated/fraction_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fraction_r8.lo -MD -MP -MF $(DEPDIR)/fraction_r8.Tpo -c -o fraction_r8.lo `test -f '$(srcdir)/generated/fraction_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/fraction_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/fraction_r8.Tpo $(DEPDIR)/fraction_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/fraction_r8.c' object='fraction_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r8.lo `test -f '$(srcdir)/generated/fraction_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/fraction_r8.c + +fraction_r10.lo: $(srcdir)/generated/fraction_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fraction_r10.lo -MD -MP -MF $(DEPDIR)/fraction_r10.Tpo -c -o fraction_r10.lo `test -f '$(srcdir)/generated/fraction_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/fraction_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/fraction_r10.Tpo $(DEPDIR)/fraction_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/fraction_r10.c' object='fraction_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r10.lo `test -f '$(srcdir)/generated/fraction_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/fraction_r10.c + +fraction_r16.lo: $(srcdir)/generated/fraction_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fraction_r16.lo -MD -MP -MF $(DEPDIR)/fraction_r16.Tpo -c -o fraction_r16.lo `test -f '$(srcdir)/generated/fraction_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/fraction_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/fraction_r16.Tpo $(DEPDIR)/fraction_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/fraction_r16.c' object='fraction_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fraction_r16.lo `test -f '$(srcdir)/generated/fraction_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/fraction_r16.c + +nearest_r4.lo: $(srcdir)/generated/nearest_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT nearest_r4.lo -MD -MP -MF $(DEPDIR)/nearest_r4.Tpo -c -o nearest_r4.lo `test -f '$(srcdir)/generated/nearest_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/nearest_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/nearest_r4.Tpo $(DEPDIR)/nearest_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/nearest_r4.c' object='nearest_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r4.lo `test -f '$(srcdir)/generated/nearest_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/nearest_r4.c + +nearest_r8.lo: $(srcdir)/generated/nearest_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT nearest_r8.lo -MD -MP -MF $(DEPDIR)/nearest_r8.Tpo -c -o nearest_r8.lo `test -f '$(srcdir)/generated/nearest_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/nearest_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/nearest_r8.Tpo $(DEPDIR)/nearest_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/nearest_r8.c' object='nearest_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r8.lo `test -f '$(srcdir)/generated/nearest_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/nearest_r8.c + +nearest_r10.lo: $(srcdir)/generated/nearest_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT nearest_r10.lo -MD -MP -MF $(DEPDIR)/nearest_r10.Tpo -c -o nearest_r10.lo `test -f '$(srcdir)/generated/nearest_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/nearest_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/nearest_r10.Tpo $(DEPDIR)/nearest_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/nearest_r10.c' object='nearest_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r10.lo `test -f '$(srcdir)/generated/nearest_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/nearest_r10.c + +nearest_r16.lo: $(srcdir)/generated/nearest_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT nearest_r16.lo -MD -MP -MF $(DEPDIR)/nearest_r16.Tpo -c -o nearest_r16.lo `test -f '$(srcdir)/generated/nearest_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/nearest_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/nearest_r16.Tpo $(DEPDIR)/nearest_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/nearest_r16.c' object='nearest_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o nearest_r16.lo `test -f '$(srcdir)/generated/nearest_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/nearest_r16.c + +set_exponent_r4.lo: $(srcdir)/generated/set_exponent_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT set_exponent_r4.lo -MD -MP -MF $(DEPDIR)/set_exponent_r4.Tpo -c -o set_exponent_r4.lo `test -f '$(srcdir)/generated/set_exponent_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/set_exponent_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/set_exponent_r4.Tpo $(DEPDIR)/set_exponent_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/set_exponent_r4.c' object='set_exponent_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r4.lo `test -f '$(srcdir)/generated/set_exponent_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/set_exponent_r4.c + +set_exponent_r8.lo: $(srcdir)/generated/set_exponent_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT set_exponent_r8.lo -MD -MP -MF $(DEPDIR)/set_exponent_r8.Tpo -c -o set_exponent_r8.lo `test -f '$(srcdir)/generated/set_exponent_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/set_exponent_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/set_exponent_r8.Tpo $(DEPDIR)/set_exponent_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/set_exponent_r8.c' object='set_exponent_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r8.lo `test -f '$(srcdir)/generated/set_exponent_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/set_exponent_r8.c + +set_exponent_r10.lo: $(srcdir)/generated/set_exponent_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT set_exponent_r10.lo -MD -MP -MF $(DEPDIR)/set_exponent_r10.Tpo -c -o set_exponent_r10.lo `test -f '$(srcdir)/generated/set_exponent_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/set_exponent_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/set_exponent_r10.Tpo $(DEPDIR)/set_exponent_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/set_exponent_r10.c' object='set_exponent_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r10.lo `test -f '$(srcdir)/generated/set_exponent_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/set_exponent_r10.c + +set_exponent_r16.lo: $(srcdir)/generated/set_exponent_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT set_exponent_r16.lo -MD -MP -MF $(DEPDIR)/set_exponent_r16.Tpo -c -o set_exponent_r16.lo `test -f '$(srcdir)/generated/set_exponent_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/set_exponent_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/set_exponent_r16.Tpo $(DEPDIR)/set_exponent_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/set_exponent_r16.c' object='set_exponent_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o set_exponent_r16.lo `test -f '$(srcdir)/generated/set_exponent_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/set_exponent_r16.c + +pow_i4_i4.lo: $(srcdir)/generated/pow_i4_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_i4_i4.lo -MD -MP -MF $(DEPDIR)/pow_i4_i4.Tpo -c -o pow_i4_i4.lo `test -f '$(srcdir)/generated/pow_i4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i4_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_i4_i4.Tpo $(DEPDIR)/pow_i4_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_i4_i4.c' object='pow_i4_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i4.lo `test -f '$(srcdir)/generated/pow_i4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i4_i4.c + +pow_i8_i4.lo: $(srcdir)/generated/pow_i8_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_i8_i4.lo -MD -MP -MF $(DEPDIR)/pow_i8_i4.Tpo -c -o pow_i8_i4.lo `test -f '$(srcdir)/generated/pow_i8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i8_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_i8_i4.Tpo $(DEPDIR)/pow_i8_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_i8_i4.c' object='pow_i8_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i4.lo `test -f '$(srcdir)/generated/pow_i8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i8_i4.c + +pow_i16_i4.lo: $(srcdir)/generated/pow_i16_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_i16_i4.lo -MD -MP -MF $(DEPDIR)/pow_i16_i4.Tpo -c -o pow_i16_i4.lo `test -f '$(srcdir)/generated/pow_i16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i16_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_i16_i4.Tpo $(DEPDIR)/pow_i16_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_i16_i4.c' object='pow_i16_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i4.lo `test -f '$(srcdir)/generated/pow_i16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i16_i4.c + +pow_r16_i4.lo: $(srcdir)/generated/pow_r16_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_r16_i4.lo -MD -MP -MF $(DEPDIR)/pow_r16_i4.Tpo -c -o pow_r16_i4.lo `test -f '$(srcdir)/generated/pow_r16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r16_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_r16_i4.Tpo $(DEPDIR)/pow_r16_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_r16_i4.c' object='pow_r16_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i4.lo `test -f '$(srcdir)/generated/pow_r16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r16_i4.c + +pow_c4_i4.lo: $(srcdir)/generated/pow_c4_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c4_i4.lo -MD -MP -MF $(DEPDIR)/pow_c4_i4.Tpo -c -o pow_c4_i4.lo `test -f '$(srcdir)/generated/pow_c4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c4_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c4_i4.Tpo $(DEPDIR)/pow_c4_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c4_i4.c' object='pow_c4_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i4.lo `test -f '$(srcdir)/generated/pow_c4_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c4_i4.c + +pow_c8_i4.lo: $(srcdir)/generated/pow_c8_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c8_i4.lo -MD -MP -MF $(DEPDIR)/pow_c8_i4.Tpo -c -o pow_c8_i4.lo `test -f '$(srcdir)/generated/pow_c8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c8_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c8_i4.Tpo $(DEPDIR)/pow_c8_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c8_i4.c' object='pow_c8_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i4.lo `test -f '$(srcdir)/generated/pow_c8_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c8_i4.c + +pow_c10_i4.lo: $(srcdir)/generated/pow_c10_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c10_i4.lo -MD -MP -MF $(DEPDIR)/pow_c10_i4.Tpo -c -o pow_c10_i4.lo `test -f '$(srcdir)/generated/pow_c10_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c10_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c10_i4.Tpo $(DEPDIR)/pow_c10_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c10_i4.c' object='pow_c10_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i4.lo `test -f '$(srcdir)/generated/pow_c10_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c10_i4.c + +pow_c16_i4.lo: $(srcdir)/generated/pow_c16_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c16_i4.lo -MD -MP -MF $(DEPDIR)/pow_c16_i4.Tpo -c -o pow_c16_i4.lo `test -f '$(srcdir)/generated/pow_c16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c16_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c16_i4.Tpo $(DEPDIR)/pow_c16_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c16_i4.c' object='pow_c16_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i4.lo `test -f '$(srcdir)/generated/pow_c16_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c16_i4.c + +pow_i4_i8.lo: $(srcdir)/generated/pow_i4_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_i4_i8.lo -MD -MP -MF $(DEPDIR)/pow_i4_i8.Tpo -c -o pow_i4_i8.lo `test -f '$(srcdir)/generated/pow_i4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i4_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_i4_i8.Tpo $(DEPDIR)/pow_i4_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_i4_i8.c' object='pow_i4_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i8.lo `test -f '$(srcdir)/generated/pow_i4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i4_i8.c + +pow_i8_i8.lo: $(srcdir)/generated/pow_i8_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_i8_i8.lo -MD -MP -MF $(DEPDIR)/pow_i8_i8.Tpo -c -o pow_i8_i8.lo `test -f '$(srcdir)/generated/pow_i8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i8_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_i8_i8.Tpo $(DEPDIR)/pow_i8_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_i8_i8.c' object='pow_i8_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i8.lo `test -f '$(srcdir)/generated/pow_i8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i8_i8.c + +pow_i16_i8.lo: $(srcdir)/generated/pow_i16_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_i16_i8.lo -MD -MP -MF $(DEPDIR)/pow_i16_i8.Tpo -c -o pow_i16_i8.lo `test -f '$(srcdir)/generated/pow_i16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i16_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_i16_i8.Tpo $(DEPDIR)/pow_i16_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_i16_i8.c' object='pow_i16_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i8.lo `test -f '$(srcdir)/generated/pow_i16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i16_i8.c + +pow_r4_i8.lo: $(srcdir)/generated/pow_r4_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_r4_i8.lo -MD -MP -MF $(DEPDIR)/pow_r4_i8.Tpo -c -o pow_r4_i8.lo `test -f '$(srcdir)/generated/pow_r4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r4_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_r4_i8.Tpo $(DEPDIR)/pow_r4_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_r4_i8.c' object='pow_r4_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i8.lo `test -f '$(srcdir)/generated/pow_r4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r4_i8.c + +pow_r8_i8.lo: $(srcdir)/generated/pow_r8_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_r8_i8.lo -MD -MP -MF $(DEPDIR)/pow_r8_i8.Tpo -c -o pow_r8_i8.lo `test -f '$(srcdir)/generated/pow_r8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r8_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_r8_i8.Tpo $(DEPDIR)/pow_r8_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_r8_i8.c' object='pow_r8_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i8.lo `test -f '$(srcdir)/generated/pow_r8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r8_i8.c + +pow_r10_i8.lo: $(srcdir)/generated/pow_r10_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_r10_i8.lo -MD -MP -MF $(DEPDIR)/pow_r10_i8.Tpo -c -o pow_r10_i8.lo `test -f '$(srcdir)/generated/pow_r10_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r10_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_r10_i8.Tpo $(DEPDIR)/pow_r10_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_r10_i8.c' object='pow_r10_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i8.lo `test -f '$(srcdir)/generated/pow_r10_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r10_i8.c + +pow_r16_i8.lo: $(srcdir)/generated/pow_r16_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_r16_i8.lo -MD -MP -MF $(DEPDIR)/pow_r16_i8.Tpo -c -o pow_r16_i8.lo `test -f '$(srcdir)/generated/pow_r16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r16_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_r16_i8.Tpo $(DEPDIR)/pow_r16_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_r16_i8.c' object='pow_r16_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i8.lo `test -f '$(srcdir)/generated/pow_r16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r16_i8.c + +pow_c4_i8.lo: $(srcdir)/generated/pow_c4_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c4_i8.lo -MD -MP -MF $(DEPDIR)/pow_c4_i8.Tpo -c -o pow_c4_i8.lo `test -f '$(srcdir)/generated/pow_c4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c4_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c4_i8.Tpo $(DEPDIR)/pow_c4_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c4_i8.c' object='pow_c4_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i8.lo `test -f '$(srcdir)/generated/pow_c4_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c4_i8.c + +pow_c8_i8.lo: $(srcdir)/generated/pow_c8_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c8_i8.lo -MD -MP -MF $(DEPDIR)/pow_c8_i8.Tpo -c -o pow_c8_i8.lo `test -f '$(srcdir)/generated/pow_c8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c8_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c8_i8.Tpo $(DEPDIR)/pow_c8_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c8_i8.c' object='pow_c8_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i8.lo `test -f '$(srcdir)/generated/pow_c8_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c8_i8.c + +pow_c10_i8.lo: $(srcdir)/generated/pow_c10_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c10_i8.lo -MD -MP -MF $(DEPDIR)/pow_c10_i8.Tpo -c -o pow_c10_i8.lo `test -f '$(srcdir)/generated/pow_c10_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c10_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c10_i8.Tpo $(DEPDIR)/pow_c10_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c10_i8.c' object='pow_c10_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i8.lo `test -f '$(srcdir)/generated/pow_c10_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c10_i8.c + +pow_c16_i8.lo: $(srcdir)/generated/pow_c16_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c16_i8.lo -MD -MP -MF $(DEPDIR)/pow_c16_i8.Tpo -c -o pow_c16_i8.lo `test -f '$(srcdir)/generated/pow_c16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c16_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c16_i8.Tpo $(DEPDIR)/pow_c16_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c16_i8.c' object='pow_c16_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i8.lo `test -f '$(srcdir)/generated/pow_c16_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c16_i8.c + +pow_i4_i16.lo: $(srcdir)/generated/pow_i4_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_i4_i16.lo -MD -MP -MF $(DEPDIR)/pow_i4_i16.Tpo -c -o pow_i4_i16.lo `test -f '$(srcdir)/generated/pow_i4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i4_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_i4_i16.Tpo $(DEPDIR)/pow_i4_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_i4_i16.c' object='pow_i4_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i4_i16.lo `test -f '$(srcdir)/generated/pow_i4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i4_i16.c + +pow_i8_i16.lo: $(srcdir)/generated/pow_i8_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_i8_i16.lo -MD -MP -MF $(DEPDIR)/pow_i8_i16.Tpo -c -o pow_i8_i16.lo `test -f '$(srcdir)/generated/pow_i8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i8_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_i8_i16.Tpo $(DEPDIR)/pow_i8_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_i8_i16.c' object='pow_i8_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i8_i16.lo `test -f '$(srcdir)/generated/pow_i8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i8_i16.c + +pow_i16_i16.lo: $(srcdir)/generated/pow_i16_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_i16_i16.lo -MD -MP -MF $(DEPDIR)/pow_i16_i16.Tpo -c -o pow_i16_i16.lo `test -f '$(srcdir)/generated/pow_i16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i16_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_i16_i16.Tpo $(DEPDIR)/pow_i16_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_i16_i16.c' object='pow_i16_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_i16_i16.lo `test -f '$(srcdir)/generated/pow_i16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_i16_i16.c + +pow_r4_i16.lo: $(srcdir)/generated/pow_r4_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_r4_i16.lo -MD -MP -MF $(DEPDIR)/pow_r4_i16.Tpo -c -o pow_r4_i16.lo `test -f '$(srcdir)/generated/pow_r4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r4_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_r4_i16.Tpo $(DEPDIR)/pow_r4_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_r4_i16.c' object='pow_r4_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r4_i16.lo `test -f '$(srcdir)/generated/pow_r4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r4_i16.c + +pow_r8_i16.lo: $(srcdir)/generated/pow_r8_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_r8_i16.lo -MD -MP -MF $(DEPDIR)/pow_r8_i16.Tpo -c -o pow_r8_i16.lo `test -f '$(srcdir)/generated/pow_r8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r8_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_r8_i16.Tpo $(DEPDIR)/pow_r8_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_r8_i16.c' object='pow_r8_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r8_i16.lo `test -f '$(srcdir)/generated/pow_r8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r8_i16.c + +pow_r10_i16.lo: $(srcdir)/generated/pow_r10_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_r10_i16.lo -MD -MP -MF $(DEPDIR)/pow_r10_i16.Tpo -c -o pow_r10_i16.lo `test -f '$(srcdir)/generated/pow_r10_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r10_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_r10_i16.Tpo $(DEPDIR)/pow_r10_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_r10_i16.c' object='pow_r10_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r10_i16.lo `test -f '$(srcdir)/generated/pow_r10_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r10_i16.c + +pow_r16_i16.lo: $(srcdir)/generated/pow_r16_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_r16_i16.lo -MD -MP -MF $(DEPDIR)/pow_r16_i16.Tpo -c -o pow_r16_i16.lo `test -f '$(srcdir)/generated/pow_r16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r16_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_r16_i16.Tpo $(DEPDIR)/pow_r16_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_r16_i16.c' object='pow_r16_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_r16_i16.lo `test -f '$(srcdir)/generated/pow_r16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_r16_i16.c + +pow_c4_i16.lo: $(srcdir)/generated/pow_c4_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c4_i16.lo -MD -MP -MF $(DEPDIR)/pow_c4_i16.Tpo -c -o pow_c4_i16.lo `test -f '$(srcdir)/generated/pow_c4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c4_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c4_i16.Tpo $(DEPDIR)/pow_c4_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c4_i16.c' object='pow_c4_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c4_i16.lo `test -f '$(srcdir)/generated/pow_c4_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c4_i16.c + +pow_c8_i16.lo: $(srcdir)/generated/pow_c8_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c8_i16.lo -MD -MP -MF $(DEPDIR)/pow_c8_i16.Tpo -c -o pow_c8_i16.lo `test -f '$(srcdir)/generated/pow_c8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c8_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c8_i16.Tpo $(DEPDIR)/pow_c8_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c8_i16.c' object='pow_c8_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i16.lo `test -f '$(srcdir)/generated/pow_c8_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c8_i16.c + +pow_c10_i16.lo: $(srcdir)/generated/pow_c10_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c10_i16.lo -MD -MP -MF $(DEPDIR)/pow_c10_i16.Tpo -c -o pow_c10_i16.lo `test -f '$(srcdir)/generated/pow_c10_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c10_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c10_i16.Tpo $(DEPDIR)/pow_c10_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c10_i16.c' object='pow_c10_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c10_i16.lo `test -f '$(srcdir)/generated/pow_c10_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c10_i16.c + +pow_c16_i16.lo: $(srcdir)/generated/pow_c16_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pow_c16_i16.lo -MD -MP -MF $(DEPDIR)/pow_c16_i16.Tpo -c -o pow_c16_i16.lo `test -f '$(srcdir)/generated/pow_c16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c16_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pow_c16_i16.Tpo $(DEPDIR)/pow_c16_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pow_c16_i16.c' object='pow_c16_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c16_i16.lo `test -f '$(srcdir)/generated/pow_c16_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pow_c16_i16.c + +rrspacing_r4.lo: $(srcdir)/generated/rrspacing_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT rrspacing_r4.lo -MD -MP -MF $(DEPDIR)/rrspacing_r4.Tpo -c -o rrspacing_r4.lo `test -f '$(srcdir)/generated/rrspacing_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/rrspacing_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/rrspacing_r4.Tpo $(DEPDIR)/rrspacing_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/rrspacing_r4.c' object='rrspacing_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rrspacing_r4.lo `test -f '$(srcdir)/generated/rrspacing_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/rrspacing_r4.c + +rrspacing_r8.lo: $(srcdir)/generated/rrspacing_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT rrspacing_r8.lo -MD -MP -MF $(DEPDIR)/rrspacing_r8.Tpo -c -o rrspacing_r8.lo `test -f '$(srcdir)/generated/rrspacing_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/rrspacing_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/rrspacing_r8.Tpo $(DEPDIR)/rrspacing_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/rrspacing_r8.c' object='rrspacing_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rrspacing_r8.lo `test -f '$(srcdir)/generated/rrspacing_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/rrspacing_r8.c + +rrspacing_r10.lo: $(srcdir)/generated/rrspacing_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT rrspacing_r10.lo -MD -MP -MF $(DEPDIR)/rrspacing_r10.Tpo -c -o rrspacing_r10.lo `test -f '$(srcdir)/generated/rrspacing_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/rrspacing_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/rrspacing_r10.Tpo $(DEPDIR)/rrspacing_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/rrspacing_r10.c' object='rrspacing_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rrspacing_r10.lo `test -f '$(srcdir)/generated/rrspacing_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/rrspacing_r10.c + +rrspacing_r16.lo: $(srcdir)/generated/rrspacing_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT rrspacing_r16.lo -MD -MP -MF $(DEPDIR)/rrspacing_r16.Tpo -c -o rrspacing_r16.lo `test -f '$(srcdir)/generated/rrspacing_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/rrspacing_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/rrspacing_r16.Tpo $(DEPDIR)/rrspacing_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/rrspacing_r16.c' object='rrspacing_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rrspacing_r16.lo `test -f '$(srcdir)/generated/rrspacing_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/rrspacing_r16.c + +spacing_r4.lo: $(srcdir)/generated/spacing_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spacing_r4.lo -MD -MP -MF $(DEPDIR)/spacing_r4.Tpo -c -o spacing_r4.lo `test -f '$(srcdir)/generated/spacing_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spacing_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spacing_r4.Tpo $(DEPDIR)/spacing_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spacing_r4.c' object='spacing_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spacing_r4.lo `test -f '$(srcdir)/generated/spacing_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spacing_r4.c + +spacing_r8.lo: $(srcdir)/generated/spacing_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spacing_r8.lo -MD -MP -MF $(DEPDIR)/spacing_r8.Tpo -c -o spacing_r8.lo `test -f '$(srcdir)/generated/spacing_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spacing_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spacing_r8.Tpo $(DEPDIR)/spacing_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spacing_r8.c' object='spacing_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spacing_r8.lo `test -f '$(srcdir)/generated/spacing_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spacing_r8.c + +spacing_r10.lo: $(srcdir)/generated/spacing_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spacing_r10.lo -MD -MP -MF $(DEPDIR)/spacing_r10.Tpo -c -o spacing_r10.lo `test -f '$(srcdir)/generated/spacing_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/spacing_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spacing_r10.Tpo $(DEPDIR)/spacing_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spacing_r10.c' object='spacing_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spacing_r10.lo `test -f '$(srcdir)/generated/spacing_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/spacing_r10.c + +spacing_r16.lo: $(srcdir)/generated/spacing_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spacing_r16.lo -MD -MP -MF $(DEPDIR)/spacing_r16.Tpo -c -o spacing_r16.lo `test -f '$(srcdir)/generated/spacing_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spacing_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spacing_r16.Tpo $(DEPDIR)/spacing_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spacing_r16.c' object='spacing_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spacing_r16.lo `test -f '$(srcdir)/generated/spacing_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spacing_r16.c + +pack_i1.lo: $(srcdir)/generated/pack_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_i1.lo -MD -MP -MF $(DEPDIR)/pack_i1.Tpo -c -o pack_i1.lo `test -f '$(srcdir)/generated/pack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_i1.Tpo $(DEPDIR)/pack_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_i1.c' object='pack_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_i1.lo `test -f '$(srcdir)/generated/pack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i1.c + +pack_i2.lo: $(srcdir)/generated/pack_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_i2.lo -MD -MP -MF $(DEPDIR)/pack_i2.Tpo -c -o pack_i2.lo `test -f '$(srcdir)/generated/pack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_i2.Tpo $(DEPDIR)/pack_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_i2.c' object='pack_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_i2.lo `test -f '$(srcdir)/generated/pack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i2.c + +pack_i4.lo: $(srcdir)/generated/pack_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_i4.lo -MD -MP -MF $(DEPDIR)/pack_i4.Tpo -c -o pack_i4.lo `test -f '$(srcdir)/generated/pack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_i4.Tpo $(DEPDIR)/pack_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_i4.c' object='pack_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_i4.lo `test -f '$(srcdir)/generated/pack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i4.c + +pack_i8.lo: $(srcdir)/generated/pack_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_i8.lo -MD -MP -MF $(DEPDIR)/pack_i8.Tpo -c -o pack_i8.lo `test -f '$(srcdir)/generated/pack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_i8.Tpo $(DEPDIR)/pack_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_i8.c' object='pack_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_i8.lo `test -f '$(srcdir)/generated/pack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i8.c + +pack_i16.lo: $(srcdir)/generated/pack_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_i16.lo -MD -MP -MF $(DEPDIR)/pack_i16.Tpo -c -o pack_i16.lo `test -f '$(srcdir)/generated/pack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_i16.Tpo $(DEPDIR)/pack_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_i16.c' object='pack_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_i16.lo `test -f '$(srcdir)/generated/pack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_i16.c + +pack_r4.lo: $(srcdir)/generated/pack_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_r4.lo -MD -MP -MF $(DEPDIR)/pack_r4.Tpo -c -o pack_r4.lo `test -f '$(srcdir)/generated/pack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_r4.Tpo $(DEPDIR)/pack_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_r4.c' object='pack_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_r4.lo `test -f '$(srcdir)/generated/pack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r4.c + +pack_r8.lo: $(srcdir)/generated/pack_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_r8.lo -MD -MP -MF $(DEPDIR)/pack_r8.Tpo -c -o pack_r8.lo `test -f '$(srcdir)/generated/pack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_r8.Tpo $(DEPDIR)/pack_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_r8.c' object='pack_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_r8.lo `test -f '$(srcdir)/generated/pack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r8.c + +pack_r10.lo: $(srcdir)/generated/pack_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_r10.lo -MD -MP -MF $(DEPDIR)/pack_r10.Tpo -c -o pack_r10.lo `test -f '$(srcdir)/generated/pack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_r10.Tpo $(DEPDIR)/pack_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_r10.c' object='pack_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_r10.lo `test -f '$(srcdir)/generated/pack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r10.c + +pack_r16.lo: $(srcdir)/generated/pack_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_r16.lo -MD -MP -MF $(DEPDIR)/pack_r16.Tpo -c -o pack_r16.lo `test -f '$(srcdir)/generated/pack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_r16.Tpo $(DEPDIR)/pack_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_r16.c' object='pack_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_r16.lo `test -f '$(srcdir)/generated/pack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_r16.c + +pack_c4.lo: $(srcdir)/generated/pack_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_c4.lo -MD -MP -MF $(DEPDIR)/pack_c4.Tpo -c -o pack_c4.lo `test -f '$(srcdir)/generated/pack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_c4.Tpo $(DEPDIR)/pack_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_c4.c' object='pack_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_c4.lo `test -f '$(srcdir)/generated/pack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c4.c + +pack_c8.lo: $(srcdir)/generated/pack_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_c8.lo -MD -MP -MF $(DEPDIR)/pack_c8.Tpo -c -o pack_c8.lo `test -f '$(srcdir)/generated/pack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_c8.Tpo $(DEPDIR)/pack_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_c8.c' object='pack_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_c8.lo `test -f '$(srcdir)/generated/pack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c8.c + +pack_c10.lo: $(srcdir)/generated/pack_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_c10.lo -MD -MP -MF $(DEPDIR)/pack_c10.Tpo -c -o pack_c10.lo `test -f '$(srcdir)/generated/pack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_c10.Tpo $(DEPDIR)/pack_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_c10.c' object='pack_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_c10.lo `test -f '$(srcdir)/generated/pack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c10.c + +pack_c16.lo: $(srcdir)/generated/pack_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_c16.lo -MD -MP -MF $(DEPDIR)/pack_c16.Tpo -c -o pack_c16.lo `test -f '$(srcdir)/generated/pack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_c16.Tpo $(DEPDIR)/pack_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/pack_c16.c' object='pack_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_c16.lo `test -f '$(srcdir)/generated/pack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/pack_c16.c + +unpack_i1.lo: $(srcdir)/generated/unpack_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_i1.lo -MD -MP -MF $(DEPDIR)/unpack_i1.Tpo -c -o unpack_i1.lo `test -f '$(srcdir)/generated/unpack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_i1.Tpo $(DEPDIR)/unpack_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_i1.c' object='unpack_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_i1.lo `test -f '$(srcdir)/generated/unpack_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i1.c + +unpack_i2.lo: $(srcdir)/generated/unpack_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_i2.lo -MD -MP -MF $(DEPDIR)/unpack_i2.Tpo -c -o unpack_i2.lo `test -f '$(srcdir)/generated/unpack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_i2.Tpo $(DEPDIR)/unpack_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_i2.c' object='unpack_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_i2.lo `test -f '$(srcdir)/generated/unpack_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i2.c + +unpack_i4.lo: $(srcdir)/generated/unpack_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_i4.lo -MD -MP -MF $(DEPDIR)/unpack_i4.Tpo -c -o unpack_i4.lo `test -f '$(srcdir)/generated/unpack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_i4.Tpo $(DEPDIR)/unpack_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_i4.c' object='unpack_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_i4.lo `test -f '$(srcdir)/generated/unpack_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i4.c + +unpack_i8.lo: $(srcdir)/generated/unpack_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_i8.lo -MD -MP -MF $(DEPDIR)/unpack_i8.Tpo -c -o unpack_i8.lo `test -f '$(srcdir)/generated/unpack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_i8.Tpo $(DEPDIR)/unpack_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_i8.c' object='unpack_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_i8.lo `test -f '$(srcdir)/generated/unpack_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i8.c + +unpack_i16.lo: $(srcdir)/generated/unpack_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_i16.lo -MD -MP -MF $(DEPDIR)/unpack_i16.Tpo -c -o unpack_i16.lo `test -f '$(srcdir)/generated/unpack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_i16.Tpo $(DEPDIR)/unpack_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_i16.c' object='unpack_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_i16.lo `test -f '$(srcdir)/generated/unpack_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_i16.c + +unpack_r4.lo: $(srcdir)/generated/unpack_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_r4.lo -MD -MP -MF $(DEPDIR)/unpack_r4.Tpo -c -o unpack_r4.lo `test -f '$(srcdir)/generated/unpack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_r4.Tpo $(DEPDIR)/unpack_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_r4.c' object='unpack_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_r4.lo `test -f '$(srcdir)/generated/unpack_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r4.c + +unpack_r8.lo: $(srcdir)/generated/unpack_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_r8.lo -MD -MP -MF $(DEPDIR)/unpack_r8.Tpo -c -o unpack_r8.lo `test -f '$(srcdir)/generated/unpack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_r8.Tpo $(DEPDIR)/unpack_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_r8.c' object='unpack_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_r8.lo `test -f '$(srcdir)/generated/unpack_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r8.c + +unpack_r10.lo: $(srcdir)/generated/unpack_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_r10.lo -MD -MP -MF $(DEPDIR)/unpack_r10.Tpo -c -o unpack_r10.lo `test -f '$(srcdir)/generated/unpack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_r10.Tpo $(DEPDIR)/unpack_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_r10.c' object='unpack_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_r10.lo `test -f '$(srcdir)/generated/unpack_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r10.c + +unpack_r16.lo: $(srcdir)/generated/unpack_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_r16.lo -MD -MP -MF $(DEPDIR)/unpack_r16.Tpo -c -o unpack_r16.lo `test -f '$(srcdir)/generated/unpack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_r16.Tpo $(DEPDIR)/unpack_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_r16.c' object='unpack_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_r16.lo `test -f '$(srcdir)/generated/unpack_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_r16.c + +unpack_c4.lo: $(srcdir)/generated/unpack_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_c4.lo -MD -MP -MF $(DEPDIR)/unpack_c4.Tpo -c -o unpack_c4.lo `test -f '$(srcdir)/generated/unpack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_c4.Tpo $(DEPDIR)/unpack_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_c4.c' object='unpack_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_c4.lo `test -f '$(srcdir)/generated/unpack_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c4.c + +unpack_c8.lo: $(srcdir)/generated/unpack_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_c8.lo -MD -MP -MF $(DEPDIR)/unpack_c8.Tpo -c -o unpack_c8.lo `test -f '$(srcdir)/generated/unpack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_c8.Tpo $(DEPDIR)/unpack_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_c8.c' object='unpack_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_c8.lo `test -f '$(srcdir)/generated/unpack_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c8.c + +unpack_c10.lo: $(srcdir)/generated/unpack_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_c10.lo -MD -MP -MF $(DEPDIR)/unpack_c10.Tpo -c -o unpack_c10.lo `test -f '$(srcdir)/generated/unpack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_c10.Tpo $(DEPDIR)/unpack_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_c10.c' object='unpack_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_c10.lo `test -f '$(srcdir)/generated/unpack_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c10.c + +unpack_c16.lo: $(srcdir)/generated/unpack_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_c16.lo -MD -MP -MF $(DEPDIR)/unpack_c16.Tpo -c -o unpack_c16.lo `test -f '$(srcdir)/generated/unpack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_c16.Tpo $(DEPDIR)/unpack_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/unpack_c16.c' object='unpack_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_c16.lo `test -f '$(srcdir)/generated/unpack_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/unpack_c16.c + +spread_i1.lo: $(srcdir)/generated/spread_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_i1.lo -MD -MP -MF $(DEPDIR)/spread_i1.Tpo -c -o spread_i1.lo `test -f '$(srcdir)/generated/spread_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_i1.Tpo $(DEPDIR)/spread_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_i1.c' object='spread_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_i1.lo `test -f '$(srcdir)/generated/spread_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i1.c + +spread_i2.lo: $(srcdir)/generated/spread_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_i2.lo -MD -MP -MF $(DEPDIR)/spread_i2.Tpo -c -o spread_i2.lo `test -f '$(srcdir)/generated/spread_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_i2.Tpo $(DEPDIR)/spread_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_i2.c' object='spread_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_i2.lo `test -f '$(srcdir)/generated/spread_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i2.c + +spread_i4.lo: $(srcdir)/generated/spread_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_i4.lo -MD -MP -MF $(DEPDIR)/spread_i4.Tpo -c -o spread_i4.lo `test -f '$(srcdir)/generated/spread_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_i4.Tpo $(DEPDIR)/spread_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_i4.c' object='spread_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_i4.lo `test -f '$(srcdir)/generated/spread_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i4.c + +spread_i8.lo: $(srcdir)/generated/spread_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_i8.lo -MD -MP -MF $(DEPDIR)/spread_i8.Tpo -c -o spread_i8.lo `test -f '$(srcdir)/generated/spread_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_i8.Tpo $(DEPDIR)/spread_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_i8.c' object='spread_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_i8.lo `test -f '$(srcdir)/generated/spread_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i8.c + +spread_i16.lo: $(srcdir)/generated/spread_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_i16.lo -MD -MP -MF $(DEPDIR)/spread_i16.Tpo -c -o spread_i16.lo `test -f '$(srcdir)/generated/spread_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_i16.Tpo $(DEPDIR)/spread_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_i16.c' object='spread_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_i16.lo `test -f '$(srcdir)/generated/spread_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_i16.c + +spread_r4.lo: $(srcdir)/generated/spread_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_r4.lo -MD -MP -MF $(DEPDIR)/spread_r4.Tpo -c -o spread_r4.lo `test -f '$(srcdir)/generated/spread_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_r4.Tpo $(DEPDIR)/spread_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_r4.c' object='spread_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_r4.lo `test -f '$(srcdir)/generated/spread_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r4.c + +spread_r8.lo: $(srcdir)/generated/spread_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_r8.lo -MD -MP -MF $(DEPDIR)/spread_r8.Tpo -c -o spread_r8.lo `test -f '$(srcdir)/generated/spread_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_r8.Tpo $(DEPDIR)/spread_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_r8.c' object='spread_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_r8.lo `test -f '$(srcdir)/generated/spread_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r8.c + +spread_r10.lo: $(srcdir)/generated/spread_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_r10.lo -MD -MP -MF $(DEPDIR)/spread_r10.Tpo -c -o spread_r10.lo `test -f '$(srcdir)/generated/spread_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_r10.Tpo $(DEPDIR)/spread_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_r10.c' object='spread_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_r10.lo `test -f '$(srcdir)/generated/spread_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r10.c + +spread_r16.lo: $(srcdir)/generated/spread_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_r16.lo -MD -MP -MF $(DEPDIR)/spread_r16.Tpo -c -o spread_r16.lo `test -f '$(srcdir)/generated/spread_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_r16.Tpo $(DEPDIR)/spread_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_r16.c' object='spread_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_r16.lo `test -f '$(srcdir)/generated/spread_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_r16.c + +spread_c4.lo: $(srcdir)/generated/spread_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_c4.lo -MD -MP -MF $(DEPDIR)/spread_c4.Tpo -c -o spread_c4.lo `test -f '$(srcdir)/generated/spread_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_c4.Tpo $(DEPDIR)/spread_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_c4.c' object='spread_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_c4.lo `test -f '$(srcdir)/generated/spread_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c4.c + +spread_c8.lo: $(srcdir)/generated/spread_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_c8.lo -MD -MP -MF $(DEPDIR)/spread_c8.Tpo -c -o spread_c8.lo `test -f '$(srcdir)/generated/spread_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_c8.Tpo $(DEPDIR)/spread_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_c8.c' object='spread_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_c8.lo `test -f '$(srcdir)/generated/spread_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c8.c + +spread_c10.lo: $(srcdir)/generated/spread_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_c10.lo -MD -MP -MF $(DEPDIR)/spread_c10.Tpo -c -o spread_c10.lo `test -f '$(srcdir)/generated/spread_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_c10.Tpo $(DEPDIR)/spread_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_c10.c' object='spread_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_c10.lo `test -f '$(srcdir)/generated/spread_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c10.c + +spread_c16.lo: $(srcdir)/generated/spread_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_c16.lo -MD -MP -MF $(DEPDIR)/spread_c16.Tpo -c -o spread_c16.lo `test -f '$(srcdir)/generated/spread_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_c16.Tpo $(DEPDIR)/spread_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/spread_c16.c' object='spread_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_c16.lo `test -f '$(srcdir)/generated/spread_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/spread_c16.c + +cshift0_i1.lo: $(srcdir)/generated/cshift0_i1.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i1.lo -MD -MP -MF $(DEPDIR)/cshift0_i1.Tpo -c -o cshift0_i1.lo `test -f '$(srcdir)/generated/cshift0_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i1.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_i1.Tpo $(DEPDIR)/cshift0_i1.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i1.c' object='cshift0_i1.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_i1.lo `test -f '$(srcdir)/generated/cshift0_i1.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i1.c + +cshift0_i2.lo: $(srcdir)/generated/cshift0_i2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i2.lo -MD -MP -MF $(DEPDIR)/cshift0_i2.Tpo -c -o cshift0_i2.lo `test -f '$(srcdir)/generated/cshift0_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_i2.Tpo $(DEPDIR)/cshift0_i2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i2.c' object='cshift0_i2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_i2.lo `test -f '$(srcdir)/generated/cshift0_i2.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i2.c + +cshift0_i4.lo: $(srcdir)/generated/cshift0_i4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i4.lo -MD -MP -MF $(DEPDIR)/cshift0_i4.Tpo -c -o cshift0_i4.lo `test -f '$(srcdir)/generated/cshift0_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_i4.Tpo $(DEPDIR)/cshift0_i4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i4.c' object='cshift0_i4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_i4.lo `test -f '$(srcdir)/generated/cshift0_i4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i4.c + +cshift0_i8.lo: $(srcdir)/generated/cshift0_i8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i8.lo -MD -MP -MF $(DEPDIR)/cshift0_i8.Tpo -c -o cshift0_i8.lo `test -f '$(srcdir)/generated/cshift0_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_i8.Tpo $(DEPDIR)/cshift0_i8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i8.c' object='cshift0_i8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_i8.lo `test -f '$(srcdir)/generated/cshift0_i8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i8.c + +cshift0_i16.lo: $(srcdir)/generated/cshift0_i16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_i16.lo -MD -MP -MF $(DEPDIR)/cshift0_i16.Tpo -c -o cshift0_i16.lo `test -f '$(srcdir)/generated/cshift0_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_i16.Tpo $(DEPDIR)/cshift0_i16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_i16.c' object='cshift0_i16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_i16.lo `test -f '$(srcdir)/generated/cshift0_i16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_i16.c + +cshift0_r4.lo: $(srcdir)/generated/cshift0_r4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r4.lo -MD -MP -MF $(DEPDIR)/cshift0_r4.Tpo -c -o cshift0_r4.lo `test -f '$(srcdir)/generated/cshift0_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_r4.Tpo $(DEPDIR)/cshift0_r4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r4.c' object='cshift0_r4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_r4.lo `test -f '$(srcdir)/generated/cshift0_r4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r4.c + +cshift0_r8.lo: $(srcdir)/generated/cshift0_r8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r8.lo -MD -MP -MF $(DEPDIR)/cshift0_r8.Tpo -c -o cshift0_r8.lo `test -f '$(srcdir)/generated/cshift0_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_r8.Tpo $(DEPDIR)/cshift0_r8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r8.c' object='cshift0_r8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_r8.lo `test -f '$(srcdir)/generated/cshift0_r8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r8.c + +cshift0_r10.lo: $(srcdir)/generated/cshift0_r10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r10.lo -MD -MP -MF $(DEPDIR)/cshift0_r10.Tpo -c -o cshift0_r10.lo `test -f '$(srcdir)/generated/cshift0_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_r10.Tpo $(DEPDIR)/cshift0_r10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r10.c' object='cshift0_r10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_r10.lo `test -f '$(srcdir)/generated/cshift0_r10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r10.c + +cshift0_r16.lo: $(srcdir)/generated/cshift0_r16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_r16.lo -MD -MP -MF $(DEPDIR)/cshift0_r16.Tpo -c -o cshift0_r16.lo `test -f '$(srcdir)/generated/cshift0_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_r16.Tpo $(DEPDIR)/cshift0_r16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_r16.c' object='cshift0_r16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_r16.lo `test -f '$(srcdir)/generated/cshift0_r16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_r16.c + +cshift0_c4.lo: $(srcdir)/generated/cshift0_c4.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c4.lo -MD -MP -MF $(DEPDIR)/cshift0_c4.Tpo -c -o cshift0_c4.lo `test -f '$(srcdir)/generated/cshift0_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c4.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_c4.Tpo $(DEPDIR)/cshift0_c4.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c4.c' object='cshift0_c4.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_c4.lo `test -f '$(srcdir)/generated/cshift0_c4.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c4.c + +cshift0_c8.lo: $(srcdir)/generated/cshift0_c8.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c8.lo -MD -MP -MF $(DEPDIR)/cshift0_c8.Tpo -c -o cshift0_c8.lo `test -f '$(srcdir)/generated/cshift0_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c8.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_c8.Tpo $(DEPDIR)/cshift0_c8.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c8.c' object='cshift0_c8.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_c8.lo `test -f '$(srcdir)/generated/cshift0_c8.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c8.c + +cshift0_c10.lo: $(srcdir)/generated/cshift0_c10.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c10.lo -MD -MP -MF $(DEPDIR)/cshift0_c10.Tpo -c -o cshift0_c10.lo `test -f '$(srcdir)/generated/cshift0_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c10.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_c10.Tpo $(DEPDIR)/cshift0_c10.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c10.c' object='cshift0_c10.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_c10.lo `test -f '$(srcdir)/generated/cshift0_c10.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c10.c + +cshift0_c16.lo: $(srcdir)/generated/cshift0_c16.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0_c16.lo -MD -MP -MF $(DEPDIR)/cshift0_c16.Tpo -c -o cshift0_c16.lo `test -f '$(srcdir)/generated/cshift0_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c16.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0_c16.Tpo $(DEPDIR)/cshift0_c16.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$(srcdir)/generated/cshift0_c16.c' object='cshift0_c16.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0_c16.lo `test -f '$(srcdir)/generated/cshift0_c16.c' || echo '$(srcdir)/'`$(srcdir)/generated/cshift0_c16.c + +close.lo: io/close.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT close.lo -MD -MP -MF $(DEPDIR)/close.Tpo -c -o close.lo `test -f 'io/close.c' || echo '$(srcdir)/'`io/close.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/close.Tpo $(DEPDIR)/close.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/close.c' object='close.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o close.lo `test -f 'io/close.c' || echo '$(srcdir)/'`io/close.c + +file_pos.lo: io/file_pos.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT file_pos.lo -MD -MP -MF $(DEPDIR)/file_pos.Tpo -c -o file_pos.lo `test -f 'io/file_pos.c' || echo '$(srcdir)/'`io/file_pos.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/file_pos.Tpo $(DEPDIR)/file_pos.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/file_pos.c' object='file_pos.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o file_pos.lo `test -f 'io/file_pos.c' || echo '$(srcdir)/'`io/file_pos.c + +format.lo: io/format.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT format.lo -MD -MP -MF $(DEPDIR)/format.Tpo -c -o format.lo `test -f 'io/format.c' || echo '$(srcdir)/'`io/format.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/format.Tpo $(DEPDIR)/format.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/format.c' object='format.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o format.lo `test -f 'io/format.c' || echo '$(srcdir)/'`io/format.c + +inquire.lo: io/inquire.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT inquire.lo -MD -MP -MF $(DEPDIR)/inquire.Tpo -c -o inquire.lo `test -f 'io/inquire.c' || echo '$(srcdir)/'`io/inquire.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/inquire.Tpo $(DEPDIR)/inquire.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/inquire.c' object='inquire.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o inquire.lo `test -f 'io/inquire.c' || echo '$(srcdir)/'`io/inquire.c + +intrinsics.lo: io/intrinsics.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT intrinsics.lo -MD -MP -MF $(DEPDIR)/intrinsics.Tpo -c -o intrinsics.lo `test -f 'io/intrinsics.c' || echo '$(srcdir)/'`io/intrinsics.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/intrinsics.Tpo $(DEPDIR)/intrinsics.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/intrinsics.c' object='intrinsics.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o intrinsics.lo `test -f 'io/intrinsics.c' || echo '$(srcdir)/'`io/intrinsics.c + +list_read.lo: io/list_read.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT list_read.lo -MD -MP -MF $(DEPDIR)/list_read.Tpo -c -o list_read.lo `test -f 'io/list_read.c' || echo '$(srcdir)/'`io/list_read.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/list_read.Tpo $(DEPDIR)/list_read.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/list_read.c' object='list_read.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o list_read.lo `test -f 'io/list_read.c' || echo '$(srcdir)/'`io/list_read.c + +lock.lo: io/lock.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT lock.lo -MD -MP -MF $(DEPDIR)/lock.Tpo -c -o lock.lo `test -f 'io/lock.c' || echo '$(srcdir)/'`io/lock.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/lock.Tpo $(DEPDIR)/lock.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/lock.c' object='lock.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o lock.lo `test -f 'io/lock.c' || echo '$(srcdir)/'`io/lock.c + +open.lo: io/open.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT open.lo -MD -MP -MF $(DEPDIR)/open.Tpo -c -o open.lo `test -f 'io/open.c' || echo '$(srcdir)/'`io/open.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/open.Tpo $(DEPDIR)/open.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/open.c' object='open.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o open.lo `test -f 'io/open.c' || echo '$(srcdir)/'`io/open.c + +read.lo: io/read.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT read.lo -MD -MP -MF $(DEPDIR)/read.Tpo -c -o read.lo `test -f 'io/read.c' || echo '$(srcdir)/'`io/read.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/read.Tpo $(DEPDIR)/read.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/read.c' object='read.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o read.lo `test -f 'io/read.c' || echo '$(srcdir)/'`io/read.c + +size_from_kind.lo: io/size_from_kind.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT size_from_kind.lo -MD -MP -MF $(DEPDIR)/size_from_kind.Tpo -c -o size_from_kind.lo `test -f 'io/size_from_kind.c' || echo '$(srcdir)/'`io/size_from_kind.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/size_from_kind.Tpo $(DEPDIR)/size_from_kind.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/size_from_kind.c' object='size_from_kind.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o size_from_kind.lo `test -f 'io/size_from_kind.c' || echo '$(srcdir)/'`io/size_from_kind.c + +transfer.lo: io/transfer.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transfer.lo -MD -MP -MF $(DEPDIR)/transfer.Tpo -c -o transfer.lo `test -f 'io/transfer.c' || echo '$(srcdir)/'`io/transfer.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transfer.Tpo $(DEPDIR)/transfer.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/transfer.c' object='transfer.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transfer.lo `test -f 'io/transfer.c' || echo '$(srcdir)/'`io/transfer.c + +transfer128.lo: io/transfer128.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transfer128.lo -MD -MP -MF $(DEPDIR)/transfer128.Tpo -c -o transfer128.lo `test -f 'io/transfer128.c' || echo '$(srcdir)/'`io/transfer128.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transfer128.Tpo $(DEPDIR)/transfer128.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/transfer128.c' object='transfer128.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transfer128.lo `test -f 'io/transfer128.c' || echo '$(srcdir)/'`io/transfer128.c + +unit.lo: io/unit.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unit.lo -MD -MP -MF $(DEPDIR)/unit.Tpo -c -o unit.lo `test -f 'io/unit.c' || echo '$(srcdir)/'`io/unit.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unit.Tpo $(DEPDIR)/unit.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/unit.c' object='unit.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unit.lo `test -f 'io/unit.c' || echo '$(srcdir)/'`io/unit.c + +unix.lo: io/unix.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unix.lo -MD -MP -MF $(DEPDIR)/unix.Tpo -c -o unix.lo `test -f 'io/unix.c' || echo '$(srcdir)/'`io/unix.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unix.Tpo $(DEPDIR)/unix.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/unix.c' object='unix.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unix.lo `test -f 'io/unix.c' || echo '$(srcdir)/'`io/unix.c + +write.lo: io/write.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT write.lo -MD -MP -MF $(DEPDIR)/write.Tpo -c -o write.lo `test -f 'io/write.c' || echo '$(srcdir)/'`io/write.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/write.Tpo $(DEPDIR)/write.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/write.c' object='write.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o write.lo `test -f 'io/write.c' || echo '$(srcdir)/'`io/write.c + +fbuf.lo: io/fbuf.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fbuf.lo -MD -MP -MF $(DEPDIR)/fbuf.Tpo -c -o fbuf.lo `test -f 'io/fbuf.c' || echo '$(srcdir)/'`io/fbuf.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/fbuf.Tpo $(DEPDIR)/fbuf.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='io/fbuf.c' object='fbuf.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fbuf.lo `test -f 'io/fbuf.c' || echo '$(srcdir)/'`io/fbuf.c + +associated.lo: intrinsics/associated.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT associated.lo -MD -MP -MF $(DEPDIR)/associated.Tpo -c -o associated.lo `test -f 'intrinsics/associated.c' || echo '$(srcdir)/'`intrinsics/associated.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/associated.Tpo $(DEPDIR)/associated.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/associated.c' object='associated.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o associated.lo `test -f 'intrinsics/associated.c' || echo '$(srcdir)/'`intrinsics/associated.c + +abort.lo: intrinsics/abort.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT abort.lo -MD -MP -MF $(DEPDIR)/abort.Tpo -c -o abort.lo `test -f 'intrinsics/abort.c' || echo '$(srcdir)/'`intrinsics/abort.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/abort.Tpo $(DEPDIR)/abort.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/abort.c' object='abort.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o abort.lo `test -f 'intrinsics/abort.c' || echo '$(srcdir)/'`intrinsics/abort.c + +access.lo: intrinsics/access.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT access.lo -MD -MP -MF $(DEPDIR)/access.Tpo -c -o access.lo `test -f 'intrinsics/access.c' || echo '$(srcdir)/'`intrinsics/access.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/access.Tpo $(DEPDIR)/access.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/access.c' object='access.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o access.lo `test -f 'intrinsics/access.c' || echo '$(srcdir)/'`intrinsics/access.c + +args.lo: intrinsics/args.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT args.lo -MD -MP -MF $(DEPDIR)/args.Tpo -c -o args.lo `test -f 'intrinsics/args.c' || echo '$(srcdir)/'`intrinsics/args.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/args.Tpo $(DEPDIR)/args.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/args.c' object='args.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o args.lo `test -f 'intrinsics/args.c' || echo '$(srcdir)/'`intrinsics/args.c + +bit_intrinsics.lo: intrinsics/bit_intrinsics.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT bit_intrinsics.lo -MD -MP -MF $(DEPDIR)/bit_intrinsics.Tpo -c -o bit_intrinsics.lo `test -f 'intrinsics/bit_intrinsics.c' || echo '$(srcdir)/'`intrinsics/bit_intrinsics.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/bit_intrinsics.Tpo $(DEPDIR)/bit_intrinsics.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/bit_intrinsics.c' object='bit_intrinsics.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bit_intrinsics.lo `test -f 'intrinsics/bit_intrinsics.c' || echo '$(srcdir)/'`intrinsics/bit_intrinsics.c + +c99_functions.lo: intrinsics/c99_functions.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT c99_functions.lo -MD -MP -MF $(DEPDIR)/c99_functions.Tpo -c -o c99_functions.lo `test -f 'intrinsics/c99_functions.c' || echo '$(srcdir)/'`intrinsics/c99_functions.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/c99_functions.Tpo $(DEPDIR)/c99_functions.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/c99_functions.c' object='c99_functions.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o c99_functions.lo `test -f 'intrinsics/c99_functions.c' || echo '$(srcdir)/'`intrinsics/c99_functions.c + +chdir.lo: intrinsics/chdir.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT chdir.lo -MD -MP -MF $(DEPDIR)/chdir.Tpo -c -o chdir.lo `test -f 'intrinsics/chdir.c' || echo '$(srcdir)/'`intrinsics/chdir.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/chdir.Tpo $(DEPDIR)/chdir.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/chdir.c' object='chdir.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o chdir.lo `test -f 'intrinsics/chdir.c' || echo '$(srcdir)/'`intrinsics/chdir.c + +chmod.lo: intrinsics/chmod.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT chmod.lo -MD -MP -MF $(DEPDIR)/chmod.Tpo -c -o chmod.lo `test -f 'intrinsics/chmod.c' || echo '$(srcdir)/'`intrinsics/chmod.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/chmod.Tpo $(DEPDIR)/chmod.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/chmod.c' object='chmod.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o chmod.lo `test -f 'intrinsics/chmod.c' || echo '$(srcdir)/'`intrinsics/chmod.c + +clock.lo: intrinsics/clock.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT clock.lo -MD -MP -MF $(DEPDIR)/clock.Tpo -c -o clock.lo `test -f 'intrinsics/clock.c' || echo '$(srcdir)/'`intrinsics/clock.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/clock.Tpo $(DEPDIR)/clock.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/clock.c' object='clock.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o clock.lo `test -f 'intrinsics/clock.c' || echo '$(srcdir)/'`intrinsics/clock.c + +cpu_time.lo: intrinsics/cpu_time.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cpu_time.lo -MD -MP -MF $(DEPDIR)/cpu_time.Tpo -c -o cpu_time.lo `test -f 'intrinsics/cpu_time.c' || echo '$(srcdir)/'`intrinsics/cpu_time.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cpu_time.Tpo $(DEPDIR)/cpu_time.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/cpu_time.c' object='cpu_time.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cpu_time.lo `test -f 'intrinsics/cpu_time.c' || echo '$(srcdir)/'`intrinsics/cpu_time.c + +cshift0.lo: intrinsics/cshift0.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT cshift0.lo -MD -MP -MF $(DEPDIR)/cshift0.Tpo -c -o cshift0.lo `test -f 'intrinsics/cshift0.c' || echo '$(srcdir)/'`intrinsics/cshift0.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/cshift0.Tpo $(DEPDIR)/cshift0.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/cshift0.c' object='cshift0.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0.lo `test -f 'intrinsics/cshift0.c' || echo '$(srcdir)/'`intrinsics/cshift0.c + +ctime.lo: intrinsics/ctime.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT ctime.lo -MD -MP -MF $(DEPDIR)/ctime.Tpo -c -o ctime.lo `test -f 'intrinsics/ctime.c' || echo '$(srcdir)/'`intrinsics/ctime.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/ctime.Tpo $(DEPDIR)/ctime.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/ctime.c' object='ctime.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ctime.lo `test -f 'intrinsics/ctime.c' || echo '$(srcdir)/'`intrinsics/ctime.c + +date_and_time.lo: intrinsics/date_and_time.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT date_and_time.lo -MD -MP -MF $(DEPDIR)/date_and_time.Tpo -c -o date_and_time.lo `test -f 'intrinsics/date_and_time.c' || echo '$(srcdir)/'`intrinsics/date_and_time.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/date_and_time.Tpo $(DEPDIR)/date_and_time.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/date_and_time.c' object='date_and_time.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o date_and_time.lo `test -f 'intrinsics/date_and_time.c' || echo '$(srcdir)/'`intrinsics/date_and_time.c + +dtime.lo: intrinsics/dtime.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT dtime.lo -MD -MP -MF $(DEPDIR)/dtime.Tpo -c -o dtime.lo `test -f 'intrinsics/dtime.c' || echo '$(srcdir)/'`intrinsics/dtime.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/dtime.Tpo $(DEPDIR)/dtime.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/dtime.c' object='dtime.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o dtime.lo `test -f 'intrinsics/dtime.c' || echo '$(srcdir)/'`intrinsics/dtime.c + +env.lo: intrinsics/env.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT env.lo -MD -MP -MF $(DEPDIR)/env.Tpo -c -o env.lo `test -f 'intrinsics/env.c' || echo '$(srcdir)/'`intrinsics/env.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/env.Tpo $(DEPDIR)/env.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/env.c' object='env.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o env.lo `test -f 'intrinsics/env.c' || echo '$(srcdir)/'`intrinsics/env.c + +eoshift0.lo: intrinsics/eoshift0.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT eoshift0.lo -MD -MP -MF $(DEPDIR)/eoshift0.Tpo -c -o eoshift0.lo `test -f 'intrinsics/eoshift0.c' || echo '$(srcdir)/'`intrinsics/eoshift0.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/eoshift0.Tpo $(DEPDIR)/eoshift0.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/eoshift0.c' object='eoshift0.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift0.lo `test -f 'intrinsics/eoshift0.c' || echo '$(srcdir)/'`intrinsics/eoshift0.c + +eoshift2.lo: intrinsics/eoshift2.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT eoshift2.lo -MD -MP -MF $(DEPDIR)/eoshift2.Tpo -c -o eoshift2.lo `test -f 'intrinsics/eoshift2.c' || echo '$(srcdir)/'`intrinsics/eoshift2.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/eoshift2.Tpo $(DEPDIR)/eoshift2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/eoshift2.c' object='eoshift2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift2.lo `test -f 'intrinsics/eoshift2.c' || echo '$(srcdir)/'`intrinsics/eoshift2.c + +erfc_scaled.lo: intrinsics/erfc_scaled.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT erfc_scaled.lo -MD -MP -MF $(DEPDIR)/erfc_scaled.Tpo -c -o erfc_scaled.lo `test -f 'intrinsics/erfc_scaled.c' || echo '$(srcdir)/'`intrinsics/erfc_scaled.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/erfc_scaled.Tpo $(DEPDIR)/erfc_scaled.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/erfc_scaled.c' object='erfc_scaled.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o erfc_scaled.lo `test -f 'intrinsics/erfc_scaled.c' || echo '$(srcdir)/'`intrinsics/erfc_scaled.c + +etime.lo: intrinsics/etime.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT etime.lo -MD -MP -MF $(DEPDIR)/etime.Tpo -c -o etime.lo `test -f 'intrinsics/etime.c' || echo '$(srcdir)/'`intrinsics/etime.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/etime.Tpo $(DEPDIR)/etime.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/etime.c' object='etime.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o etime.lo `test -f 'intrinsics/etime.c' || echo '$(srcdir)/'`intrinsics/etime.c + +execute_command_line.lo: intrinsics/execute_command_line.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT execute_command_line.lo -MD -MP -MF $(DEPDIR)/execute_command_line.Tpo -c -o execute_command_line.lo `test -f 'intrinsics/execute_command_line.c' || echo '$(srcdir)/'`intrinsics/execute_command_line.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/execute_command_line.Tpo $(DEPDIR)/execute_command_line.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/execute_command_line.c' object='execute_command_line.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o execute_command_line.lo `test -f 'intrinsics/execute_command_line.c' || echo '$(srcdir)/'`intrinsics/execute_command_line.c + +exit.lo: intrinsics/exit.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT exit.lo -MD -MP -MF $(DEPDIR)/exit.Tpo -c -o exit.lo `test -f 'intrinsics/exit.c' || echo '$(srcdir)/'`intrinsics/exit.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/exit.Tpo $(DEPDIR)/exit.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/exit.c' object='exit.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exit.lo `test -f 'intrinsics/exit.c' || echo '$(srcdir)/'`intrinsics/exit.c + +extends_type_of.lo: intrinsics/extends_type_of.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT extends_type_of.lo -MD -MP -MF $(DEPDIR)/extends_type_of.Tpo -c -o extends_type_of.lo `test -f 'intrinsics/extends_type_of.c' || echo '$(srcdir)/'`intrinsics/extends_type_of.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/extends_type_of.Tpo $(DEPDIR)/extends_type_of.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/extends_type_of.c' object='extends_type_of.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o extends_type_of.lo `test -f 'intrinsics/extends_type_of.c' || echo '$(srcdir)/'`intrinsics/extends_type_of.c + +fnum.lo: intrinsics/fnum.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fnum.lo -MD -MP -MF $(DEPDIR)/fnum.Tpo -c -o fnum.lo `test -f 'intrinsics/fnum.c' || echo '$(srcdir)/'`intrinsics/fnum.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/fnum.Tpo $(DEPDIR)/fnum.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/fnum.c' object='fnum.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fnum.lo `test -f 'intrinsics/fnum.c' || echo '$(srcdir)/'`intrinsics/fnum.c + +gerror.lo: intrinsics/gerror.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT gerror.lo -MD -MP -MF $(DEPDIR)/gerror.Tpo -c -o gerror.lo `test -f 'intrinsics/gerror.c' || echo '$(srcdir)/'`intrinsics/gerror.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/gerror.Tpo $(DEPDIR)/gerror.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/gerror.c' object='gerror.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o gerror.lo `test -f 'intrinsics/gerror.c' || echo '$(srcdir)/'`intrinsics/gerror.c + +getcwd.lo: intrinsics/getcwd.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT getcwd.lo -MD -MP -MF $(DEPDIR)/getcwd.Tpo -c -o getcwd.lo `test -f 'intrinsics/getcwd.c' || echo '$(srcdir)/'`intrinsics/getcwd.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/getcwd.Tpo $(DEPDIR)/getcwd.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/getcwd.c' object='getcwd.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o getcwd.lo `test -f 'intrinsics/getcwd.c' || echo '$(srcdir)/'`intrinsics/getcwd.c + +getlog.lo: intrinsics/getlog.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT getlog.lo -MD -MP -MF $(DEPDIR)/getlog.Tpo -c -o getlog.lo `test -f 'intrinsics/getlog.c' || echo '$(srcdir)/'`intrinsics/getlog.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/getlog.Tpo $(DEPDIR)/getlog.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/getlog.c' object='getlog.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o getlog.lo `test -f 'intrinsics/getlog.c' || echo '$(srcdir)/'`intrinsics/getlog.c + +getXid.lo: intrinsics/getXid.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT getXid.lo -MD -MP -MF $(DEPDIR)/getXid.Tpo -c -o getXid.lo `test -f 'intrinsics/getXid.c' || echo '$(srcdir)/'`intrinsics/getXid.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/getXid.Tpo $(DEPDIR)/getXid.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/getXid.c' object='getXid.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o getXid.lo `test -f 'intrinsics/getXid.c' || echo '$(srcdir)/'`intrinsics/getXid.c + +hostnm.lo: intrinsics/hostnm.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT hostnm.lo -MD -MP -MF $(DEPDIR)/hostnm.Tpo -c -o hostnm.lo `test -f 'intrinsics/hostnm.c' || echo '$(srcdir)/'`intrinsics/hostnm.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/hostnm.Tpo $(DEPDIR)/hostnm.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/hostnm.c' object='hostnm.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o hostnm.lo `test -f 'intrinsics/hostnm.c' || echo '$(srcdir)/'`intrinsics/hostnm.c + +ierrno.lo: intrinsics/ierrno.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT ierrno.lo -MD -MP -MF $(DEPDIR)/ierrno.Tpo -c -o ierrno.lo `test -f 'intrinsics/ierrno.c' || echo '$(srcdir)/'`intrinsics/ierrno.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/ierrno.Tpo $(DEPDIR)/ierrno.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/ierrno.c' object='ierrno.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ierrno.lo `test -f 'intrinsics/ierrno.c' || echo '$(srcdir)/'`intrinsics/ierrno.c + +ishftc.lo: intrinsics/ishftc.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT ishftc.lo -MD -MP -MF $(DEPDIR)/ishftc.Tpo -c -o ishftc.lo `test -f 'intrinsics/ishftc.c' || echo '$(srcdir)/'`intrinsics/ishftc.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/ishftc.Tpo $(DEPDIR)/ishftc.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/ishftc.c' object='ishftc.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ishftc.lo `test -f 'intrinsics/ishftc.c' || echo '$(srcdir)/'`intrinsics/ishftc.c + +iso_c_generated_procs.lo: intrinsics/iso_c_generated_procs.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iso_c_generated_procs.lo -MD -MP -MF $(DEPDIR)/iso_c_generated_procs.Tpo -c -o iso_c_generated_procs.lo `test -f 'intrinsics/iso_c_generated_procs.c' || echo '$(srcdir)/'`intrinsics/iso_c_generated_procs.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iso_c_generated_procs.Tpo $(DEPDIR)/iso_c_generated_procs.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/iso_c_generated_procs.c' object='iso_c_generated_procs.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iso_c_generated_procs.lo `test -f 'intrinsics/iso_c_generated_procs.c' || echo '$(srcdir)/'`intrinsics/iso_c_generated_procs.c + +iso_c_binding.lo: intrinsics/iso_c_binding.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT iso_c_binding.lo -MD -MP -MF $(DEPDIR)/iso_c_binding.Tpo -c -o iso_c_binding.lo `test -f 'intrinsics/iso_c_binding.c' || echo '$(srcdir)/'`intrinsics/iso_c_binding.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/iso_c_binding.Tpo $(DEPDIR)/iso_c_binding.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/iso_c_binding.c' object='iso_c_binding.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o iso_c_binding.lo `test -f 'intrinsics/iso_c_binding.c' || echo '$(srcdir)/'`intrinsics/iso_c_binding.c + +kill.lo: intrinsics/kill.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT kill.lo -MD -MP -MF $(DEPDIR)/kill.Tpo -c -o kill.lo `test -f 'intrinsics/kill.c' || echo '$(srcdir)/'`intrinsics/kill.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/kill.Tpo $(DEPDIR)/kill.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/kill.c' object='kill.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o kill.lo `test -f 'intrinsics/kill.c' || echo '$(srcdir)/'`intrinsics/kill.c + +link.lo: intrinsics/link.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT link.lo -MD -MP -MF $(DEPDIR)/link.Tpo -c -o link.lo `test -f 'intrinsics/link.c' || echo '$(srcdir)/'`intrinsics/link.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/link.Tpo $(DEPDIR)/link.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/link.c' object='link.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o link.lo `test -f 'intrinsics/link.c' || echo '$(srcdir)/'`intrinsics/link.c + +malloc.lo: intrinsics/malloc.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT malloc.lo -MD -MP -MF $(DEPDIR)/malloc.Tpo -c -o malloc.lo `test -f 'intrinsics/malloc.c' || echo '$(srcdir)/'`intrinsics/malloc.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/malloc.Tpo $(DEPDIR)/malloc.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/malloc.c' object='malloc.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o malloc.lo `test -f 'intrinsics/malloc.c' || echo '$(srcdir)/'`intrinsics/malloc.c + +mvbits.lo: intrinsics/mvbits.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mvbits.lo -MD -MP -MF $(DEPDIR)/mvbits.Tpo -c -o mvbits.lo `test -f 'intrinsics/mvbits.c' || echo '$(srcdir)/'`intrinsics/mvbits.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/mvbits.Tpo $(DEPDIR)/mvbits.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/mvbits.c' object='mvbits.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mvbits.lo `test -f 'intrinsics/mvbits.c' || echo '$(srcdir)/'`intrinsics/mvbits.c + +move_alloc.lo: intrinsics/move_alloc.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT move_alloc.lo -MD -MP -MF $(DEPDIR)/move_alloc.Tpo -c -o move_alloc.lo `test -f 'intrinsics/move_alloc.c' || echo '$(srcdir)/'`intrinsics/move_alloc.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/move_alloc.Tpo $(DEPDIR)/move_alloc.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/move_alloc.c' object='move_alloc.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o move_alloc.lo `test -f 'intrinsics/move_alloc.c' || echo '$(srcdir)/'`intrinsics/move_alloc.c + +pack_generic.lo: intrinsics/pack_generic.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pack_generic.lo -MD -MP -MF $(DEPDIR)/pack_generic.Tpo -c -o pack_generic.lo `test -f 'intrinsics/pack_generic.c' || echo '$(srcdir)/'`intrinsics/pack_generic.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/pack_generic.Tpo $(DEPDIR)/pack_generic.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/pack_generic.c' object='pack_generic.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_generic.lo `test -f 'intrinsics/pack_generic.c' || echo '$(srcdir)/'`intrinsics/pack_generic.c + +perror.lo: intrinsics/perror.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT perror.lo -MD -MP -MF $(DEPDIR)/perror.Tpo -c -o perror.lo `test -f 'intrinsics/perror.c' || echo '$(srcdir)/'`intrinsics/perror.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/perror.Tpo $(DEPDIR)/perror.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/perror.c' object='perror.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o perror.lo `test -f 'intrinsics/perror.c' || echo '$(srcdir)/'`intrinsics/perror.c + +selected_char_kind.lo: intrinsics/selected_char_kind.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT selected_char_kind.lo -MD -MP -MF $(DEPDIR)/selected_char_kind.Tpo -c -o selected_char_kind.lo `test -f 'intrinsics/selected_char_kind.c' || echo '$(srcdir)/'`intrinsics/selected_char_kind.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/selected_char_kind.Tpo $(DEPDIR)/selected_char_kind.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/selected_char_kind.c' object='selected_char_kind.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o selected_char_kind.lo `test -f 'intrinsics/selected_char_kind.c' || echo '$(srcdir)/'`intrinsics/selected_char_kind.c + +signal.lo: intrinsics/signal.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT signal.lo -MD -MP -MF $(DEPDIR)/signal.Tpo -c -o signal.lo `test -f 'intrinsics/signal.c' || echo '$(srcdir)/'`intrinsics/signal.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/signal.Tpo $(DEPDIR)/signal.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/signal.c' object='signal.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o signal.lo `test -f 'intrinsics/signal.c' || echo '$(srcdir)/'`intrinsics/signal.c + +size.lo: intrinsics/size.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT size.lo -MD -MP -MF $(DEPDIR)/size.Tpo -c -o size.lo `test -f 'intrinsics/size.c' || echo '$(srcdir)/'`intrinsics/size.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/size.Tpo $(DEPDIR)/size.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/size.c' object='size.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o size.lo `test -f 'intrinsics/size.c' || echo '$(srcdir)/'`intrinsics/size.c + +sleep.lo: intrinsics/sleep.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT sleep.lo -MD -MP -MF $(DEPDIR)/sleep.Tpo -c -o sleep.lo `test -f 'intrinsics/sleep.c' || echo '$(srcdir)/'`intrinsics/sleep.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/sleep.Tpo $(DEPDIR)/sleep.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/sleep.c' object='sleep.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o sleep.lo `test -f 'intrinsics/sleep.c' || echo '$(srcdir)/'`intrinsics/sleep.c + +spread_generic.lo: intrinsics/spread_generic.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT spread_generic.lo -MD -MP -MF $(DEPDIR)/spread_generic.Tpo -c -o spread_generic.lo `test -f 'intrinsics/spread_generic.c' || echo '$(srcdir)/'`intrinsics/spread_generic.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/spread_generic.Tpo $(DEPDIR)/spread_generic.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/spread_generic.c' object='spread_generic.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o spread_generic.lo `test -f 'intrinsics/spread_generic.c' || echo '$(srcdir)/'`intrinsics/spread_generic.c + +string_intrinsics.lo: intrinsics/string_intrinsics.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT string_intrinsics.lo -MD -MP -MF $(DEPDIR)/string_intrinsics.Tpo -c -o string_intrinsics.lo `test -f 'intrinsics/string_intrinsics.c' || echo '$(srcdir)/'`intrinsics/string_intrinsics.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/string_intrinsics.Tpo $(DEPDIR)/string_intrinsics.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/string_intrinsics.c' object='string_intrinsics.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o string_intrinsics.lo `test -f 'intrinsics/string_intrinsics.c' || echo '$(srcdir)/'`intrinsics/string_intrinsics.c + +system.lo: intrinsics/system.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT system.lo -MD -MP -MF $(DEPDIR)/system.Tpo -c -o system.lo `test -f 'intrinsics/system.c' || echo '$(srcdir)/'`intrinsics/system.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/system.Tpo $(DEPDIR)/system.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/system.c' object='system.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o system.lo `test -f 'intrinsics/system.c' || echo '$(srcdir)/'`intrinsics/system.c + +rand.lo: intrinsics/rand.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT rand.lo -MD -MP -MF $(DEPDIR)/rand.Tpo -c -o rand.lo `test -f 'intrinsics/rand.c' || echo '$(srcdir)/'`intrinsics/rand.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/rand.Tpo $(DEPDIR)/rand.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/rand.c' object='rand.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rand.lo `test -f 'intrinsics/rand.c' || echo '$(srcdir)/'`intrinsics/rand.c + +random.lo: intrinsics/random.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT random.lo -MD -MP -MF $(DEPDIR)/random.Tpo -c -o random.lo `test -f 'intrinsics/random.c' || echo '$(srcdir)/'`intrinsics/random.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/random.Tpo $(DEPDIR)/random.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/random.c' object='random.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o random.lo `test -f 'intrinsics/random.c' || echo '$(srcdir)/'`intrinsics/random.c + +rename.lo: intrinsics/rename.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT rename.lo -MD -MP -MF $(DEPDIR)/rename.Tpo -c -o rename.lo `test -f 'intrinsics/rename.c' || echo '$(srcdir)/'`intrinsics/rename.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/rename.Tpo $(DEPDIR)/rename.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/rename.c' object='rename.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rename.lo `test -f 'intrinsics/rename.c' || echo '$(srcdir)/'`intrinsics/rename.c + +reshape_generic.lo: intrinsics/reshape_generic.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_generic.lo -MD -MP -MF $(DEPDIR)/reshape_generic.Tpo -c -o reshape_generic.lo `test -f 'intrinsics/reshape_generic.c' || echo '$(srcdir)/'`intrinsics/reshape_generic.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_generic.Tpo $(DEPDIR)/reshape_generic.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/reshape_generic.c' object='reshape_generic.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_generic.lo `test -f 'intrinsics/reshape_generic.c' || echo '$(srcdir)/'`intrinsics/reshape_generic.c + +reshape_packed.lo: intrinsics/reshape_packed.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT reshape_packed.lo -MD -MP -MF $(DEPDIR)/reshape_packed.Tpo -c -o reshape_packed.lo `test -f 'intrinsics/reshape_packed.c' || echo '$(srcdir)/'`intrinsics/reshape_packed.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/reshape_packed.Tpo $(DEPDIR)/reshape_packed.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/reshape_packed.c' object='reshape_packed.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_packed.lo `test -f 'intrinsics/reshape_packed.c' || echo '$(srcdir)/'`intrinsics/reshape_packed.c + +stat.lo: intrinsics/stat.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT stat.lo -MD -MP -MF $(DEPDIR)/stat.Tpo -c -o stat.lo `test -f 'intrinsics/stat.c' || echo '$(srcdir)/'`intrinsics/stat.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/stat.Tpo $(DEPDIR)/stat.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/stat.c' object='stat.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o stat.lo `test -f 'intrinsics/stat.c' || echo '$(srcdir)/'`intrinsics/stat.c + +symlnk.lo: intrinsics/symlnk.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT symlnk.lo -MD -MP -MF $(DEPDIR)/symlnk.Tpo -c -o symlnk.lo `test -f 'intrinsics/symlnk.c' || echo '$(srcdir)/'`intrinsics/symlnk.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/symlnk.Tpo $(DEPDIR)/symlnk.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/symlnk.c' object='symlnk.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o symlnk.lo `test -f 'intrinsics/symlnk.c' || echo '$(srcdir)/'`intrinsics/symlnk.c + +system_clock.lo: intrinsics/system_clock.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT system_clock.lo -MD -MP -MF $(DEPDIR)/system_clock.Tpo -c -o system_clock.lo `test -f 'intrinsics/system_clock.c' || echo '$(srcdir)/'`intrinsics/system_clock.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/system_clock.Tpo $(DEPDIR)/system_clock.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/system_clock.c' object='system_clock.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o system_clock.lo `test -f 'intrinsics/system_clock.c' || echo '$(srcdir)/'`intrinsics/system_clock.c + +time.lo: intrinsics/time.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT time.lo -MD -MP -MF $(DEPDIR)/time.Tpo -c -o time.lo `test -f 'intrinsics/time.c' || echo '$(srcdir)/'`intrinsics/time.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/time.Tpo $(DEPDIR)/time.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/time.c' object='time.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o time.lo `test -f 'intrinsics/time.c' || echo '$(srcdir)/'`intrinsics/time.c + +transpose_generic.lo: intrinsics/transpose_generic.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT transpose_generic.lo -MD -MP -MF $(DEPDIR)/transpose_generic.Tpo -c -o transpose_generic.lo `test -f 'intrinsics/transpose_generic.c' || echo '$(srcdir)/'`intrinsics/transpose_generic.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/transpose_generic.Tpo $(DEPDIR)/transpose_generic.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/transpose_generic.c' object='transpose_generic.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_generic.lo `test -f 'intrinsics/transpose_generic.c' || echo '$(srcdir)/'`intrinsics/transpose_generic.c + +umask.lo: intrinsics/umask.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT umask.lo -MD -MP -MF $(DEPDIR)/umask.Tpo -c -o umask.lo `test -f 'intrinsics/umask.c' || echo '$(srcdir)/'`intrinsics/umask.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/umask.Tpo $(DEPDIR)/umask.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/umask.c' object='umask.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o umask.lo `test -f 'intrinsics/umask.c' || echo '$(srcdir)/'`intrinsics/umask.c + +unlink.lo: intrinsics/unlink.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unlink.lo -MD -MP -MF $(DEPDIR)/unlink.Tpo -c -o unlink.lo `test -f 'intrinsics/unlink.c' || echo '$(srcdir)/'`intrinsics/unlink.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unlink.Tpo $(DEPDIR)/unlink.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/unlink.c' object='unlink.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unlink.lo `test -f 'intrinsics/unlink.c' || echo '$(srcdir)/'`intrinsics/unlink.c + +unpack_generic.lo: intrinsics/unpack_generic.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT unpack_generic.lo -MD -MP -MF $(DEPDIR)/unpack_generic.Tpo -c -o unpack_generic.lo `test -f 'intrinsics/unpack_generic.c' || echo '$(srcdir)/'`intrinsics/unpack_generic.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/unpack_generic.Tpo $(DEPDIR)/unpack_generic.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/unpack_generic.c' object='unpack_generic.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o unpack_generic.lo `test -f 'intrinsics/unpack_generic.c' || echo '$(srcdir)/'`intrinsics/unpack_generic.c + +in_pack_generic.lo: runtime/in_pack_generic.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_pack_generic.lo -MD -MP -MF $(DEPDIR)/in_pack_generic.Tpo -c -o in_pack_generic.lo `test -f 'runtime/in_pack_generic.c' || echo '$(srcdir)/'`runtime/in_pack_generic.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_pack_generic.Tpo $(DEPDIR)/in_pack_generic.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/in_pack_generic.c' object='in_pack_generic.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_pack_generic.lo `test -f 'runtime/in_pack_generic.c' || echo '$(srcdir)/'`runtime/in_pack_generic.c + +in_unpack_generic.lo: runtime/in_unpack_generic.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT in_unpack_generic.lo -MD -MP -MF $(DEPDIR)/in_unpack_generic.Tpo -c -o in_unpack_generic.lo `test -f 'runtime/in_unpack_generic.c' || echo '$(srcdir)/'`runtime/in_unpack_generic.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/in_unpack_generic.Tpo $(DEPDIR)/in_unpack_generic.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/in_unpack_generic.c' object='in_unpack_generic.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o in_unpack_generic.lo `test -f 'runtime/in_unpack_generic.c' || echo '$(srcdir)/'`runtime/in_unpack_generic.c + +.f90.o: + $(FCCOMPILE) -c -o $@ $< + +.f90.obj: + $(FCCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.f90.lo: + $(LTFCCOMPILE) -c -o $@ $< + +selected_int_kind.lo: intrinsics/selected_int_kind.f90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o selected_int_kind.lo `test -f 'intrinsics/selected_int_kind.f90' || echo '$(srcdir)/'`intrinsics/selected_int_kind.f90 + +selected_real_kind.lo: intrinsics/selected_real_kind.f90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --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 + +dprod_r8.lo: intrinsics/dprod_r8.f90 + $(LIBTOOL) --tag=FC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(FC) $(AM_FCFLAGS) $(FCFLAGS) -c -o dprod_r8.lo `test -f 'intrinsics/dprod_r8.f90' || echo '$(srcdir)/'`intrinsics/dprod_r8.f90 + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +distclean-libtool: + -rm -f libtool config.lt + +# GNU Make needs to see an explicit $(MAKE) variable in the command it +# runs to enable its job server during parallel builds. Hence the +# comments below. +all-multi: + $(MULTIDO) $(AM_MAKEFLAGS) DO=all multi-do # $(MAKE) +install-multi: + $(MULTIDO) $(AM_MAKEFLAGS) DO=install multi-do # $(MAKE) + +mostlyclean-multi: + $(MULTICLEAN) $(AM_MAKEFLAGS) DO=mostlyclean multi-clean # $(MAKE) +clean-multi: + $(MULTICLEAN) $(AM_MAKEFLAGS) DO=clean multi-clean # $(MAKE) +distclean-multi: + $(MULTICLEAN) $(AM_MAKEFLAGS) DO=distclean multi-clean # $(MAKE) +maintainer-clean-multi: + $(MULTICLEAN) $(AM_MAKEFLAGS) DO=maintainer-clean multi-clean # $(MAKE) +install-toolexeclibDATA: $(toolexeclib_DATA) + @$(NORMAL_INSTALL) + test -z "$(toolexeclibdir)" || $(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" + @list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + echo "$$d$$p"; \ + done | $(am__base_list) | \ + while read files; do \ + echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(toolexeclibdir)'"; \ + $(INSTALL_DATA) $$files "$(DESTDIR)$(toolexeclibdir)" || exit $$?; \ + done + +uninstall-toolexeclibDATA: + @$(NORMAL_UNINSTALL) + @list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \ + files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ + test -n "$$files" || exit 0; \ + echo " ( cd '$(DESTDIR)$(toolexeclibdir)' && rm -f" $$files ")"; \ + cd "$(DESTDIR)$(toolexeclibdir)" && rm -f $$files + +ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + mkid -fID $$unique +tags: TAGS + +TAGS: $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + set x; \ + here=`pwd`; \ + list='$(SOURCES) $(HEADERS) config.h.in $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: CTAGS +CTAGS: $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + list='$(SOURCES) $(HEADERS) config.h.in $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags +check-am: all-am +check: $(BUILT_SOURCES) + $(MAKE) $(AM_MAKEFLAGS) check-am +all-am: Makefile $(LTLIBRARIES) all-multi $(DATA) config.h +installdirs: + for dir in "$(DESTDIR)$(myexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: $(BUILT_SOURCES) + $(MAKE) $(AM_MAKEFLAGS) install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." + -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) +clean: clean-am clean-multi + +clean-am: clean-generic clean-libtool clean-myexeclibLTLIBRARIES \ + clean-toolexeclibLTLIBRARIES mostlyclean-am + +distclean: distclean-am distclean-multi + -rm -f $(am__CONFIG_DISTCLEAN_FILES) + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-hdr distclean-libtool distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: install-multi install-myexeclibLTLIBRARIES \ + install-toolexeclibDATA install-toolexeclibLTLIBRARIES + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am maintainer-clean-multi + -rm -f $(am__CONFIG_DISTCLEAN_FILES) + -rm -rf $(top_srcdir)/autom4te.cache + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am mostlyclean-multi + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-myexeclibLTLIBRARIES uninstall-toolexeclibDATA \ + uninstall-toolexeclibLTLIBRARIES + +.MAKE: all all-multi check clean-multi distclean-multi install \ + install-am install-multi install-strip maintainer-clean-multi \ + mostlyclean-multi + +.PHONY: CTAGS GTAGS all all-am all-multi am--refresh check check-am \ + clean clean-generic clean-libtool clean-multi \ + clean-myexeclibLTLIBRARIES clean-toolexeclibLTLIBRARIES ctags \ + distclean distclean-compile distclean-generic distclean-hdr \ + distclean-libtool distclean-multi distclean-tags dvi dvi-am \ + html html-am info info-am install install-am install-data \ + install-data-am install-dvi install-dvi-am install-exec \ + install-exec-am install-html install-html-am install-info \ + install-info-am install-man install-multi \ + install-myexeclibLTLIBRARIES install-pdf install-pdf-am \ + install-ps install-ps-am install-strip install-toolexeclibDATA \ + install-toolexeclibLTLIBRARIES installcheck installcheck-am \ + installdirs maintainer-clean maintainer-clean-generic \ + maintainer-clean-multi mostlyclean mostlyclean-compile \ + mostlyclean-generic mostlyclean-libtool mostlyclean-multi pdf \ + pdf-am ps ps-am tags uninstall uninstall-am \ + uninstall-myexeclibLTLIBRARIES uninstall-toolexeclibDATA \ + uninstall-toolexeclibLTLIBRARIES + +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@gfortran.map-sun : $(srcdir)/gfortran.map \ +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(top_srcdir)/../contrib/make_sunver.pl \ +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD) +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ perl $(top_srcdir)/../contrib/make_sunver.pl \ +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(srcdir)/gfortran.map \ +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(libgfortran_la_OBJECTS:%.lo=.libs/%.o) \ +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ `echo $(libgfortran_la_LIBADD) | \ +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ sed 's,/\([^/.]*\)\.la,/.libs/\1.a,g'` \ +@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ > $@ || (rm -f $@ ; exit 1) + +# Turn on vectorization and loop unrolling for matmul. +$(patsubst %.c,%.lo,$(notdir $(i_matmul_c))): AM_CFLAGS += -ftree-vectorize -funroll-loops +# Logical matmul doesn't vectorize. +$(patsubst %.c,%.lo,$(notdir $(i_matmull_c))): AM_CFLAGS += -funroll-loops + +# Add the -fallow-leading-underscore option when needed +$(patsubst %.F90,%.lo,$(patsubst %.f90,%.lo,$(notdir $(gfor_specific_src)))): AM_FCFLAGS += -fallow-leading-underscore +selected_real_kind.lo selected_int_kind.lo: AM_FCFLAGS += -fallow-leading-underscore +@onestep_TRUE@libgfortran_c.c libgfortran_f.f90 libgfortran_F.F90: +@onestep_TRUE@ echo > $@ +# overrides for libtool perusing the dummy sources +@onestep_TRUE@libgfortran_c.o: $(filter %.c,$(prereq_SRC)) +@onestep_TRUE@ $(COMPILE) -c $^ -o $@ -combine + +@onestep_TRUE@libgfortran_c.lo: $(filter %.c,$(prereq_SRC)) +@onestep_TRUE@ $(LTCOMPILE) -c -o $@ $^ -combine + +kinds.h: $(srcdir)/mk-kinds-h.sh + $(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@ || rm $@ + +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)' > $@ || rm $@ + +selected_real_kind.inc: $(srcdir)/mk-srk-inc.sh + $(SHELL) $(srcdir)/mk-srk-inc.sh '$(FCCOMPILE)' > $@ || rm $@ + +fpu-target.h: $(srcdir)/$(FPU_HOST_HEADER) + cp $(srcdir)/$(FPU_HOST_HEADER) $@ + +@MAINTAINER_MODE_TRUE@$(i_all_c): m4/all.m4 $(I_M4_DEPS2) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 all.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_bessel_c): m4/bessel.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 bessel.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_any_c): m4/any.m4 $(I_M4_DEPS2) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 any.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_count_c): m4/count.m4 $(I_M4_DEPS2) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 count.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_iall_c): m4/iall.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 iall.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_iany_c): m4/iany.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 iany.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_iparity_c): m4/iparity.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 iparity.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_maxloc0_c): m4/maxloc0.m4 $(I_M4_DEPS0) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc0.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_maxloc1_c): m4/maxloc1.m4 $(I_M4_DEPS1) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxloc1.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_maxval_c): m4/maxval.m4 $(I_M4_DEPS1) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 maxval.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_minloc0_c): m4/minloc0.m4 $(I_M4_DEPS0) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 minloc0.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_minloc1_c): m4/minloc1.m4 $(I_M4_DEPS1) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 minloc1.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_minval_c): m4/minval.m4 $(I_M4_DEPS1) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 minval.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_product_c): m4/product.m4 $(I_M4_DEPS1) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 product.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_sum_c): m4/sum.m4 $(I_M4_DEPS1) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 sum.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_matmul_c): m4/matmul.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 matmul.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_matmull_c): m4/matmull.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 matmull.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_norm2_c): m4/norm2.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 norm2.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_parity_c): m4/parity.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 parity.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_transpose_c): m4/transpose.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 transpose.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_shape_c): m4/shape.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 shape.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_reshape_c): m4/reshape.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 reshape.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_eoshift1_c): m4/eoshift1.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 eoshift1.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_eoshift3_c): m4/eoshift3.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 eoshift3.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_cshift0_c): m4/cshift0.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 cshift0.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_cshift1_c): m4/cshift1.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 cshift1.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(in_pack_c): m4/in_pack.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 in_pack.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(in_unpack_c): m4/in_unpack.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 in_unpack.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_exponent_c): m4/exponent.m4 m4/mtype.m4 +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 exponent.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_rrspacing_c): m4/rrspacing.m4 m4/mtype.m4 +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 rrspacing.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_spacing_c): m4/spacing.m4 m4/mtype.m4 +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 spacing.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_fraction_c): m4/fraction.m4 m4/mtype.m4 +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 fraction.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_nearest_c): m4/nearest.m4 m4/mtype.m4 +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 nearest.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_set_exponent_c): m4/set_exponent.m4 m4/mtype.m4 +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 set_exponent.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_pow_c): m4/pow.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 pow.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_pack_c): m4/pack.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 pack.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_unpack_c): m4/unpack.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 unpack.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(i_spread_c): m4/spread.m4 $(I_M4_DEPS) +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 spread.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(gfor_built_specific_src): m4/specific.m4 m4/head.m4 +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 specific.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(gfor_built_specific2_src): m4/specific2.m4 m4/head.m4 +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 specific2.m4 > $@ + +@MAINTAINER_MODE_TRUE@$(gfor_misc_specifics): m4/misc_specifics.m4 m4/head.m4 +@MAINTAINER_MODE_TRUE@ $(M4) -Dfile=$@ -I$(srcdir)/m4 misc_specifics.m4 > $@ + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/libgfortran/acinclude.m4 b/libgfortran/acinclude.m4 new file mode 100644 index 000000000..62c3b452c --- /dev/null +++ b/libgfortran/acinclude.m4 @@ -0,0 +1,372 @@ +m4_include(../config/acx.m4) +m4_include(../config/no-executables.m4) + +dnl Check that we have a working GNU Fortran compiler +AC_DEFUN([LIBGFOR_WORKING_GFORTRAN], [ +AC_MSG_CHECKING([whether the GNU Fortran compiler is working]) +AC_LANG_PUSH([Fortran]) +AC_COMPILE_IFELSE([[ + program foo + real, parameter :: bar = sin (12.34 / 2.5) + end program foo]], + [AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no]) + AC_MSG_ERROR([GNU Fortran is not working; please report a bug in http://gcc.gnu.org/bugzilla, attaching $PWD/config.log]) + ]) +AC_LANG_POP([Fortran]) +]) + + +sinclude(../libtool.m4) +dnl The lines below arrange for aclocal not to bring an installed +dnl libtool.m4 into aclocal.m4, while still arranging for automake to +dnl add a definition of LIBTOOL to Makefile.in. +ifelse(,,,[AC_SUBST(LIBTOOL) +AC_DEFUN([AM_PROG_LIBTOOL]) +AC_DEFUN([AC_LIBTOOL_DLOPEN]) +AC_DEFUN([AC_PROG_LD]) +]) + +dnl Check whether the target supports hidden visibility. +AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_VISIBILITY], [ + AC_CACHE_CHECK([whether the target supports hidden visibility], + libgfor_cv_have_attribute_visibility, [ + save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Werror" + AC_TRY_COMPILE([void __attribute__((visibility("hidden"))) foo(void) { }], + [], libgfor_cv_have_attribute_visibility=yes, + libgfor_cv_have_attribute_visibility=no) + CFLAGS="$save_CFLAGS"]) + if test $libgfor_cv_have_attribute_visibility = yes; then + AC_DEFINE(HAVE_ATTRIBUTE_VISIBILITY, 1, + [Define to 1 if the target supports __attribute__((visibility(...))).]) + fi]) + +dnl Check whether the target supports dllexport +AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_DLLEXPORT], [ + AC_CACHE_CHECK([whether the target supports dllexport], + libgfor_cv_have_attribute_dllexport, [ + save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Werror" + AC_TRY_COMPILE([void __attribute__((dllexport)) foo(void) { }], + [], libgfor_cv_have_attribute_dllexport=yes, + libgfor_cv_have_attribute_dllexport=no) + CFLAGS="$save_CFLAGS"]) + if test $libgfor_cv_have_attribute_dllexport = yes; then + AC_DEFINE(HAVE_ATTRIBUTE_DLLEXPORT, 1, + [Define to 1 if the target supports __attribute__((dllexport)).]) + fi]) + +dnl Check whether the target supports symbol aliases. +AC_DEFUN([LIBGFOR_CHECK_ATTRIBUTE_ALIAS], [ + AC_CACHE_CHECK([whether the target supports symbol aliases], + libgfor_cv_have_attribute_alias, [ + AC_TRY_LINK([ +void foo(void) { } +extern void bar(void) __attribute__((alias("foo")));], + [bar();], libgfor_cv_have_attribute_alias=yes, libgfor_cv_have_attribute_alias=no)]) + if test $libgfor_cv_have_attribute_alias = yes; then + AC_DEFINE(HAVE_ATTRIBUTE_ALIAS, 1, + [Define to 1 if the target supports __attribute__((alias(...))).]) + fi]) + +dnl Check whether the target supports __sync_fetch_and_add. +AC_DEFUN([LIBGFOR_CHECK_SYNC_FETCH_AND_ADD], [ + AC_CACHE_CHECK([whether the target supports __sync_fetch_and_add], + libgfor_cv_have_sync_fetch_and_add, [ + AC_TRY_LINK([int foovar = 0;], [ +if (foovar <= 0) return __sync_fetch_and_add (&foovar, 1); +if (foovar > 10) return __sync_add_and_fetch (&foovar, -1);], + libgfor_cv_have_sync_fetch_and_add=yes, libgfor_cv_have_sync_fetch_and_add=no)]) + if test $libgfor_cv_have_sync_fetch_and_add = yes; then + AC_DEFINE(HAVE_SYNC_FETCH_AND_ADD, 1, + [Define to 1 if the target supports __sync_fetch_and_add]) + fi]) + +dnl Check if threads are supported. +AC_DEFUN([LIBGFOR_CHECK_GTHR_DEFAULT], [ + AC_CACHE_CHECK([configured target thread model], + libgfor_cv_target_thread_file, [ +libgfor_cv_target_thread_file=`$CC -v 2>&1 | sed -n 's/^Thread model: //p'`]) + + if test $libgfor_cv_target_thread_file != single; then + AC_DEFINE(HAVE_GTHR_DEFAULT, 1, + [Define if the compiler has a thread header that is non single.]) + fi]) + +dnl Check for pragma weak. +AC_DEFUN([LIBGFOR_GTHREAD_WEAK], [ + AC_CACHE_CHECK([whether pragma weak works], + libgfor_cv_have_pragma_weak, [ + gfor_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Wunknown-pragmas" + AC_TRY_COMPILE([void foo (void); +#pragma weak foo], [if (foo) foo ();], + libgfor_cv_have_pragma_weak=yes, libgfor_cv_have_pragma_weak=no)]) + if test $libgfor_cv_have_pragma_weak = yes; then + AC_DEFINE(SUPPORTS_WEAK, 1, + [Define to 1 if the target supports #pragma weak]) + fi + case "$host" in + *-*-darwin* | *-*-hpux* | *-*-cygwin* | *-*-mingw* | alpha*-dec-osf* ) + AC_DEFINE(GTHREAD_USE_WEAK, 0, + [Define to 0 if the target shouldn't use #pragma weak]) + ;; + esac]) + +dnl Check whether target can unlink a file still open. +AC_DEFUN([LIBGFOR_CHECK_UNLINK_OPEN_FILE], [ + AC_CACHE_CHECK([whether the target can unlink an open file], + libgfor_cv_have_unlink_open_file, [ + AC_TRY_RUN([ +#include +#include +#include +#include + +int main () +{ + int fd; + + fd = open ("testfile", O_RDWR | O_CREAT, S_IWRITE | S_IREAD); + if (fd <= 0) + return 0; + if (unlink ("testfile") == -1) + return 1; + write (fd, "This is a test\n", 15); + close (fd); + + if (open ("testfile", O_RDONLY, S_IWRITE | S_IREAD) == -1 && errno == ENOENT) + return 0; + else + return 1; +}], libgfor_cv_have_unlink_open_file=yes, libgfor_cv_have_unlink_open_file=no, [ +case "${target}" in + *mingw*) libgfor_cv_have_unlink_open_file=no ;; + *) libgfor_cv_have_unlink_open_file=yes;; +esac])]) +if test x"$libgfor_cv_have_unlink_open_file" = xyes; then + AC_DEFINE(HAVE_UNLINK_OPEN_FILE, 1, [Define if target can unlink open files.]) +fi]) + +dnl Check whether CRLF is the line terminator +AC_DEFUN([LIBGFOR_CHECK_CRLF], [ + AC_CACHE_CHECK([whether the target has CRLF as line terminator], + libgfor_cv_have_crlf, [ + AC_TRY_RUN([ +/* This test program should exit with status 0 if system uses a CRLF as + line terminator, and status 1 otherwise. + Since it is used to check for mingw systems, and should return 0 in any + other case, in case of a failure we will not use CRLF. */ +#include +#include +#include +#include + +int main () +{ +#ifndef O_BINARY + exit(1); +#else + int fd, bytes; + char buff[5]; + + fd = open ("foo", O_WRONLY | O_CREAT | O_TRUNC, S_IRWXU); + if (fd < 0) + exit(1); + if (write (fd, "\n", 1) < 0) + perror ("write"); + + close (fd); + + if ((fd = open ("foo", O_RDONLY | O_BINARY, S_IRWXU)) < 0) + exit(1); + bytes = read (fd, buff, 5); + if (bytes == 2 && buff[0] == '\r' && buff[1] == '\n') + exit(0); + else + exit(1); +#endif +}], libgfor_cv_have_crlf=yes, libgfor_cv_have_crlf=no, [ +case "${target}" in + *mingw*) libgfor_cv_have_crlf=yes ;; + *) libgfor_cv_have_crlf=no;; +esac])]) +if test x"$libgfor_cv_have_crlf" = xyes; then + AC_DEFINE(HAVE_CRLF, 1, [Define if CRLF is line terminator.]) +fi]) + +dnl Check whether the st_ino and st_dev stat fields taken together uniquely +dnl identify the file within the system. This is should be true for POSIX +dnl systems; it is known to be false on mingw32. +AC_DEFUN([LIBGFOR_CHECK_WORKING_STAT], [ + AC_CACHE_CHECK([whether the target stat is reliable], + libgfor_cv_have_working_stat, [ + AC_TRY_RUN([ +#include +#include +#include +#include + +int main () +{ + FILE *f, *g; + struct stat st1, st2; + + f = fopen ("foo", "w"); + g = fopen ("bar", "w"); + if (stat ("foo", &st1) != 0 || stat ("bar", &st2)) + return 1; + if (st1.st_dev == st2.st_dev && st1.st_ino == st2.st_ino) + return 1; + fclose(f); + fclose(g); + return 0; +}], libgfor_cv_have_working_stat=yes, libgfor_cv_have_working_stat=no, [ +case "${target}" in + *mingw*) libgfor_cv_have_working_stat=no ;; + *) libgfor_cv_have_working_stat=yes;; +esac])]) +if test x"$libgfor_cv_have_working_stat" = xyes; then + AC_DEFINE(HAVE_WORKING_STAT, 1, [Define if target has a reliable stat.]) +fi]) + +dnl Checks for fpsetmask function. +AC_DEFUN([LIBGFOR_CHECK_FPSETMASK], [ + AC_CACHE_CHECK([whether fpsetmask is present], libgfor_cv_have_fpsetmask, [ + AC_TRY_LINK([ +#if HAVE_FLOATINGPOINT_H +# include +#endif /* HAVE_FLOATINGPOINT_H */ +#if HAVE_IEEEFP_H +# include +#endif /* HAVE_IEEEFP_H */],[fpsetmask(0);], + eval "libgfor_cv_have_fpsetmask=yes", eval "libgfor_cv_have_fpsetmask=no") + ]) + if test x"$libgfor_cv_have_fpsetmask" = xyes; then + have_fpsetmask=yes + AC_DEFINE(HAVE_FPSETMASK, 1, [Define if you have fpsetmask.]) + fi +]) + +dnl Check whether we have a mingw that provides a __mingw_snprintf function +AC_DEFUN([LIBGFOR_CHECK_MINGW_SNPRINTF], [ + AC_CACHE_CHECK([whether __mingw_snprintf is present], libgfor_cv_have_mingw_snprintf, [ + AC_TRY_LINK([ +#include +extern int __mingw_snprintf (char *, size_t, const char *, ...); +],[ +__mingw_snprintf (NULL, 0, "%d\n", 1); +], + eval "libgfor_cv_have_mingw_snprintf=yes", eval "libgfor_cv_have_mingw_snprintf=no") + ]) + if test x"$libgfor_cv_have_mingw_snprintf" = xyes; then + AC_DEFINE(HAVE_MINGW_SNPRINTF, 1, [Define if you have __mingw_snprintf.]) + fi +]) + +dnl Check whether we have a broken powf implementation +AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_POWF], [ + AC_CACHE_CHECK([whether powf is broken], libgfor_cv_have_broken_powf, [ +case "${target}" in + hppa*64*-*-hpux*) libgfor_cv_have_broken_powf=yes ;; + *) libgfor_cv_have_broken_powf=no;; +esac]) + if test x"$libgfor_cv_have_broken_powf" = xyes; then + AC_DEFINE(HAVE_BROKEN_POWF, 1, [Define if powf is broken.]) + fi +]) + +dnl Check whether we have a __float128 type +AC_DEFUN([LIBGFOR_CHECK_FLOAT128], [ + LIBQUADSPEC= + + if test "x$enable_libquadmath_support" != xno; then + + AC_CACHE_CHECK([whether we have a usable __float128 type], + libgfor_cv_have_float128, [ + GCC_TRY_COMPILE_OR_LINK([ + typedef _Complex float __attribute__((mode(TC))) __complex128; + + __float128 foo (__float128 x) + { + + __complex128 z1, z2; + + z1 = x; + z2 = x / 7.Q; + z2 /= z1; + + return (__float128) z2; + } + + __float128 bar (__float128 x) + { + return x * __builtin_huge_valq (); + } + ],[ + foo (1.2Q); + bar (1.2Q); + ],[ + libgfor_cv_have_float128=yes + ],[ + libgfor_cv_have_float128=no +])]) + + if test "x$libgfor_cv_have_float128" = xyes; then + AC_DEFINE(HAVE_FLOAT128, 1, [Define if have a usable __float128 type.]) + + dnl Check whether -Wl,--as-needed is supported + dnl + dnl Turn warnings into error to avoid testsuite breakage. So enable + dnl AC_LANG_WERROR, but there's currently (autoconf 2.64) no way to turn + dnl it off again. As a workaround, save and restore werror flag like + dnl AC_PATH_XTRA. + dnl Cf. http://gcc.gnu.org/ml/gcc-patches/2010-05/msg01889.html + ac_xsave_[]_AC_LANG_ABBREV[]_werror_flag=$ac_[]_AC_LANG_ABBREV[]_werror_flag + AC_CACHE_CHECK([whether --as-needed works], + [libgfor_cv_have_as_needed], + [ + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS -Wl,--as-needed -lm -Wl,--no-as-needed" + libgfor_cv_have_as_needed=no + AC_LANG_WERROR + AC_LINK_IFELSE([AC_LANG_PROGRAM([])], + [libgfor_cv_have_as_needed=yes], + [libgfor_cv_have_as_needed=no]) + LDFLAGS="$save_LDFLAGS" + ac_[]_AC_LANG_ABBREV[]_werror_flag=$ac_xsave_[]_AC_LANG_ABBREV[]_werror_flag + ]) + + dnl For static libgfortran linkage, depend on libquadmath only if needed. + if test "x$libgfor_cv_have_as_needed" = xyes; then + LIBQUADSPEC="%{static-libgfortran:--as-needed} -lquadmath %{static-libgfortran:--no-as-needed}" + else + LIBQUADSPEC="-lquadmath" + fi + if test -f ../libquadmath/libquadmath.la; then + LIBQUADLIB=../libquadmath/libquadmath.la + LIBQUADLIB_DEP=../libquadmath/libquadmath.la + LIBQUADINCLUDE='-I$(srcdir)/../libquadmath' + else + LIBQUADLIB="-lquadmath" + LIBQUADLIB_DEP= + LIBQUADINCLUDE= + fi + fi + else + # for --disable-quadmath + LIBQUADLIB= + LIBQUADLIB_DEP= + LIBQUADINCLUDE= + fi + + dnl For the spec file + AC_SUBST(LIBQUADSPEC) + AC_SUBST(LIBQUADLIB) + AC_SUBST(LIBQUADLIB_DEP) + AC_SUBST(LIBQUADINCLUDE) + + dnl We need a conditional for the Makefile + AM_CONDITIONAL(LIBGFOR_BUILD_QUAD, [test "x$libgfor_cv_have_float128" = xyes]) +]) diff --git a/libgfortran/aclocal.m4 b/libgfortran/aclocal.m4 new file mode 100644 index 000000000..cbac4af8f --- /dev/null +++ b/libgfortran/aclocal.m4 @@ -0,0 +1,981 @@ +# generated automatically by aclocal 1.11.1 -*- Autoconf -*- + +# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +# 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +m4_ifndef([AC_AUTOCONF_VERSION], + [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl +m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.64],, +[m4_warning([this file was generated for autoconf 2.64. +You have another version of autoconf. It may work, but is not guaranteed to. +If you have problems, you may need to regenerate the build system entirely. +To do so, use the procedure documented by the package, typically `autoreconf'.])]) + +# Copyright (C) 2002, 2003, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_AUTOMAKE_VERSION(VERSION) +# ---------------------------- +# Automake X.Y traces this macro to ensure aclocal.m4 has been +# generated from the m4 files accompanying Automake X.Y. +# (This private macro should not be called outside this file.) +AC_DEFUN([AM_AUTOMAKE_VERSION], +[am__api_version='1.11' +dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to +dnl require some minimum version. Point them to the right macro. +m4_if([$1], [1.11.1], [], + [AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl +]) + +# _AM_AUTOCONF_VERSION(VERSION) +# ----------------------------- +# aclocal traces this macro to find the Autoconf version. +# This is a private macro too. Using m4_define simplifies +# the logic in aclocal, which can simply ignore this definition. +m4_define([_AM_AUTOCONF_VERSION], []) + +# AM_SET_CURRENT_AUTOMAKE_VERSION +# ------------------------------- +# Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced. +# This function is AC_REQUIREd by AM_INIT_AUTOMAKE. +AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION], +[AM_AUTOMAKE_VERSION([1.11.1])dnl +m4_ifndef([AC_AUTOCONF_VERSION], + [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl +_AM_AUTOCONF_VERSION(m4_defn([AC_AUTOCONF_VERSION]))]) + +# AM_AUX_DIR_EXPAND -*- Autoconf -*- + +# Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets +# $ac_aux_dir to `$srcdir/foo'. In other projects, it is set to +# `$srcdir', `$srcdir/..', or `$srcdir/../..'. +# +# Of course, Automake must honor this variable whenever it calls a +# tool from the auxiliary directory. The problem is that $srcdir (and +# therefore $ac_aux_dir as well) can be either absolute or relative, +# depending on how configure is run. This is pretty annoying, since +# it makes $ac_aux_dir quite unusable in subdirectories: in the top +# source directory, any form will work fine, but in subdirectories a +# relative path needs to be adjusted first. +# +# $ac_aux_dir/missing +# fails when called from a subdirectory if $ac_aux_dir is relative +# $top_srcdir/$ac_aux_dir/missing +# fails if $ac_aux_dir is absolute, +# fails when called from a subdirectory in a VPATH build with +# a relative $ac_aux_dir +# +# The reason of the latter failure is that $top_srcdir and $ac_aux_dir +# are both prefixed by $srcdir. In an in-source build this is usually +# harmless because $srcdir is `.', but things will broke when you +# start a VPATH build or use an absolute $srcdir. +# +# So we could use something similar to $top_srcdir/$ac_aux_dir/missing, +# iff we strip the leading $srcdir from $ac_aux_dir. That would be: +# am_aux_dir='\$(top_srcdir)/'`expr "$ac_aux_dir" : "$srcdir//*\(.*\)"` +# and then we would define $MISSING as +# MISSING="\${SHELL} $am_aux_dir/missing" +# This will work as long as MISSING is not called from configure, because +# unfortunately $(top_srcdir) has no meaning in configure. +# However there are other variables, like CC, which are often used in +# configure, and could therefore not use this "fixed" $ac_aux_dir. +# +# Another solution, used here, is to always expand $ac_aux_dir to an +# absolute PATH. The drawback is that using absolute paths prevent a +# configured tree to be moved without reconfiguration. + +AC_DEFUN([AM_AUX_DIR_EXPAND], +[dnl Rely on autoconf to set up CDPATH properly. +AC_PREREQ([2.50])dnl +# expand $ac_aux_dir to an absolute path +am_aux_dir=`cd $ac_aux_dir && pwd` +]) + +# AM_CONDITIONAL -*- Autoconf -*- + +# Copyright (C) 1997, 2000, 2001, 2003, 2004, 2005, 2006, 2008 +# Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# serial 9 + +# AM_CONDITIONAL(NAME, SHELL-CONDITION) +# ------------------------------------- +# Define a conditional. +AC_DEFUN([AM_CONDITIONAL], +[AC_PREREQ(2.52)dnl + ifelse([$1], [TRUE], [AC_FATAL([$0: invalid condition: $1])], + [$1], [FALSE], [AC_FATAL([$0: invalid condition: $1])])dnl +AC_SUBST([$1_TRUE])dnl +AC_SUBST([$1_FALSE])dnl +_AM_SUBST_NOTMAKE([$1_TRUE])dnl +_AM_SUBST_NOTMAKE([$1_FALSE])dnl +m4_define([_AM_COND_VALUE_$1], [$2])dnl +if $2; then + $1_TRUE= + $1_FALSE='#' +else + $1_TRUE='#' + $1_FALSE= +fi +AC_CONFIG_COMMANDS_PRE( +[if test -z "${$1_TRUE}" && test -z "${$1_FALSE}"; then + AC_MSG_ERROR([[conditional "$1" was never defined. +Usually this means the macro was only invoked conditionally.]]) +fi])]) + +# Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009 +# Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# serial 10 + +# There are a few dirty hacks below to avoid letting `AC_PROG_CC' be +# written in clear, in which case automake, when reading aclocal.m4, +# will think it sees a *use*, and therefore will trigger all it's +# C support machinery. Also note that it means that autoscan, seeing +# CC etc. in the Makefile, will ask for an AC_PROG_CC use... + + +# _AM_DEPENDENCIES(NAME) +# ---------------------- +# See how the compiler implements dependency checking. +# NAME is "CC", "CXX", "GCJ", or "OBJC". +# We try a few techniques and use that to set a single cache variable. +# +# We don't AC_REQUIRE the corresponding AC_PROG_CC since the latter was +# modified to invoke _AM_DEPENDENCIES(CC); we would have a circular +# dependency, and given that the user is not expected to run this macro, +# just rely on AC_PROG_CC. +AC_DEFUN([_AM_DEPENDENCIES], +[AC_REQUIRE([AM_SET_DEPDIR])dnl +AC_REQUIRE([AM_OUTPUT_DEPENDENCY_COMMANDS])dnl +AC_REQUIRE([AM_MAKE_INCLUDE])dnl +AC_REQUIRE([AM_DEP_TRACK])dnl + +ifelse([$1], CC, [depcc="$CC" am_compiler_list=], + [$1], CXX, [depcc="$CXX" am_compiler_list=], + [$1], OBJC, [depcc="$OBJC" am_compiler_list='gcc3 gcc'], + [$1], UPC, [depcc="$UPC" am_compiler_list=], + [$1], GCJ, [depcc="$GCJ" am_compiler_list='gcc3 gcc'], + [depcc="$$1" am_compiler_list=]) + +AC_CACHE_CHECK([dependency style of $depcc], + [am_cv_$1_dependencies_compiler_type], +[if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named `D' -- because `-MD' means `put the output + # in D'. + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_$1_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n ['s/^#*\([a-zA-Z0-9]*\))$/\1/p'] < ./depcomp` + fi + am__universal=false + m4_case([$1], [CC], + [case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac], + [CXX], + [case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac]) + + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + # Using `: > sub/conftst$i.h' creates only sub/conftst1.h with + # Solaris 8's {/usr,}/bin/sh. + touch sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + # We check with `-c' and `-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle `-M -o', and we need to detect this. Also, some Intel + # versions had trouble with output in subdirs + am__obj=sub/conftest.${OBJEXT-o} + am__minus_obj="-o $am__obj" + case $depmode in + gcc) + # This depmode causes a compiler race in universal mode. + test "$am__universal" = false || continue + ;; + nosideeffect) + # after this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + msvisualcpp | msvcmsys) + # This compiler won't grok `-c -o', but also, the minuso test has + # not run yet. These depmodes are late enough in the game, and + # so weak that their functioning should not be impacted. + am__obj=conftest.${OBJEXT-o} + am__minus_obj= + ;; + none) break ;; + esac + if depmode=$depmode \ + source=sub/conftest.c object=$am__obj \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep $am__obj sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # or remarks (even with -Werror). So we grep stderr for any message + # that says an option was ignored or not supported. + # When given -MP, icc 7.0 and 7.1 complain thusly: + # icc: Command line warning: ignoring option '-M'; no argument required + # The diagnosis changed in icc 8.0: + # icc: Command line remark: option '-MP' not supported + if (grep 'ignoring option' conftest.err || + grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else + am_cv_$1_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_$1_dependencies_compiler_type=none +fi +]) +AC_SUBST([$1DEPMODE], [depmode=$am_cv_$1_dependencies_compiler_type]) +AM_CONDITIONAL([am__fastdep$1], [ + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_$1_dependencies_compiler_type" = gcc3]) +]) + + +# AM_SET_DEPDIR +# ------------- +# Choose a directory name for dependency files. +# This macro is AC_REQUIREd in _AM_DEPENDENCIES +AC_DEFUN([AM_SET_DEPDIR], +[AC_REQUIRE([AM_SET_LEADING_DOT])dnl +AC_SUBST([DEPDIR], ["${am__leading_dot}deps"])dnl +]) + + +# AM_DEP_TRACK +# ------------ +AC_DEFUN([AM_DEP_TRACK], +[AC_ARG_ENABLE(dependency-tracking, +[ --disable-dependency-tracking speeds up one-time build + --enable-dependency-tracking do not reject slow dependency extractors]) +if test "x$enable_dependency_tracking" != xno; then + am_depcomp="$ac_aux_dir/depcomp" + AMDEPBACKSLASH='\' +fi +AM_CONDITIONAL([AMDEP], [test "x$enable_dependency_tracking" != xno]) +AC_SUBST([AMDEPBACKSLASH])dnl +_AM_SUBST_NOTMAKE([AMDEPBACKSLASH])dnl +]) + +# Generate code to set up dependency tracking. -*- Autoconf -*- + +# Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2008 +# Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +#serial 5 + +# _AM_OUTPUT_DEPENDENCY_COMMANDS +# ------------------------------ +AC_DEFUN([_AM_OUTPUT_DEPENDENCY_COMMANDS], +[{ + # Autoconf 2.62 quotes --file arguments for eval, but not when files + # are listed without --file. Let's play safe and only enable the eval + # if we detect the quoting. + case $CONFIG_FILES in + *\'*) eval set x "$CONFIG_FILES" ;; + *) set x $CONFIG_FILES ;; + esac + shift + for mf + do + # Strip MF so we end up with the name of the file. + mf=`echo "$mf" | sed -e 's/:.*$//'` + # Check whether this is an Automake generated Makefile or not. + # We used to match only the files named `Makefile.in', but + # some people rename them; so instead we look at the file content. + # Grep'ing the first line is not enough: some people post-process + # each Makefile.in and add a new line on top of each file to say so. + # Grep'ing the whole file is not good either: AIX grep has a line + # limit of 2048, but all sed's we know have understand at least 4000. + if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then + dirpart=`AS_DIRNAME("$mf")` + else + continue + fi + # Extract the definition of DEPDIR, am__include, and am__quote + # from the Makefile without running `make'. + DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"` + test -z "$DEPDIR" && continue + am__include=`sed -n 's/^am__include = //p' < "$mf"` + test -z "am__include" && continue + am__quote=`sed -n 's/^am__quote = //p' < "$mf"` + # When using ansi2knr, U may be empty or an underscore; expand it + U=`sed -n 's/^U = //p' < "$mf"` + # Find all dependency output files, they are included files with + # $(DEPDIR) in their names. We invoke sed twice because it is the + # simplest approach to changing $(DEPDIR) to its actual value in the + # expansion. + for file in `sed -n " + s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \ + sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g' -e 's/\$U/'"$U"'/g'`; do + # Make sure the directory exists. + test -f "$dirpart/$file" && continue + fdir=`AS_DIRNAME(["$file"])` + AS_MKDIR_P([$dirpart/$fdir]) + # echo "creating $dirpart/$file" + echo '# dummy' > "$dirpart/$file" + done + done +} +])# _AM_OUTPUT_DEPENDENCY_COMMANDS + + +# AM_OUTPUT_DEPENDENCY_COMMANDS +# ----------------------------- +# This macro should only be invoked once -- use via AC_REQUIRE. +# +# This code is only required when automatic dependency tracking +# is enabled. FIXME. This creates each `.P' file that we will +# need in order to bootstrap the dependency handling code. +AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS], +[AC_CONFIG_COMMANDS([depfiles], + [test x"$AMDEP_TRUE" != x"" || _AM_OUTPUT_DEPENDENCY_COMMANDS], + [AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"]) +]) + +# Do all the work for Automake. -*- Autoconf -*- + +# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +# 2005, 2006, 2008, 2009 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# serial 16 + +# This macro actually does too much. Some checks are only needed if +# your package does certain things. But this isn't really a big deal. + +# AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE]) +# AM_INIT_AUTOMAKE([OPTIONS]) +# ----------------------------------------------- +# The call with PACKAGE and VERSION arguments is the old style +# call (pre autoconf-2.50), which is being phased out. PACKAGE +# and VERSION should now be passed to AC_INIT and removed from +# the call to AM_INIT_AUTOMAKE. +# We support both call styles for the transition. After +# the next Automake release, Autoconf can make the AC_INIT +# arguments mandatory, and then we can depend on a new Autoconf +# release and drop the old call support. +AC_DEFUN([AM_INIT_AUTOMAKE], +[AC_PREREQ([2.62])dnl +dnl Autoconf wants to disallow AM_ names. We explicitly allow +dnl the ones we care about. +m4_pattern_allow([^AM_[A-Z]+FLAGS$])dnl +AC_REQUIRE([AM_SET_CURRENT_AUTOMAKE_VERSION])dnl +AC_REQUIRE([AC_PROG_INSTALL])dnl +if test "`cd $srcdir && pwd`" != "`pwd`"; then + # Use -I$(srcdir) only when $(srcdir) != ., so that make's output + # is not polluted with repeated "-I." + AC_SUBST([am__isrc], [' -I$(srcdir)'])_AM_SUBST_NOTMAKE([am__isrc])dnl + # test to see if srcdir already configured + if test -f $srcdir/config.status; then + AC_MSG_ERROR([source directory already configured; run "make distclean" there first]) + fi +fi + +# test whether we have cygpath +if test -z "$CYGPATH_W"; then + if (cygpath --version) >/dev/null 2>/dev/null; then + CYGPATH_W='cygpath -w' + else + CYGPATH_W=echo + fi +fi +AC_SUBST([CYGPATH_W]) + +# Define the identity of the package. +dnl Distinguish between old-style and new-style calls. +m4_ifval([$2], +[m4_ifval([$3], [_AM_SET_OPTION([no-define])])dnl + AC_SUBST([PACKAGE], [$1])dnl + AC_SUBST([VERSION], [$2])], +[_AM_SET_OPTIONS([$1])dnl +dnl Diagnose old-style AC_INIT with new-style AM_AUTOMAKE_INIT. +m4_if(m4_ifdef([AC_PACKAGE_NAME], 1)m4_ifdef([AC_PACKAGE_VERSION], 1), 11,, + [m4_fatal([AC_INIT should be called with package and version arguments])])dnl + AC_SUBST([PACKAGE], ['AC_PACKAGE_TARNAME'])dnl + AC_SUBST([VERSION], ['AC_PACKAGE_VERSION'])])dnl + +_AM_IF_OPTION([no-define],, +[AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE", [Name of package]) + AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package])])dnl + +# Some tools Automake needs. +AC_REQUIRE([AM_SANITY_CHECK])dnl +AC_REQUIRE([AC_ARG_PROGRAM])dnl +AM_MISSING_PROG(ACLOCAL, aclocal-${am__api_version}) +AM_MISSING_PROG(AUTOCONF, autoconf) +AM_MISSING_PROG(AUTOMAKE, automake-${am__api_version}) +AM_MISSING_PROG(AUTOHEADER, autoheader) +AM_MISSING_PROG(MAKEINFO, makeinfo) +AC_REQUIRE([AM_PROG_INSTALL_SH])dnl +AC_REQUIRE([AM_PROG_INSTALL_STRIP])dnl +AC_REQUIRE([AM_PROG_MKDIR_P])dnl +# We need awk for the "check" target. The system "awk" is bad on +# some platforms. +AC_REQUIRE([AC_PROG_AWK])dnl +AC_REQUIRE([AC_PROG_MAKE_SET])dnl +AC_REQUIRE([AM_SET_LEADING_DOT])dnl +_AM_IF_OPTION([tar-ustar], [_AM_PROG_TAR([ustar])], + [_AM_IF_OPTION([tar-pax], [_AM_PROG_TAR([pax])], + [_AM_PROG_TAR([v7])])]) +_AM_IF_OPTION([no-dependencies],, +[AC_PROVIDE_IFELSE([AC_PROG_CC], + [_AM_DEPENDENCIES(CC)], + [define([AC_PROG_CC], + defn([AC_PROG_CC])[_AM_DEPENDENCIES(CC)])])dnl +AC_PROVIDE_IFELSE([AC_PROG_CXX], + [_AM_DEPENDENCIES(CXX)], + [define([AC_PROG_CXX], + defn([AC_PROG_CXX])[_AM_DEPENDENCIES(CXX)])])dnl +AC_PROVIDE_IFELSE([AC_PROG_OBJC], + [_AM_DEPENDENCIES(OBJC)], + [define([AC_PROG_OBJC], + defn([AC_PROG_OBJC])[_AM_DEPENDENCIES(OBJC)])])dnl +]) +_AM_IF_OPTION([silent-rules], [AC_REQUIRE([AM_SILENT_RULES])])dnl +dnl The `parallel-tests' driver may need to know about EXEEXT, so add the +dnl `am__EXEEXT' conditional if _AM_COMPILER_EXEEXT was seen. This macro +dnl is hooked onto _AC_COMPILER_EXEEXT early, see below. +AC_CONFIG_COMMANDS_PRE(dnl +[m4_provide_if([_AM_COMPILER_EXEEXT], + [AM_CONDITIONAL([am__EXEEXT], [test -n "$EXEEXT"])])])dnl +]) + +dnl Hook into `_AC_COMPILER_EXEEXT' early to learn its expansion. Do not +dnl add the conditional right here, as _AC_COMPILER_EXEEXT may be further +dnl mangled by Autoconf and run in a shell conditional statement. +m4_define([_AC_COMPILER_EXEEXT], +m4_defn([_AC_COMPILER_EXEEXT])[m4_provide([_AM_COMPILER_EXEEXT])]) + + +# When config.status generates a header, we must update the stamp-h file. +# This file resides in the same directory as the config header +# that is generated. The stamp files are numbered to have different names. + +# Autoconf calls _AC_AM_CONFIG_HEADER_HOOK (when defined) in the +# loop where config.status creates the headers, so we can generate +# our stamp files there. +AC_DEFUN([_AC_AM_CONFIG_HEADER_HOOK], +[# Compute $1's index in $config_headers. +_am_arg=$1 +_am_stamp_count=1 +for _am_header in $config_headers :; do + case $_am_header in + $_am_arg | $_am_arg:* ) + break ;; + * ) + _am_stamp_count=`expr $_am_stamp_count + 1` ;; + esac +done +echo "timestamp for $_am_arg" >`AS_DIRNAME(["$_am_arg"])`/stamp-h[]$_am_stamp_count]) + +# Copyright (C) 2001, 2003, 2005, 2008 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_PROG_INSTALL_SH +# ------------------ +# Define $install_sh. +AC_DEFUN([AM_PROG_INSTALL_SH], +[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl +if test x"${install_sh}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; + *) + install_sh="\${SHELL} $am_aux_dir/install-sh" + esac +fi +AC_SUBST(install_sh)]) + +# Add --enable-maintainer-mode option to configure. -*- Autoconf -*- +# From Jim Meyering + +# Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2008 +# Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# serial 5 + +# AM_MAINTAINER_MODE([DEFAULT-MODE]) +# ---------------------------------- +# Control maintainer-specific portions of Makefiles. +# Default is to disable them, unless `enable' is passed literally. +# For symmetry, `disable' may be passed as well. Anyway, the user +# can override the default with the --enable/--disable switch. +AC_DEFUN([AM_MAINTAINER_MODE], +[m4_case(m4_default([$1], [disable]), + [enable], [m4_define([am_maintainer_other], [disable])], + [disable], [m4_define([am_maintainer_other], [enable])], + [m4_define([am_maintainer_other], [enable]) + m4_warn([syntax], [unexpected argument to AM@&t@_MAINTAINER_MODE: $1])]) +AC_MSG_CHECKING([whether to am_maintainer_other maintainer-specific portions of Makefiles]) + dnl maintainer-mode's default is 'disable' unless 'enable' is passed + AC_ARG_ENABLE([maintainer-mode], +[ --][am_maintainer_other][-maintainer-mode am_maintainer_other make rules and dependencies not useful + (and sometimes confusing) to the casual installer], + [USE_MAINTAINER_MODE=$enableval], + [USE_MAINTAINER_MODE=]m4_if(am_maintainer_other, [enable], [no], [yes])) + AC_MSG_RESULT([$USE_MAINTAINER_MODE]) + AM_CONDITIONAL([MAINTAINER_MODE], [test $USE_MAINTAINER_MODE = yes]) + MAINT=$MAINTAINER_MODE_TRUE + AC_SUBST([MAINT])dnl +] +) + +AU_DEFUN([jm_MAINTAINER_MODE], [AM_MAINTAINER_MODE]) + +# Check to see how 'make' treats includes. -*- Autoconf -*- + +# Copyright (C) 2001, 2002, 2003, 2005, 2009 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# serial 4 + +# AM_MAKE_INCLUDE() +# ----------------- +# Check to see how make treats includes. +AC_DEFUN([AM_MAKE_INCLUDE], +[am_make=${MAKE-make} +cat > confinc << 'END' +am__doit: + @echo this is the am__doit target +.PHONY: am__doit +END +# If we don't find an include directive, just comment out the code. +AC_MSG_CHECKING([for style of include used by $am_make]) +am__include="#" +am__quote= +_am_result=none +# First try GNU make style include. +echo "include confinc" > confmf +# Ignore all kinds of additional output from `make'. +case `$am_make -s -f confmf 2> /dev/null` in #( +*the\ am__doit\ target*) + am__include=include + am__quote= + _am_result=GNU + ;; +esac +# Now try BSD make style include. +if test "$am__include" = "#"; then + echo '.include "confinc"' > confmf + case `$am_make -s -f confmf 2> /dev/null` in #( + *the\ am__doit\ target*) + am__include=.include + am__quote="\"" + _am_result=BSD + ;; + esac +fi +AC_SUBST([am__include]) +AC_SUBST([am__quote]) +AC_MSG_RESULT([$_am_result]) +rm -f confinc confmf +]) + +# Fake the existence of programs that GNU maintainers use. -*- Autoconf -*- + +# Copyright (C) 1997, 1999, 2000, 2001, 2003, 2004, 2005, 2008 +# Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# serial 6 + +# AM_MISSING_PROG(NAME, PROGRAM) +# ------------------------------ +AC_DEFUN([AM_MISSING_PROG], +[AC_REQUIRE([AM_MISSING_HAS_RUN]) +$1=${$1-"${am_missing_run}$2"} +AC_SUBST($1)]) + + +# AM_MISSING_HAS_RUN +# ------------------ +# Define MISSING if not defined so far and test if it supports --run. +# If it does, set am_missing_run to use it, otherwise, to nothing. +AC_DEFUN([AM_MISSING_HAS_RUN], +[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl +AC_REQUIRE_AUX_FILE([missing])dnl +if test x"${MISSING+set}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; + *) + MISSING="\${SHELL} $am_aux_dir/missing" ;; + esac +fi +# Use eval to expand $SHELL +if eval "$MISSING --run true"; then + am_missing_run="$MISSING --run " +else + am_missing_run= + AC_MSG_WARN([`missing' script is too old or missing]) +fi +]) + +# Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_PROG_MKDIR_P +# --------------- +# Check for `mkdir -p'. +AC_DEFUN([AM_PROG_MKDIR_P], +[AC_PREREQ([2.60])dnl +AC_REQUIRE([AC_PROG_MKDIR_P])dnl +dnl Automake 1.8 to 1.9.6 used to define mkdir_p. We now use MKDIR_P, +dnl while keeping a definition of mkdir_p for backward compatibility. +dnl @MKDIR_P@ is magic: AC_OUTPUT adjusts its value for each Makefile. +dnl However we cannot define mkdir_p as $(MKDIR_P) for the sake of +dnl Makefile.ins that do not define MKDIR_P, so we do our own +dnl adjustment using top_builddir (which is defined more often than +dnl MKDIR_P). +AC_SUBST([mkdir_p], ["$MKDIR_P"])dnl +case $mkdir_p in + [[\\/$]]* | ?:[[\\/]]*) ;; + */*) mkdir_p="\$(top_builddir)/$mkdir_p" ;; +esac +]) + +# Helper functions for option handling. -*- Autoconf -*- + +# Copyright (C) 2001, 2002, 2003, 2005, 2008 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# serial 4 + +# _AM_MANGLE_OPTION(NAME) +# ----------------------- +AC_DEFUN([_AM_MANGLE_OPTION], +[[_AM_OPTION_]m4_bpatsubst($1, [[^a-zA-Z0-9_]], [_])]) + +# _AM_SET_OPTION(NAME) +# ------------------------------ +# Set option NAME. Presently that only means defining a flag for this option. +AC_DEFUN([_AM_SET_OPTION], +[m4_define(_AM_MANGLE_OPTION([$1]), 1)]) + +# _AM_SET_OPTIONS(OPTIONS) +# ---------------------------------- +# OPTIONS is a space-separated list of Automake options. +AC_DEFUN([_AM_SET_OPTIONS], +[m4_foreach_w([_AM_Option], [$1], [_AM_SET_OPTION(_AM_Option)])]) + +# _AM_IF_OPTION(OPTION, IF-SET, [IF-NOT-SET]) +# ------------------------------------------- +# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise. +AC_DEFUN([_AM_IF_OPTION], +[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])]) + +# Check to make sure that the build environment is sane. -*- Autoconf -*- + +# Copyright (C) 1996, 1997, 2000, 2001, 2003, 2005, 2008 +# Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# serial 5 + +# AM_SANITY_CHECK +# --------------- +AC_DEFUN([AM_SANITY_CHECK], +[AC_MSG_CHECKING([whether build environment is sane]) +# Just in case +sleep 1 +echo timestamp > conftest.file +# Reject unsafe characters in $srcdir or the absolute working directory +# name. Accept space and tab only in the latter. +am_lf=' +' +case `pwd` in + *[[\\\"\#\$\&\'\`$am_lf]]*) + AC_MSG_ERROR([unsafe absolute working directory name]);; +esac +case $srcdir in + *[[\\\"\#\$\&\'\`$am_lf\ \ ]]*) + AC_MSG_ERROR([unsafe srcdir value: `$srcdir']);; +esac + +# Do `set' in a subshell so we don't clobber the current shell's +# arguments. Must try -L first in case configure is actually a +# symlink; some systems play weird games with the mod time of symlinks +# (eg FreeBSD returns the mod time of the symlink's containing +# directory). +if ( + set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` + if test "$[*]" = "X"; then + # -L didn't work. + set X `ls -t "$srcdir/configure" conftest.file` + fi + rm -f conftest.file + if test "$[*]" != "X $srcdir/configure conftest.file" \ + && test "$[*]" != "X conftest.file $srcdir/configure"; then + + # If neither matched, then we have a broken ls. This can happen + # if, for instance, CONFIG_SHELL is bash and it inherits a + # broken ls alias from the environment. This has actually + # happened. Such a system could not be considered "sane". + AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken +alias in your environment]) + fi + + test "$[2]" = conftest.file + ) +then + # Ok. + : +else + AC_MSG_ERROR([newly created file is older than distributed files! +Check your system clock]) +fi +AC_MSG_RESULT(yes)]) + +# Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_PROG_INSTALL_STRIP +# --------------------- +# One issue with vendor `install' (even GNU) is that you can't +# specify the program used to strip binaries. This is especially +# annoying in cross-compiling environments, where the build's strip +# is unlikely to handle the host's binaries. +# Fortunately install-sh will honor a STRIPPROG variable, so we +# always use install-sh in `make install-strip', and initialize +# STRIPPROG with the value of the STRIP variable (set by the user). +AC_DEFUN([AM_PROG_INSTALL_STRIP], +[AC_REQUIRE([AM_PROG_INSTALL_SH])dnl +# Installed binaries are usually stripped using `strip' when the user +# run `make install-strip'. However `strip' might not be the right +# tool to use in cross-compilation environments, therefore Automake +# will honor the `STRIP' environment variable to overrule this program. +dnl Don't test for $cross_compiling = yes, because it might be `maybe'. +if test "$cross_compiling" != no; then + AC_CHECK_TOOL([STRIP], [strip], :) +fi +INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" +AC_SUBST([INSTALL_STRIP_PROGRAM])]) + +# Copyright (C) 2006, 2008 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# serial 2 + +# _AM_SUBST_NOTMAKE(VARIABLE) +# --------------------------- +# Prevent Automake from outputting VARIABLE = @VARIABLE@ in Makefile.in. +# This macro is traced by Automake. +AC_DEFUN([_AM_SUBST_NOTMAKE]) + +# AM_SUBST_NOTMAKE(VARIABLE) +# --------------------------- +# Public sister of _AM_SUBST_NOTMAKE. +AC_DEFUN([AM_SUBST_NOTMAKE], [_AM_SUBST_NOTMAKE($@)]) + +# Check how to create a tarball. -*- Autoconf -*- + +# Copyright (C) 2004, 2005 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# serial 2 + +# _AM_PROG_TAR(FORMAT) +# -------------------- +# Check how to create a tarball in format FORMAT. +# FORMAT should be one of `v7', `ustar', or `pax'. +# +# Substitute a variable $(am__tar) that is a command +# writing to stdout a FORMAT-tarball containing the directory +# $tardir. +# tardir=directory && $(am__tar) > result.tar +# +# Substitute a variable $(am__untar) that extract such +# a tarball read from stdin. +# $(am__untar) < result.tar +AC_DEFUN([_AM_PROG_TAR], +[# Always define AMTAR for backward compatibility. +AM_MISSING_PROG([AMTAR], [tar]) +m4_if([$1], [v7], + [am__tar='${AMTAR} chof - "$$tardir"'; am__untar='${AMTAR} xf -'], + [m4_case([$1], [ustar],, [pax],, + [m4_fatal([Unknown tar format])]) +AC_MSG_CHECKING([how to create a $1 tar archive]) +# Loop over all known methods to create a tar archive until one works. +_am_tools='gnutar m4_if([$1], [ustar], [plaintar]) pax cpio none' +_am_tools=${am_cv_prog_tar_$1-$_am_tools} +# Do not fold the above two line into one, because Tru64 sh and +# Solaris sh will not grok spaces in the rhs of `-'. +for _am_tool in $_am_tools +do + case $_am_tool in + gnutar) + for _am_tar in tar gnutar gtar; + do + AM_RUN_LOG([$_am_tar --version]) && break + done + am__tar="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$$tardir"' + am__tar_="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$tardir"' + am__untar="$_am_tar -xf -" + ;; + plaintar) + # Must skip GNU tar: if it does not support --format= it doesn't create + # ustar tarball either. + (tar --version) >/dev/null 2>&1 && continue + am__tar='tar chf - "$$tardir"' + am__tar_='tar chf - "$tardir"' + am__untar='tar xf -' + ;; + pax) + am__tar='pax -L -x $1 -w "$$tardir"' + am__tar_='pax -L -x $1 -w "$tardir"' + am__untar='pax -r' + ;; + cpio) + am__tar='find "$$tardir" -print | cpio -o -H $1 -L' + am__tar_='find "$tardir" -print | cpio -o -H $1 -L' + am__untar='cpio -i -H $1 -d' + ;; + none) + am__tar=false + am__tar_=false + am__untar=false + ;; + esac + + # If the value was cached, stop now. We just wanted to have am__tar + # and am__untar set. + test -n "${am_cv_prog_tar_$1}" && break + + # tar/untar a dummy directory, and stop if the command works + rm -rf conftest.dir + mkdir conftest.dir + echo GrepMe > conftest.dir/file + AM_RUN_LOG([tardir=conftest.dir && eval $am__tar_ >conftest.tar]) + rm -rf conftest.dir + if test -s conftest.tar; then + AM_RUN_LOG([$am__untar /dev/null 2>&1 && break + fi +done +rm -rf conftest.dir + +AC_CACHE_VAL([am_cv_prog_tar_$1], [am_cv_prog_tar_$1=$_am_tool]) +AC_MSG_RESULT([$am_cv_prog_tar_$1])]) +AC_SUBST([am__tar]) +AC_SUBST([am__untar]) +]) # _AM_PROG_TAR + +m4_include([../config/depstand.m4]) +m4_include([../config/lead-dot.m4]) +m4_include([../config/lthostflags.m4]) +m4_include([../config/multi.m4]) +m4_include([../config/override.m4]) +m4_include([../config/stdint.m4]) +m4_include([../ltoptions.m4]) +m4_include([../ltsugar.m4]) +m4_include([../ltversion.m4]) +m4_include([../lt~obsolete.m4]) +m4_include([acinclude.m4]) diff --git a/libgfortran/c99_protos.h b/libgfortran/c99_protos.h new file mode 100644 index 000000000..73a22c3da --- /dev/null +++ b/libgfortran/c99_protos.h @@ -0,0 +1,633 @@ +/* Declarations of various C99 functions + Copyright (C) 2004, 2006, 2007, 2009 Free Software Foundation, Inc. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#ifndef C99_PROTOS_H +#define C99_PROTOS_H 1 + +/* float variants of libm functions */ +#ifndef HAVE_ACOSF +#define HAVE_ACOSF 1 +extern float acosf(float); +#endif + +#if HAVE_ACOSH && !HAVE_ACOSHF +#define HAVE_ACOSHF 1 +extern float acoshf(float); +#endif + +#ifndef HAVE_ASINF +#define HAVE_ASINF 1 +extern float asinf(float); +#endif + +#if HAVE_ASINH && !HAVE_ASINHF +#define HAVE_ASINHF 1 +extern float asinhf(float); +#endif + +#ifndef HAVE_ATAN2F +#define HAVE_ATAN2F 1 +extern float atan2f(float, float); +#endif + +#ifndef HAVE_ATANF +#define HAVE_ATANF 1 +extern float atanf(float); +#endif + +#if HAVE_ATANH && !HAVE_ATANHF +#define HAVE_ATANHF 1 +extern float atanhf(float); +#endif + +#ifndef HAVE_CEILF +#define HAVE_CEILF 1 +extern float ceilf(float); +#endif + +#ifndef HAVE_COPYSIGNF +#define HAVE_COPYSIGNF 1 +extern float copysignf(float, float); +#endif + +#ifndef HAVE_COSF +#define HAVE_COSF 1 +extern float cosf(float); +#endif + +#ifndef HAVE_COSHF +#define HAVE_COSHF 1 +extern float coshf(float); +#endif + +#ifndef HAVE_EXPF +#define HAVE_EXPF 1 +extern float expf(float); +#endif + +#ifndef HAVE_FABSF +#define HAVE_FABSF 1 +extern float fabsf(float); +#endif + +#ifndef HAVE_FLOORF +#define HAVE_FLOORF 1 +extern float floorf(float); +#endif + +#ifndef HAVE_FLOORL +#define HAVE_FLOORL 1 +extern long double floorl (long double x); +#endif + +#ifndef HAVE_FMODF +#define HAVE_FMODF 1 +extern float fmodf (float x, float y); +#endif + +#ifndef HAVE_FMODL +#define HAVE_FMODL 1 +extern long double fmodl (long double x, long double y); +#endif + +#ifndef HAVE_FREXPF +#define HAVE_FREXPF 1 +extern float frexpf(float, int *); +#endif + +#ifndef HAVE_HYPOTF +#define HAVE_HYPOTF 1 +extern float hypotf(float, float); +#endif + +#ifndef HAVE_LOGF +#define HAVE_LOGF 1 +extern float logf(float); +#endif + +#ifndef HAVE_LOG10F +#define HAVE_LOG10F 1 +extern float log10f(float); +#endif + +#ifndef HAVE_SCALBN +#define HAVE_SCALBN 1 +extern double scalbn(double, int); +#endif + +#ifndef HAVE_SCALBNF +#define HAVE_SCALBNF 1 +extern float scalbnf(float, int); +#endif + +#ifndef HAVE_SINF +#define HAVE_SINF 1 +extern float sinf(float); +#endif + +#ifndef HAVE_SINHF +#define HAVE_SINHF 1 +extern float sinhf(float); +#endif + +#ifndef HAVE_SQRTF +#define HAVE_SQRTF 1 +extern float sqrtf(float); +#endif + +#ifndef HAVE_TANF +#define HAVE_TANF 1 +extern float tanf(float); +#endif + +#ifndef HAVE_TANHF +#define HAVE_TANHF 1 +extern float tanhf(float); +#endif + +#ifndef HAVE_TRUNC +#define HAVE_TRUNC 1 +extern double trunc(double); +#endif + +#ifndef HAVE_TRUNCF +#define HAVE_TRUNCF 1 +extern float truncf(float); +#endif + +#ifndef HAVE_NEXTAFTERF +#define HAVE_NEXTAFTERF 1 +extern float nextafterf(float, float); +#endif + +#ifndef HAVE_POWF +#define HAVE_POWF 1 +extern float powf(float, float); +#endif + +#ifndef HAVE_ROUND +#define HAVE_ROUND 1 +extern double round(double); +#endif + +#ifndef HAVE_ROUNDF +#define HAVE_ROUNDF 1 +extern float roundf(float); +#endif + +#if !defined(HAVE_ROUNDL) +#define HAVE_ROUNDL 1 +extern long double roundl(long double); +#endif + + + +#if !defined(HAVE_LROUNDF) && defined(HAVE_ROUNDF) +#define HAVE_LROUNDF 1 +long int lroundf (float); +#endif + +#if !defined(HAVE_LROUND) && defined(HAVE_ROUND) +#define HAVE_LROUND 1 +long int lround (double); +#endif + +#if !defined(HAVE_LROUNDL) && defined(HAVE_ROUNDL) +#define HAVE_LROUNDL 1 +long int lroundl (long double); +#endif + +#if !defined(HAVE_LLROUNDF) && defined(HAVE_ROUNDF) +#define HAVE_LLROUNDF 1 +long long int llroundf (float); +#endif + +#if !defined(HAVE_LLROUND) && defined(HAVE_ROUND) +#define HAVE_LLROUND 1 +long long int llround (double); +#endif + +#if !defined(HAVE_LLROUNDL) && defined(HAVE_ROUNDL) +#define HAVE_LLROUNDL 1 +long long int llroundl (long double); +#endif + +/* Wrappers for systems without the various C99 single precision Bessel + functions. */ + +#if defined(HAVE_J0) && ! defined(HAVE_J0F) +#define HAVE_J0F 1 +extern float j0f (float); +#endif + +#if defined(HAVE_J1) && !defined(HAVE_J1F) +#define HAVE_J1F 1 +extern float j1f (float); +#endif + +#if defined(HAVE_JN) && !defined(HAVE_JNF) +#define HAVE_JNF 1 +extern float jnf (int, float); +#endif + +#if defined(HAVE_Y0) && !defined(HAVE_Y0F) +#define HAVE_Y0F 1 +extern float y0f (float); +#endif + +#if defined(HAVE_Y1) && !defined(HAVE_Y1F) +#define HAVE_Y1F 1 +extern float y1f (float); +#endif + +#if defined(HAVE_YN) && !defined(HAVE_YNF) +#define HAVE_YNF 1 +extern float ynf (int, float); +#endif + + +/* Wrappers for systems without the C99 erff() and erfcf() functions. */ + +#if defined(HAVE_ERF) && !defined(HAVE_ERFF) +#define HAVE_ERFF 1 +extern float erff (float); +#endif + +#if defined(HAVE_ERFC) && !defined(HAVE_ERFCF) +#define HAVE_ERFCF 1 +extern float erfcf (float); +#endif + + + +/* log10l is needed on all platforms for decimal I/O */ +#ifndef HAVE_LOG10L +#define HAVE_LOG10L 1 +extern long double log10l(long double); +#endif + + +/* complex math functions */ + +#if !defined(HAVE_CABSF) +#define HAVE_CABSF 1 +extern float cabsf (float complex); +#endif + +#if !defined(HAVE_CABS) +#define HAVE_CABS 1 +extern double cabs (double complex); +#endif + +#if !defined(HAVE_CABSL) && defined(HAVE_HYPOTL) +#define HAVE_CABSL 1 +extern long double cabsl (long double complex); +#endif + + +#if !defined(HAVE_CARGF) +#define HAVE_CARGF 1 +extern float cargf (float complex); +#endif + +#if !defined(HAVE_CARG) +#define HAVE_CARG 1 +extern double carg (double complex); +#endif + +#if !defined(HAVE_CARGL) && defined(HAVE_ATAN2L) +#define HAVE_CARGL 1 +extern long double cargl (long double complex); +#endif + + +#if !defined(HAVE_CEXPF) +#define HAVE_CEXPF 1 +extern float complex cexpf (float complex); +#endif + +#if !defined(HAVE_CEXP) +#define HAVE_CEXP 1 +extern double complex cexp (double complex); +#endif + +#if !defined(HAVE_CEXPL) && defined(HAVE_COSL) && defined(HAVE_SINL) && defined(EXPL) +#define HAVE_CEXPL 1 +extern long double complex cexpl (long double complex); +#endif + + +#if !defined(HAVE_CLOGF) +#define HAVE_CLOGF 1 +extern float complex clogf (float complex); +#endif + +#if !defined(HAVE_CLOG) +#define HAVE_CLOG 1 +extern double complex clog (double complex); +#endif + +#if !defined(HAVE_CLOGL) && defined(HAVE_LOGL) && defined(HAVE_CABSL) && defined(HAVE_CARGL) +#define HAVE_CLOGL 1 +extern long double complex clogl (long double complex); +#endif + + +#if !defined(HAVE_CLOG10F) +#define HAVE_CLOG10F 1 +extern float complex clog10f (float complex); +#endif + +#if !defined(HAVE_CLOG10) +#define HAVE_CLOG10 1 +extern double complex clog10 (double complex); +#endif + +#if !defined(HAVE_CLOG10L) && defined(HAVE_LOG10L) && defined(HAVE_CABSL) && defined(HAVE_CARGL) +#define HAVE_CLOG10L 1 +extern long double complex clog10l (long double complex); +#endif + + +#if !defined(HAVE_CPOWF) +#define HAVE_CPOWF 1 +extern float complex cpowf (float complex, float complex); +#endif + +#if !defined(HAVE_CPOW) +#define HAVE_CPOW 1 +extern double complex cpow (double complex, double complex); +#endif + +#if !defined(HAVE_CPOWL) && defined(HAVE_CEXPL) && defined(HAVE_CLOGL) +#define HAVE_CPOWL 1 +extern long double complex cpowl (long double complex, long double complex); +#endif + + +#if !defined(HAVE_CSQRTF) +#define HAVE_CSQRTF 1 +extern float complex csqrtf (float complex); +#endif + +#if !defined(HAVE_CSQRT) +#define HAVE_CSQRT 1 +extern double complex csqrt (double complex); +#endif + +#if !defined(HAVE_CSQRTL) && defined(HAVE_COPYSIGNL) && defined(HAVE_SQRTL) && defined(HAVE_FABSL) && defined(HAVE_HYPOTL) +#define HAVE_CSQRTL 1 +extern long double complex csqrtl (long double complex); +#endif + + +#if !defined(HAVE_CSINHF) +#define HAVE_CSINHF 1 +extern float complex csinhf (float complex); +#endif + +#if !defined(HAVE_CSINH) +#define HAVE_CSINH 1 +extern double complex csinh (double complex); +#endif + +#if !defined(HAVE_CSINHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CSINHL 1 +extern long double complex csinhl (long double complex); +#endif + + +#if !defined(HAVE_CCOSHF) +#define HAVE_CCOSHF 1 +extern float complex ccoshf (float complex); +#endif + +#if !defined(HAVE_CCOSH) +#define HAVE_CCOSH 1 +extern double complex ccosh (double complex); +#endif + +#if !defined(HAVE_CCOSHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CCOSHL 1 +extern long double complex ccoshl (long double complex); +#endif + + +#if !defined(HAVE_CTANHF) +#define HAVE_CTANHF 1 +extern float complex ctanhf (float complex); +#endif + +#if !defined(HAVE_CTANH) +#define HAVE_CTANH 1 +extern double complex ctanh (double complex); +#endif + +#if !defined(HAVE_CTANHL) && defined(HAVE_TANL) && defined(HAVE_TANHL) +#define HAVE_CTANHL 1 +extern long double complex ctanhl (long double complex); +#endif + + +#if !defined(HAVE_CSINF) +#define HAVE_CSINF 1 +extern float complex csinf (float complex); +#endif + +#if !defined(HAVE_CSIN) +#define HAVE_CSIN 1 +extern double complex csin (double complex); +#endif + +#if !defined(HAVE_CSINL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CSINL 1 +extern long double complex csinl (long double complex); +#endif + + +#if !defined(HAVE_CCOSF) +#define HAVE_CCOSF 1 +extern float complex ccosf (float complex); +#endif + +#if !defined(HAVE_CCOS) +#define HAVE_CCOS 1 +extern double complex ccos (double complex); +#endif + +#if !defined(HAVE_CCOSL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CCOSL 1 +extern long double complex ccosl (long double complex); +#endif + + +#if !defined(HAVE_CTANF) +#define HAVE_CTANF 1 +extern float complex ctanf (float complex); +#endif + +#if !defined(HAVE_CTAN) +#define HAVE_CTAN 1 +extern double complex ctan (double complex); +#endif + +#if !defined(HAVE_CTANL) && defined(HAVE_TANL) && defined(HAVE_TANHL) +#define HAVE_CTANL 1 +extern long double complex ctanl (long double complex); +#endif + + +/* Complex ACOS. */ + +#if !defined(HAVE_CACOSF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF) +#define HAVE_CACOSF 1 +extern complex float cacosf (complex float z); +#endif + +#if !defined(HAVE_CACOS) && defined(HAVE_CLOG) && defined(HAVE_CSQRT) +#define HAVE_CACOS 1 +extern complex double cacos (complex double z); +#endif + +#if !defined(HAVE_CACOSL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL) +#define HAVE_CACOSL 1 +extern complex long double cacosl (complex long double z); +#endif + + +/* Complex ASIN. */ + +#if !defined(HAVE_CASINF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF) +#define HAVE_CASINF 1 +extern complex float casinf (complex float z); +#endif + +#if !defined(HAVE_CASIN) && defined(HAVE_CLOG) && defined(HAVE_CSQRT) +#define HAVE_CASIN 1 +extern complex double casin (complex double z); +#endif + +#if !defined(HAVE_CASINL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL) +#define HAVE_CASINL 1 +extern complex long double casinl (complex long double z); +#endif + + +/* Complex ATAN. */ + +#if !defined(HAVE_CATANF) && defined(HAVE_CLOGF) +#define HAVE_CATANF 1 +extern complex float catanf (complex float z); +#endif + +#if !defined(HAVE_CATAN) && defined(HAVE_CLOG) +#define HAVE_CATAN 1 +extern complex double catan (complex double z); +#endif + +#if !defined(HAVE_CATANL) && defined(HAVE_CLOGL) +#define HAVE_CATANL 1 +extern complex long double catanl (complex long double z); +#endif + + +/* Complex ASINH. */ + +#if !defined(HAVE_CASINHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF) +#define HAVE_CASINHF 1 +extern complex float casinhf (complex float z); +#endif + + +#if !defined(HAVE_CASINH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT) +#define HAVE_CASINH 1 +extern complex double casinh (complex double z); +#endif + +#if !defined(HAVE_CASINHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL) +#define HAVE_CASINHL 1 +extern complex long double casinhl (complex long double z); +#endif + + +/* Complex ACOSH. */ + +#if !defined(HAVE_CACOSHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF) +#define HAVE_CACOSHF 1 +extern complex float cacoshf (complex float z); +#endif + +#if !defined(HAVE_CACOSH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT) +#define HAVE_CACOSH 1 +extern complex double cacosh (complex double z); +#endif + +#if !defined(HAVE_CACOSHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL) +#define HAVE_CACOSHL 1 +extern complex long double cacoshl (complex long double z); +#endif + + +/* Complex ATANH. */ + +#if !defined(HAVE_CATANHF) && defined(HAVE_CLOGF) +#define HAVE_CATANHF 1 +extern complex float catanhf (complex float z); +#endif + +#if !defined(HAVE_CATANH) && defined(HAVE_CLOG) +#define HAVE_CATANH 1 +extern complex double catanh (complex double z); +#endif + +#if !defined(HAVE_CATANHL) && defined(HAVE_CLOGL) +#define HAVE_CATANHL 1 +extern complex long double catanhl (complex long double z); +#endif + + +/* Gamma-related prototypes. */ +#if !defined(HAVE_TGAMMA) +#define HAVE_TGAMMA 1 +extern double tgamma (double); +#endif + +#if !defined(HAVE_LGAMMA) +#define HAVE_LGAMMA 1 +extern double lgamma (double); +#endif + +#if defined(HAVE_TGAMMA) && !defined(HAVE_TGAMMAF) +#define HAVE_TGAMMAF 1 +extern float tgammaf (float); +#endif + +#if defined(HAVE_LGAMMA) && !defined(HAVE_LGAMMAF) +#define HAVE_LGAMMAF 1 +extern float lgammaf (float); +#endif + + +#endif /* C99_PROTOS_H */ + diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in new file mode 100644 index 000000000..a99ba6984 --- /dev/null +++ b/libgfortran/config.h.in @@ -0,0 +1,952 @@ +/* config.h.in. Generated from configure.ac by autoheader. */ + +/* Define to 0 if the target shouldn't use #pragma weak */ +#undef GTHREAD_USE_WEAK + +/* Define to 1 if you have the `access' function. */ +#undef HAVE_ACCESS + +/* libm includes acos */ +#undef HAVE_ACOS + +/* libm includes acosf */ +#undef HAVE_ACOSF + +/* libm includes acosh */ +#undef HAVE_ACOSH + +/* libm includes acoshf */ +#undef HAVE_ACOSHF + +/* libm includes acoshl */ +#undef HAVE_ACOSHL + +/* libm includes acosl */ +#undef HAVE_ACOSL + +/* Define to 1 if you have the `alarm' function. */ +#undef HAVE_ALARM + +/* libm includes asin */ +#undef HAVE_ASIN + +/* libm includes asinf */ +#undef HAVE_ASINF + +/* libm includes asinh */ +#undef HAVE_ASINH + +/* libm includes asinhf */ +#undef HAVE_ASINHF + +/* libm includes asinhl */ +#undef HAVE_ASINHL + +/* libm includes asinl */ +#undef HAVE_ASINL + +/* libm includes atan */ +#undef HAVE_ATAN + +/* libm includes atan2 */ +#undef HAVE_ATAN2 + +/* libm includes atan2f */ +#undef HAVE_ATAN2F + +/* libm includes atan2l */ +#undef HAVE_ATAN2L + +/* libm includes atanf */ +#undef HAVE_ATANF + +/* libm includes atanh */ +#undef HAVE_ATANH + +/* libm includes atanhf */ +#undef HAVE_ATANHF + +/* libm includes atanhl */ +#undef HAVE_ATANHL + +/* libm includes atanl */ +#undef HAVE_ATANL + +/* Define to 1 if the target supports __attribute__((alias(...))). */ +#undef HAVE_ATTRIBUTE_ALIAS + +/* Define to 1 if the target supports __attribute__((dllexport)). */ +#undef HAVE_ATTRIBUTE_DLLEXPORT + +/* Define to 1 if the target supports __attribute__((visibility(...))). */ +#undef HAVE_ATTRIBUTE_VISIBILITY + +/* Define to 1 if you have the `backtrace' function. */ +#undef HAVE_BACKTRACE + +/* Define to 1 if you have the `backtrace_symbols' function. */ +#undef HAVE_BACKTRACE_SYMBOLS + +/* Define if powf is broken. */ +#undef HAVE_BROKEN_POWF + +/* libm includes cabs */ +#undef HAVE_CABS + +/* libm includes cabsf */ +#undef HAVE_CABSF + +/* libm includes cabsl */ +#undef HAVE_CABSL + +/* libm includes cacos */ +#undef HAVE_CACOS + +/* libm includes cacosf */ +#undef HAVE_CACOSF + +/* libm includes cacosh */ +#undef HAVE_CACOSH + +/* libm includes cacoshf */ +#undef HAVE_CACOSHF + +/* libm includes cacoshl */ +#undef HAVE_CACOSHL + +/* libm includes cacosl */ +#undef HAVE_CACOSL + +/* libm includes carg */ +#undef HAVE_CARG + +/* libm includes cargf */ +#undef HAVE_CARGF + +/* libm includes cargl */ +#undef HAVE_CARGL + +/* libm includes casin */ +#undef HAVE_CASIN + +/* libm includes casinf */ +#undef HAVE_CASINF + +/* libm includes casinh */ +#undef HAVE_CASINH + +/* libm includes casinhf */ +#undef HAVE_CASINHF + +/* libm includes casinhl */ +#undef HAVE_CASINHL + +/* libm includes casinl */ +#undef HAVE_CASINL + +/* libm includes catan */ +#undef HAVE_CATAN + +/* libm includes catanf */ +#undef HAVE_CATANF + +/* libm includes catanh */ +#undef HAVE_CATANH + +/* libm includes catanhf */ +#undef HAVE_CATANHF + +/* libm includes catanhl */ +#undef HAVE_CATANHL + +/* libm includes catanl */ +#undef HAVE_CATANL + +/* libm includes ccos */ +#undef HAVE_CCOS + +/* libm includes ccosf */ +#undef HAVE_CCOSF + +/* libm includes ccosh */ +#undef HAVE_CCOSH + +/* libm includes ccoshf */ +#undef HAVE_CCOSHF + +/* libm includes ccoshl */ +#undef HAVE_CCOSHL + +/* libm includes ccosl */ +#undef HAVE_CCOSL + +/* libm includes ceil */ +#undef HAVE_CEIL + +/* libm includes ceilf */ +#undef HAVE_CEILF + +/* libm includes ceill */ +#undef HAVE_CEILL + +/* libm includes cexp */ +#undef HAVE_CEXP + +/* libm includes cexpf */ +#undef HAVE_CEXPF + +/* libm includes cexpl */ +#undef HAVE_CEXPL + +/* Define to 1 if you have the `chdir' function. */ +#undef HAVE_CHDIR + +/* Define to 1 if you have the `chsize' function. */ +#undef HAVE_CHSIZE + +/* Define to 1 if you have the `clock' function. */ +#undef HAVE_CLOCK + +/* Define to 1 if you have the `clock_gettime' function. */ +#undef HAVE_CLOCK_GETTIME + +/* Define to 1 if you have the `clock_gettime' function in librt. */ +#undef HAVE_CLOCK_GETTIME_LIBRT + +/* libm includes clog */ +#undef HAVE_CLOG + +/* libm includes clog10 */ +#undef HAVE_CLOG10 + +/* libm includes clog10f */ +#undef HAVE_CLOG10F + +/* libm includes clog10l */ +#undef HAVE_CLOG10L + +/* libm includes clogf */ +#undef HAVE_CLOGF + +/* libm includes clogl */ +#undef HAVE_CLOGL + +/* Define to 1 if you have the `close' function. */ +#undef HAVE_CLOSE + +/* complex.h exists */ +#undef HAVE_COMPLEX_H + +/* libm includes copysign */ +#undef HAVE_COPYSIGN + +/* libm includes copysignf */ +#undef HAVE_COPYSIGNF + +/* libm includes copysignl */ +#undef HAVE_COPYSIGNL + +/* libm includes cos */ +#undef HAVE_COS + +/* libm includes cosf */ +#undef HAVE_COSF + +/* libm includes cosh */ +#undef HAVE_COSH + +/* libm includes coshf */ +#undef HAVE_COSHF + +/* libm includes coshl */ +#undef HAVE_COSHL + +/* libm includes cosl */ +#undef HAVE_COSL + +/* libm includes cpow */ +#undef HAVE_CPOW + +/* libm includes cpowf */ +#undef HAVE_CPOWF + +/* libm includes cpowl */ +#undef HAVE_CPOWL + +/* Define if CRLF is line terminator. */ +#undef HAVE_CRLF + +/* libm includes csin */ +#undef HAVE_CSIN + +/* libm includes csinf */ +#undef HAVE_CSINF + +/* libm includes csinh */ +#undef HAVE_CSINH + +/* libm includes csinhf */ +#undef HAVE_CSINHF + +/* libm includes csinhl */ +#undef HAVE_CSINHL + +/* libm includes csinl */ +#undef HAVE_CSINL + +/* libm includes csqrt */ +#undef HAVE_CSQRT + +/* libm includes csqrtf */ +#undef HAVE_CSQRTF + +/* libm includes csqrtl */ +#undef HAVE_CSQRTL + +/* libm includes ctan */ +#undef HAVE_CTAN + +/* libm includes ctanf */ +#undef HAVE_CTANF + +/* libm includes ctanh */ +#undef HAVE_CTANH + +/* libm includes ctanhf */ +#undef HAVE_CTANHF + +/* libm includes ctanhl */ +#undef HAVE_CTANHL + +/* libm includes ctanl */ +#undef HAVE_CTANL + +/* Define to 1 if you have the header file. */ +#undef HAVE_DLFCN_H + +/* Define to 1 if you have the `dup' function. */ +#undef HAVE_DUP + +/* Define to 1 if you have the `dup2' function. */ +#undef HAVE_DUP2 + +/* libm includes erf */ +#undef HAVE_ERF + +/* libm includes erfc */ +#undef HAVE_ERFC + +/* libm includes erfcf */ +#undef HAVE_ERFCF + +/* libm includes erfcl */ +#undef HAVE_ERFCL + +/* libm includes erff */ +#undef HAVE_ERFF + +/* libm includes erfl */ +#undef HAVE_ERFL + +/* Define to 1 if you have the header file. */ +#undef HAVE_EXECINFO_H + +/* Define to 1 if you have the `execl' function. */ +#undef HAVE_EXECL + +/* Define to 1 if you have the `execvp' function. */ +#undef HAVE_EXECVP + +/* libm includes exp */ +#undef HAVE_EXP + +/* libm includes expf */ +#undef HAVE_EXPF + +/* libm includes expl */ +#undef HAVE_EXPL + +/* libm includes fabs */ +#undef HAVE_FABS + +/* libm includes fabsf */ +#undef HAVE_FABSF + +/* libm includes fabsl */ +#undef HAVE_FABSL + +/* Define to 1 if you have the `fdopen' function. */ +#undef HAVE_FDOPEN + +/* libm includes feenableexcept */ +#undef HAVE_FEENABLEEXCEPT + +/* Define to 1 if you have the header file. */ +#undef HAVE_FENV_H + +/* Define if have a usable __float128 type. */ +#undef HAVE_FLOAT128 + +/* Define to 1 if you have the header file. */ +#undef HAVE_FLOATINGPOINT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_FLOAT_H + +/* libm includes floor */ +#undef HAVE_FLOOR + +/* libm includes floorf */ +#undef HAVE_FLOORF + +/* libm includes floorl */ +#undef HAVE_FLOORL + +/* libm includes fmod */ +#undef HAVE_FMOD + +/* libm includes fmodf */ +#undef HAVE_FMODF + +/* libm includes fmodl */ +#undef HAVE_FMODL + +/* Define to 1 if you have the `fork' function. */ +#undef HAVE_FORK + +/* Define if you have fpsetmask. */ +#undef HAVE_FPSETMASK + +/* Define to 1 if you have the header file. */ +#undef HAVE_FPTRAP_H + +/* fp_enable is present */ +#undef HAVE_FP_ENABLE + +/* fp_trap is present */ +#undef HAVE_FP_TRAP + +/* libm includes frexp */ +#undef HAVE_FREXP + +/* libm includes frexpf */ +#undef HAVE_FREXPF + +/* libm includes frexpl */ +#undef HAVE_FREXPL + +/* Define to 1 if you have the `fstat' function. */ +#undef HAVE_FSTAT + +/* Define to 1 if you have the `ftruncate' function. */ +#undef HAVE_FTRUNCATE + +/* Define to 1 if you have the `getcwd' function. */ +#undef HAVE_GETCWD + +/* libc includes geteuid */ +#undef HAVE_GETEUID + +/* libc includes getgid */ +#undef HAVE_GETGID + +/* Define to 1 if you have the `gethostname' function. */ +#undef HAVE_GETHOSTNAME + +/* Define to 1 if you have the `getlogin' function. */ +#undef HAVE_GETLOGIN + +/* libc includes getpid */ +#undef HAVE_GETPID + +/* libc includes getppid */ +#undef HAVE_GETPPID + +/* Define to 1 if you have the `getpwuid' function. */ +#undef HAVE_GETPWUID + +/* Define to 1 if you have the `getpwuid_r' function. */ +#undef HAVE_GETPWUID_R + +/* Define to 1 if you have the `getrlimit' function. */ +#undef HAVE_GETRLIMIT + +/* Define to 1 if you have the `getrusage' function. */ +#undef HAVE_GETRUSAGE + +/* Define to 1 if you have the `gettimeofday' function. */ +#undef HAVE_GETTIMEOFDAY + +/* libc includes getuid */ +#undef HAVE_GETUID + +/* Define to 1 if you have the `gmtime_r' function. */ +#undef HAVE_GMTIME_R + +/* Define if the compiler has a thread header that is non single. */ +#undef HAVE_GTHR_DEFAULT + +/* libm includes hypot */ +#undef HAVE_HYPOT + +/* libm includes hypotf */ +#undef HAVE_HYPOTF + +/* libm includes hypotl */ +#undef HAVE_HYPOTL + +/* Define to 1 if you have the header file. */ +#undef HAVE_IEEEFP_H + +/* Define to 1 if the system has the type `intptr_t'. */ +#undef HAVE_INTPTR_T + +/* Define to 1 if you have the header file. */ +#undef HAVE_INTTYPES_H + +/* libm includes j0 */ +#undef HAVE_J0 + +/* libm includes j0f */ +#undef HAVE_J0F + +/* libm includes j0l */ +#undef HAVE_J0L + +/* libm includes j1 */ +#undef HAVE_J1 + +/* libm includes j1f */ +#undef HAVE_J1F + +/* libm includes j1l */ +#undef HAVE_J1L + +/* libm includes jn */ +#undef HAVE_JN + +/* libm includes jnf */ +#undef HAVE_JNF + +/* libm includes jnl */ +#undef HAVE_JNL + +/* Define to 1 if you have the `kill' function. */ +#undef HAVE_KILL + +/* libm includes ldexp */ +#undef HAVE_LDEXP + +/* libm includes ldexpf */ +#undef HAVE_LDEXPF + +/* libm includes ldexpl */ +#undef HAVE_LDEXPL + +/* libm includes lgamma */ +#undef HAVE_LGAMMA + +/* libm includes lgammaf */ +#undef HAVE_LGAMMAF + +/* libm includes lgammal */ +#undef HAVE_LGAMMAL + +/* Define to 1 if you have the `link' function. */ +#undef HAVE_LINK + +/* libm includes llround */ +#undef HAVE_LLROUND + +/* libm includes llroundf */ +#undef HAVE_LLROUNDF + +/* libm includes llroundl */ +#undef HAVE_LLROUNDL + +/* Define to 1 if you have the `localtime_r' function. */ +#undef HAVE_LOCALTIME_R + +/* libm includes log */ +#undef HAVE_LOG + +/* libm includes log10 */ +#undef HAVE_LOG10 + +/* libm includes log10f */ +#undef HAVE_LOG10F + +/* libm includes log10l */ +#undef HAVE_LOG10L + +/* libm includes logf */ +#undef HAVE_LOGF + +/* libm includes logl */ +#undef HAVE_LOGL + +/* libm includes lround */ +#undef HAVE_LROUND + +/* libm includes lroundf */ +#undef HAVE_LROUNDF + +/* libm includes lroundl */ +#undef HAVE_LROUNDL + +/* Define to 1 if you have the `lstat' function. */ +#undef HAVE_LSTAT + +/* Define to 1 if you have the header file. */ +#undef HAVE_MEMORY_H + +/* Define if you have __mingw_snprintf. */ +#undef HAVE_MINGW_SNPRINTF + +/* Define to 1 if you have the `mkstemp' function. */ +#undef HAVE_MKSTEMP + +/* libm includes nextafter */ +#undef HAVE_NEXTAFTER + +/* libm includes nextafterf */ +#undef HAVE_NEXTAFTERF + +/* libm includes nextafterl */ +#undef HAVE_NEXTAFTERL + +/* Define to 1 if you have the `perror' function. */ +#undef HAVE_PERROR + +/* Define to 1 if you have the `pipe' function. */ +#undef HAVE_PIPE + +/* Define to 1 if we have POSIX getpwuid_r which takes 5 arguments. */ +#undef HAVE_POSIX_GETPWUID_R + +/* libm includes pow */ +#undef HAVE_POW + +/* libm includes powf */ +#undef HAVE_POWF + +/* libm includes powl */ +#undef HAVE_POWL + +/* Define to 1 if you have the header file. */ +#undef HAVE_PWD_H + +/* libm includes round */ +#undef HAVE_ROUND + +/* libm includes roundf */ +#undef HAVE_ROUNDF + +/* libm includes roundl */ +#undef HAVE_ROUNDL + +/* libm includes scalbn */ +#undef HAVE_SCALBN + +/* libm includes scalbnf */ +#undef HAVE_SCALBNF + +/* libm includes scalbnl */ +#undef HAVE_SCALBNL + +/* Define to 1 if you have the `setmode' function. */ +#undef HAVE_SETMODE + +/* Define to 1 if you have the `signal' function. */ +#undef HAVE_SIGNAL + +/* Define to 1 if you have the header file. */ +#undef HAVE_SIGNAL_H + +/* libm includes sin */ +#undef HAVE_SIN + +/* libm includes sinf */ +#undef HAVE_SINF + +/* libm includes sinh */ +#undef HAVE_SINH + +/* libm includes sinhf */ +#undef HAVE_SINHF + +/* libm includes sinhl */ +#undef HAVE_SINHL + +/* libm includes sinl */ +#undef HAVE_SINL + +/* Define to 1 if you have the `sleep' function. */ +#undef HAVE_SLEEP + +/* Define to 1 if you have the `snprintf' function. */ +#undef HAVE_SNPRINTF + +/* libm includes sqrt */ +#undef HAVE_SQRT + +/* libm includes sqrtf */ +#undef HAVE_SQRTF + +/* libm includes sqrtl */ +#undef HAVE_SQRTL + +/* Define to 1 if you have the `stat' function. */ +#undef HAVE_STAT + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDARG_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDINT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDIO_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDLIB_H + +/* Define to 1 if you have the `strcasestr' function. */ +#undef HAVE_STRCASESTR + +/* Define to 1 if you have the `strerror' function. */ +#undef HAVE_STRERROR + +/* Define to 1 if you have the `strerror_r' function. */ +#undef HAVE_STRERROR_R + +/* Define to 1 if you have the `strftime' function. */ +#undef HAVE_STRFTIME + +/* Define to 1 if you have the header file. */ +#undef HAVE_STRINGS_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STRING_H + +/* Define to 1 if you have the `strtof' function. */ +#undef HAVE_STRTOF + +/* Define to 1 if you have the `strtold' function. */ +#undef HAVE_STRTOLD + +/* Define to 1 if `struct stat' is a member of `st_blksize'. */ +#undef HAVE_STRUCT_STAT_ST_BLKSIZE + +/* Define to 1 if `struct stat' is a member of `st_blocks'. */ +#undef HAVE_STRUCT_STAT_ST_BLOCKS + +/* Define to 1 if `struct stat' is a member of `st_rdev'. */ +#undef HAVE_STRUCT_STAT_ST_RDEV + +/* Define to 1 if you have the `symlink' function. */ +#undef HAVE_SYMLINK + +/* Define to 1 if the target supports __sync_fetch_and_add */ +#undef HAVE_SYNC_FETCH_AND_ADD + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_RESOURCE_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_STAT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_TIMES_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_TIME_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_TYPES_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_WAIT_H + +/* libm includes tan */ +#undef HAVE_TAN + +/* libm includes tanf */ +#undef HAVE_TANF + +/* libm includes tanh */ +#undef HAVE_TANH + +/* libm includes tanhf */ +#undef HAVE_TANHF + +/* libm includes tanhl */ +#undef HAVE_TANHL + +/* libm includes tanl */ +#undef HAVE_TANL + +/* libm includes tgamma */ +#undef HAVE_TGAMMA + +/* libm includes tgammaf */ +#undef HAVE_TGAMMAF + +/* libm includes tgammal */ +#undef HAVE_TGAMMAL + +/* Define to 1 if you have the `time' function. */ +#undef HAVE_TIME + +/* Define to 1 if you have the `times' function. */ +#undef HAVE_TIMES + +/* Define to 1 if you have the header file. */ +#undef HAVE_TIME_H + +/* libm includes trunc */ +#undef HAVE_TRUNC + +/* libm includes truncf */ +#undef HAVE_TRUNCF + +/* libm includes truncl */ +#undef HAVE_TRUNCL + +/* Define to 1 if you have the `ttyname' function. */ +#undef HAVE_TTYNAME + +/* Define to 1 if you have the `ttyname_r' function. */ +#undef HAVE_TTYNAME_R + +/* Define to 1 if the system has the type `uintptr_t'. */ +#undef HAVE_UINTPTR_T + +/* Define to 1 if you have the header file. */ +#undef HAVE_UNISTD_H + +/* Define if target can unlink open files. */ +#undef HAVE_UNLINK_OPEN_FILE + +/* Define to 1 if you have the `vsnprintf' function. */ +#undef HAVE_VSNPRINTF + +/* Define to 1 if you have the `wait' function. */ +#undef HAVE_WAIT + +/* Define if target has a reliable stat. */ +#undef HAVE_WORKING_STAT + +/* libm includes y0 */ +#undef HAVE_Y0 + +/* libm includes y0f */ +#undef HAVE_Y0F + +/* libm includes y0l */ +#undef HAVE_Y0L + +/* libm includes y1 */ +#undef HAVE_Y1 + +/* libm includes y1f */ +#undef HAVE_Y1F + +/* libm includes y1l */ +#undef HAVE_Y1L + +/* libm includes yn */ +#undef HAVE_YN + +/* libm includes ynf */ +#undef HAVE_YNF + +/* libm includes ynl */ +#undef HAVE_YNL + +/* Define to the sub-directory in which libtool stores uninstalled libraries. + */ +#undef LT_OBJDIR + +/* Define to the address where bug reports for this package should be sent. */ +#undef PACKAGE_BUGREPORT + +/* Define to the full name of this package. */ +#undef PACKAGE_NAME + +/* Define to the full name and version of this package. */ +#undef PACKAGE_STRING + +/* Define to the one symbol short name of this package. */ +#undef PACKAGE_TARNAME + +/* Define to the home page for this package. */ +#undef PACKAGE_URL + +/* Define to the version of this package. */ +#undef PACKAGE_VERSION + +/* The size of `char', as computed by sizeof. */ +#undef SIZEOF_CHAR + +/* The size of `int', as computed by sizeof. */ +#undef SIZEOF_INT + +/* The size of `long', as computed by sizeof. */ +#undef SIZEOF_LONG + +/* The size of `short', as computed by sizeof. */ +#undef SIZEOF_SHORT + +/* The size of `void *', as computed by sizeof. */ +#undef SIZEOF_VOID_P + +/* Define to 1 if you have the ANSI C header files. */ +#undef STDC_HEADERS + +/* Define to 1 if the target supports #pragma weak */ +#undef SUPPORTS_WEAK + +/* Define to 1 if you can safely include both and . */ +#undef TIME_WITH_SYS_TIME + +/* Enable extensions on AIX 3, Interix. */ +#ifndef _ALL_SOURCE +# undef _ALL_SOURCE +#endif +/* Enable GNU extensions on systems that have them. */ +#ifndef _GNU_SOURCE +# undef _GNU_SOURCE +#endif +/* Enable threading extensions on Solaris. */ +#ifndef _POSIX_PTHREAD_SEMANTICS +# undef _POSIX_PTHREAD_SEMANTICS +#endif +/* Enable extensions on HP NonStop. */ +#ifndef _TANDEM_SOURCE +# undef _TANDEM_SOURCE +#endif +/* Enable general extensions on Solaris. */ +#ifndef __EXTENSIONS__ +# undef __EXTENSIONS__ +#endif + + +/* Number of bits in a file offset, on hosts where this is settable. */ +#undef _FILE_OFFSET_BITS + +/* Define for large files, on AIX-style hosts. */ +#undef _LARGE_FILES + +/* Define to 1 if on MINIX. */ +#undef _MINIX + +/* Define to 2 if the system does not provide POSIX.1 features except with + this defined. */ +#undef _POSIX_1_SOURCE + +/* Define to 1 if you need to in order for `stat' and other things to work. */ +#undef _POSIX_SOURCE + +/* Define to `long int' if does not define. */ +#undef off_t diff --git a/libgfortran/config/fpu-387.h b/libgfortran/config/fpu-387.h new file mode 100644 index 000000000..2bd9efb55 --- /dev/null +++ b/libgfortran/config/fpu-387.h @@ -0,0 +1,136 @@ +/* FPU-related code for x86 and x86_64 processors. + Copyright 2005, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#ifndef __x86_64__ +#include "cpuid.h" +#endif + +#if defined(__sun__) && defined(__svr4__) +#include +#include + +static volatile sig_atomic_t sigill_caught; + +static void +sigill_hdlr (int sig __attribute((unused)), + siginfo_t *sip __attribute__((unused)), + ucontext_t *ucp) +{ + sigill_caught = 1; + /* Set PC to the instruction after the faulting one to skip over it, + otherwise we enter an infinite loop. 4 is the size of the stmxcsr + instruction. */ + ucp->uc_mcontext.gregs[EIP] += 4; + setcontext (ucp); +} +#endif + +static int +has_sse (void) +{ +#ifndef __x86_64__ + unsigned int eax, ebx, ecx, edx; + + if (!__get_cpuid (1, &eax, &ebx, &ecx, &edx)) + return 0; + +#if defined(__sun__) && defined(__svr4__) + /* Solaris 2 before Solaris 9 4/04 cannot execute SSE instructions even + if the CPU supports them. Programs receive SIGILL instead, so check + for that at runtime. */ + + if (edx & bit_SSE) + { + struct sigaction act, oact; + + act.sa_handler = sigill_hdlr; + sigemptyset (&act.sa_mask); + /* Need to set SA_SIGINFO so a ucontext_t * is passed to the handler. */ + act.sa_flags = SA_SIGINFO; + sigaction (SIGILL, &act, &oact); + + /* We need a single SSE instruction here so the handler can safely skip + over it. */ + __asm__ volatile ("movss %xmm2,%xmm1"); + + sigaction (SIGILL, &oact, NULL); + + if (sigill_caught) + return 0; + } +#endif /* __sun__ && __svr4__ */ + + return edx & bit_SSE; +#else + return 1; +#endif +} + +/* i387 -- see linux header file for details. */ +#define _FPU_MASK_IM 0x01 +#define _FPU_MASK_DM 0x02 +#define _FPU_MASK_ZM 0x04 +#define _FPU_MASK_OM 0x08 +#define _FPU_MASK_UM 0x10 +#define _FPU_MASK_PM 0x20 + +void set_fpu (void) +{ + unsigned short cw; + + asm volatile ("fnstcw %0" : "=m" (cw)); + + cw |= (_FPU_MASK_IM | _FPU_MASK_DM | _FPU_MASK_ZM | _FPU_MASK_OM + | _FPU_MASK_UM | _FPU_MASK_PM); + + if (options.fpe & GFC_FPE_INVALID) cw &= ~_FPU_MASK_IM; + if (options.fpe & GFC_FPE_DENORMAL) cw &= ~_FPU_MASK_DM; + if (options.fpe & GFC_FPE_ZERO) cw &= ~_FPU_MASK_ZM; + if (options.fpe & GFC_FPE_OVERFLOW) cw &= ~_FPU_MASK_OM; + if (options.fpe & GFC_FPE_UNDERFLOW) cw &= ~_FPU_MASK_UM; + if (options.fpe & GFC_FPE_PRECISION) cw &= ~_FPU_MASK_PM; + + asm volatile ("fldcw %0" : : "m" (cw)); + + if (has_sse()) + { + unsigned int cw_sse; + + asm volatile ("stmxcsr %0" : "=m" (cw_sse)); + + cw_sse &= 0xffff0000; + cw_sse |= (_FPU_MASK_IM | _FPU_MASK_DM | _FPU_MASK_ZM | _FPU_MASK_OM + | _FPU_MASK_UM | _FPU_MASK_PM ) << 7; + + if (options.fpe & GFC_FPE_INVALID) cw_sse &= ~(_FPU_MASK_IM << 7); + if (options.fpe & GFC_FPE_DENORMAL) cw_sse &= ~(_FPU_MASK_DM << 7); + if (options.fpe & GFC_FPE_ZERO) cw_sse &= ~(_FPU_MASK_ZM << 7); + if (options.fpe & GFC_FPE_OVERFLOW) cw_sse &= ~(_FPU_MASK_OM << 7); + if (options.fpe & GFC_FPE_UNDERFLOW) cw_sse &= ~(_FPU_MASK_UM << 7); + if (options.fpe & GFC_FPE_PRECISION) cw_sse &= ~(_FPU_MASK_PM << 7); + + asm volatile ("ldmxcsr %0" : : "m" (cw_sse)); + } +} diff --git a/libgfortran/config/fpu-aix.h b/libgfortran/config/fpu-aix.h new file mode 100644 index 000000000..7d6f8dfcd --- /dev/null +++ b/libgfortran/config/fpu-aix.h @@ -0,0 +1,83 @@ +/* AIX FPU-related code. + Copyright 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* FPU-related code for AIX. */ +#ifdef HAVE_FPTRAP_H +#include +#endif + +void +set_fpu (void) +{ + fptrap_t mode = 0; + + if (options.fpe & GFC_FPE_INVALID) +#ifdef TRP_INVALID + mode |= TRP_INVALID; +#else + st_printf ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_DENORMAL) + st_printf ("Fortran runtime warning: IEEE 'denormal number' " + "exception not supported.\n"); + + if (options.fpe & GFC_FPE_ZERO) +#ifdef TRP_DIV_BY_ZERO + mode |= TRP_DIV_BY_ZERO; +#else + st_printf ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_OVERFLOW) +#ifdef TRP_OVERFLOW + mode |= TRP_OVERFLOW; +#else + st_printf ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_UNDERFLOW) +#ifdef TRP_UNDERFLOW + mode |= TRP_UNDERFLOW; +#else + st_printf ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_PRECISION) +#ifdef TRP_UNDERFLOW + mode |= TRP_UNDERFLOW; +#else + st_printf ("Fortran runtime warning: IEEE 'loss of precision' " + "exception not supported.\n"); +#endif + + fp_trap(FP_TRAP_SYNC); + fp_enable(mode); +} diff --git a/libgfortran/config/fpu-generic.h b/libgfortran/config/fpu-generic.h new file mode 100644 index 000000000..234e6e2cd --- /dev/null +++ b/libgfortran/config/fpu-generic.h @@ -0,0 +1,52 @@ +/* Fallback FPU-related code (for systems not otherwise supported). + Copyright 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* Fallback FPU-related code for systems not otherwise supported. This + is mainly telling the user that we will not be able to do what he + requested. */ + +void +set_fpu (void) +{ + if (options.fpe & GFC_FPE_INVALID) + st_printf ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_DENORMAL) + st_printf ("Fortran runtime warning: IEEE 'denormal number' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_ZERO) + st_printf ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_OVERFLOW) + st_printf ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_UNDERFLOW) + st_printf ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_PRECISION) + st_printf ("Fortran runtime warning: IEEE 'loss of precision' " + "exception not supported.\n"); +} diff --git a/libgfortran/config/fpu-glibc.h b/libgfortran/config/fpu-glibc.h new file mode 100644 index 000000000..807f0942e --- /dev/null +++ b/libgfortran/config/fpu-glibc.h @@ -0,0 +1,87 @@ +/* FPU-related code for systems with GNU libc. + Copyright 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +/* FPU-related code for systems with the GNU libc, providing the + feenableexcept function in fenv.h to set individual exceptions + (there's nothing to do that in C99). */ + +#ifdef HAVE_FENV_H +#include +#endif + +void set_fpu (void) +{ + if (FE_ALL_EXCEPT != 0) + fedisableexcept (FE_ALL_EXCEPT); + + if (options.fpe & GFC_FPE_INVALID) +#ifdef FE_INVALID + feenableexcept (FE_INVALID); +#else + st_printf ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); +#endif + +/* glibc does never have a FE_DENORMAL. */ + if (options.fpe & GFC_FPE_DENORMAL) +#ifdef FE_DENORMAL + feenableexcept (FE_DENORMAL); +#else + st_printf ("Fortran runtime warning: IEEE 'denormal number' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_ZERO) +#ifdef FE_DIVBYZERO + feenableexcept (FE_DIVBYZERO); +#else + st_printf ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_OVERFLOW) +#ifdef FE_OVERFLOW + feenableexcept (FE_OVERFLOW); +#else + st_printf ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_UNDERFLOW) +#ifdef FE_UNDERFLOW + feenableexcept (FE_UNDERFLOW); +#else + st_printf ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_PRECISION) +#ifdef FE_INEXACT + feenableexcept (FE_INEXACT); +#else + st_printf ("Fortran runtime warning: IEEE 'loss of precision' " + "exception not supported.\n"); +#endif +} diff --git a/libgfortran/config/fpu-sysv.h b/libgfortran/config/fpu-sysv.h new file mode 100644 index 000000000..85ca25285 --- /dev/null +++ b/libgfortran/config/fpu-sysv.h @@ -0,0 +1,82 @@ +/* SysV FPU-related code (for systems not otherwise supported). + Copyright 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +/* FPU-related code for SysV platforms with fpsetmask(). */ + +void +set_fpu (void) +{ + int cw = 0; + + if (options.fpe & GFC_FPE_INVALID) +#ifdef FP_X_INV + cw |= FP_X_INV; +#else + st_printf ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_DENORMAL) +#ifdef FP_X_DNML + cw |= FP_X_DNML; +#else + st_printf ("Fortran runtime warning: IEEE 'denormal number' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_ZERO) +#ifdef FP_X_DZ + cw |= FP_X_DZ; +#else + st_printf ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_OVERFLOW) +#ifdef FP_X_OFL + cw |= FP_X_OFL; +#else + st_printf ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_UNDERFLOW) +#ifdef FP_X_UFL + cw |= FP_X_UFL; +#else + st_printf ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); +#endif + + if (options.fpe & GFC_FPE_PRECISION) +#ifdef FP_X_IMP + cw |= FP_X_IMP; +#else + st_printf ("Fortran runtime warning: IEEE 'loss of precision' " + "exception not supported.\n"); +#endif + + fpsetmask(cw); +} diff --git a/libgfortran/configure b/libgfortran/configure new file mode 100755 index 000000000..1e61aeb49 --- /dev/null +++ b/libgfortran/configure @@ -0,0 +1,28964 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.64 for GNU Fortran Runtime Library 0.3. +# +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software +# Foundation, Inc. +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1 + + test -n \"\${ZSH_VERSION+set}\${BASH_VERSION+set}\" || ( + ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' + ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO + ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO + PATH=/empty FPATH=/empty; export PATH FPATH + test \"X\`printf %s \$ECHO\`\" = \"X\$ECHO\" \\ + || test \"X\`print -r -- \$ECHO\`\" = \"X\$ECHO\" ) || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + # We cannot yet assume a decent shell, so we have to provide a + # neutralization value for shells without unset; and this also + # works around shells that cannot unset nonexistent variables. + BASH_ENV=/dev/null + ENV=/dev/null + (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error ERROR [LINENO LOG_FD] +# --------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with status $?, using 1 if that was 0. +as_fn_error () +{ + as_status=$?; test $as_status -eq 0 && as_status=1 + if test "$3"; then + as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 + fi + $as_echo "$as_me: error: $1" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' + fi +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + +SHELL=${CONFIG_SHELL-/bin/sh} + + +exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='GNU Fortran Runtime Library' +PACKAGE_TARNAME='libgfortran' +PACKAGE_VERSION='0.3' +PACKAGE_STRING='GNU Fortran Runtime Library 0.3' +PACKAGE_BUGREPORT='' +PACKAGE_URL='http://www.gnu.org/software/libgfortran/' + +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef STDC_HEADERS +# include +# include +#else +# ifdef HAVE_STDLIB_H +# include +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include +# endif +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_c_werror_flag= +ac_subst_vars='am__EXEEXT_FALSE +am__EXEEXT_TRUE +LTLIBOBJS +LIBOBJS +IEEE_FLAGS +FPU_HOST_HEADER +LIBGFOR_BUILD_QUAD_FALSE +LIBGFOR_BUILD_QUAD_TRUE +LIBQUADINCLUDE +LIBQUADLIB_DEP +LIBQUADLIB +LIBQUADSPEC +extra_ldflags_libgfortran +ac_ct_FC +FCFLAGS +FC +enable_static +enable_shared +lt_host_flags +OTOOL64 +OTOOL +LIPO +NMEDIT +DSYMUTIL +OBJDUMP +LN_S +NM +ac_ct_DUMPBIN +DUMPBIN +LD +FGREP +SED +LIBTOOL +RANLIB +AR +AS +SECTION_FLAGS +LIBGFOR_USE_SYMVER_SUN_FALSE +LIBGFOR_USE_SYMVER_SUN_TRUE +LIBGFOR_USE_SYMVER_GNU_FALSE +LIBGFOR_USE_SYMVER_GNU_TRUE +LIBGFOR_USE_SYMVER_FALSE +LIBGFOR_USE_SYMVER_TRUE +AM_CFLAGS +AM_FCFLAGS +toolexeclibdir +toolexecdir +EGREP +GREP +CPP +am__fastdepCC_FALSE +am__fastdepCC_TRUE +CCDEPMODE +AMDEPBACKSLASH +AMDEP_FALSE +AMDEP_TRUE +am__quote +am__include +DEPDIR +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +multi_basedir +MAINT +MAINTAINER_MODE_FALSE +MAINTAINER_MODE_TRUE +am__untar +am__tar +AMTAR +am__leading_dot +SET_MAKE +AWK +mkdir_p +MKDIR_P +INSTALL_STRIP_PROGRAM +STRIP +install_sh +MAKEINFO +AUTOHEADER +AUTOMAKE +AUTOCONF +ACLOCAL +VERSION +PACKAGE +CYGPATH_W +am__isrc +INSTALL_DATA +INSTALL_SCRIPT +INSTALL_PROGRAM +target_os +target_vendor +target_cpu +target +host_os +host_vendor +host_cpu +host +onestep +onestep_FALSE +onestep_TRUE +target_subdir +host_subdir +build_subdir +build_libsubdir +build_os +build_vendor +build_cpu +build +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_build_libsubdir +enable_version_specific_runtime_libs +enable_intermodule +enable_maintainer_mode +enable_multilib +enable_dependency_tracking +enable_symvers +enable_shared +enable_static +with_pic +enable_fast_install +with_gnu_ld +enable_libtool_lock +enable_largefile +enable_libquadmath_support +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP +FC +FCFLAGS' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information." + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used." >&2 + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures GNU Fortran Runtime Library 0.3 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/libgfortran] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF + +Program names: + --program-prefix=PREFIX prepend PREFIX to installed program names + --program-suffix=SUFFIX append SUFFIX to installed program names + --program-transform-name=PROGRAM run sed PROGRAM on installed program names + +System types: + --build=BUILD configure for building on BUILD [guessed] + --host=HOST cross-compile to build programs to run on HOST [BUILD] + --target=TARGET configure for building compilers for TARGET [HOST] +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of GNU Fortran Runtime Library 0.3:";; + esac + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-version-specific-runtime-libs + specify that runtime libraries should be installed + in a compiler-specific directory + --enable-intermodule build the library in one step + --enable-maintainer-mode enable make rules and dependencies not useful + (and sometimes confusing) to the casual installer + --enable-multilib build many library versions (default) + --disable-dependency-tracking speeds up one-time build + --enable-dependency-tracking do not reject slow dependency extractors + --disable-symvers disable symbol versioning for libgfortran + --enable-shared[=PKGS] build shared libraries [default=yes] + --enable-static[=PKGS] build static libraries [default=yes] + --enable-fast-install[=PKGS] + optimize for fast installation [default=yes] + --disable-libtool-lock avoid locking (might break parallel builds) + --disable-largefile omit support for large files + --disable-libquadmath-support + disable libquadmath support for Fortran + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-build-libsubdir=DIR Directory where to find libraries for build system + --with-pic try to use only PIC/non-PIC objects [default=use + both] + --with-gnu-ld assume the C compiler uses GNU ld [default=no] + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + CPP C preprocessor + FC Fortran compiler command + FCFLAGS Fortran compiler flags + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to the package provider. +GNU Fortran Runtime Library home page: . +General help using GNU software: . +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +GNU Fortran Runtime Library configure 0.3 +generated by GNU Autoconf 2.64 + +Copyright (C) 2009 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + return $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } >/dev/null && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + return $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + +} # ac_fn_c_check_header_mongrel + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + return $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + +} # ac_fn_c_check_header_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + return $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : + $as_echo_n "(cached) " >&6 +else + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + +} # ac_fn_c_check_func + +# ac_fn_fc_try_compile LINENO +# --------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_fc_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_fc_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + return $ac_retval + +} # ac_fn_fc_try_compile + +# ac_fn_fc_try_link LINENO +# ------------------------ +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_fc_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_fc_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + $as_test_x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + return $ac_retval + +} # ac_fn_fc_try_link + +# ac_fn_c_check_type LINENO TYPE VAR INCLUDES +# ------------------------------------------- +# Tests whether TYPE exists after having included INCLUDES, setting cache +# variable VAR accordingly. +ac_fn_c_check_type () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=no" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof ($2)) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof (($2))) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + eval "$3=yes" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + +} # ac_fn_c_check_type + +# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES +# -------------------------------------------- +# Tries to find the compile-time value of EXPR in a program that includes +# INCLUDES, setting VAR accordingly. Returns whether the value could be +# computed +ac_fn_c_compute_int () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) >= 0)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=0 ac_mid=0 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid; break +else + as_fn_arith $ac_mid + 1 && ac_lo=$as_val + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) < 0)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=-1 ac_mid=-1 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) >= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=$ac_mid; break +else + as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + ac_lo= ac_hi= +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +# Binary search between lo and hi bounds. +while test "x$ac_lo" != "x$ac_hi"; do + as_fn_arith '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo && ac_mid=$as_val + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid +else + as_fn_arith '(' $ac_mid ')' + 1 && ac_lo=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done +case $ac_lo in #(( +?*) eval "$3=\$ac_lo"; ac_retval=0 ;; +'') ac_retval=1 ;; +esac + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +static long int longval () { return $2; } +static unsigned long int ulongval () { return $2; } +#include +#include +int +main () +{ + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + return 1; + if (($2) < 0) + { + long int i = longval (); + if (i != ($2)) + return 1; + fprintf (f, "%ld", i); + } + else + { + unsigned long int i = ulongval (); + if (i != ($2)) + return 1; + fprintf (f, "%lu", i); + } + /* Do not output a trailing newline, as this causes \r\n confusion + on some platforms. */ + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + echo >>conftest.val; read $3 &5 +$as_echo_n "checking for $2.$3... " >&6; } +if { as_var=$4; eval "test \"\${$as_var+set}\" = set"; }; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$5 +int +main () +{ +static $2 ac_aggr; +if (ac_aggr.$3) +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$4=yes" +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$5 +int +main () +{ +static $2 ac_aggr; +if (sizeof ac_aggr.$3) +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$4=yes" +else + eval "$4=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$4 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + +} # ac_fn_c_check_member +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by GNU Fortran Runtime Library $as_me 0.3, which was +generated by GNU Autoconf 2.64. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + cat <<\_ASBOX +## ---------------- ## +## Cache variables. ## +## ---------------- ## +_ASBOX + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------------- ## +## File substitutions. ## +## ------------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + ac_site_file1=$CONFIG_SITE +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special + # files actually), so we avoid doing that. + if test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + +ac_config_headers="$ac_config_headers config.h" + +ac_aux_dir= +for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do + for ac_t in install-sh install.sh shtool; do + if test -f "$ac_dir/$ac_t"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/$ac_t -c" + break 2 + fi + done +done +if test -z "$ac_aux_dir"; then + as_fn_error "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 +fi + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + +# Make sure we can run config.sub. +$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || + as_fn_error "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 +$as_echo_n "checking build system type... " >&6; } +if test "${ac_cv_build+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_build_alias=$build_alias +test "x$ac_build_alias" = x && + ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` +test "x$ac_build_alias" = x && + as_fn_error "cannot guess build type; you must specify one" "$LINENO" 5 +ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || + as_fn_error "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 +$as_echo "$ac_cv_build" >&6; } +case $ac_cv_build in +*-*-*) ;; +*) as_fn_error "invalid value of canonical build" "$LINENO" 5;; +esac +build=$ac_cv_build +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_build +shift +build_cpu=$1 +build_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +build_os=$* +IFS=$ac_save_IFS +case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac + + + case ${build_alias} in + "") build_noncanonical=${build} ;; + *) build_noncanonical=${build_alias} ;; +esac + + case ${host_alias} in + "") host_noncanonical=${build_noncanonical} ;; + *) host_noncanonical=${host_alias} ;; +esac + + case ${target_alias} in + "") target_noncanonical=${host_noncanonical} ;; + *) target_noncanonical=${target_alias} ;; +esac + + +# post-stage1 host modules use a different CC_FOR_BUILD so, in order to +# have matching libraries, they should use host libraries: Makefile.tpl +# arranges to pass --with-build-libsubdir=$(HOST_SUBDIR). +# However, they still use the build modules, because the corresponding +# host modules (e.g. bison) are only built for the host when bootstrap +# finishes. So: +# - build_subdir is where we find build modules, and never changes. +# - build_libsubdir is where we find build libraries, and can be overridden. + +# Prefix 'build-' so this never conflicts with target_subdir. +build_subdir="build-${build_noncanonical}" + +# Check whether --with-build-libsubdir was given. +if test "${with_build_libsubdir+set}" = set; then : + withval=$with_build_libsubdir; build_libsubdir="$withval" +else + build_libsubdir="$build_subdir" +fi + +# --srcdir=. covers the toplevel, while "test -d" covers the subdirectories +if ( test $srcdir = . && test -d gcc ) \ + || test -d $srcdir/../host-${host_noncanonical}; then + host_subdir="host-${host_noncanonical}" +else + host_subdir=. +fi +# No prefix. +target_subdir=${target_noncanonical} + + +# ------- +# Options +# ------- + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for --enable-version-specific-runtime-libs" >&5 +$as_echo_n "checking for --enable-version-specific-runtime-libs... " >&6; } +# Check whether --enable-version-specific-runtime-libs was given. +if test "${enable_version_specific_runtime_libs+set}" = set; then : + enableval=$enable_version_specific_runtime_libs; case "$enableval" in + yes) version_specific_libs=yes ;; + no) version_specific_libs=no ;; + *) as_fn_error "Unknown argument to enable/disable version-specific libs" "$LINENO" 5;; + esac +else + version_specific_libs=no +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $version_specific_libs" >&5 +$as_echo "$version_specific_libs" >&6; } + +# Build with intermodule optimisations +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for --enable-intermodule" >&5 +$as_echo_n "checking for --enable-intermodule... " >&6; } +# Check whether --enable-intermodule was given. +if test "${enable_intermodule+set}" = set; then : + enableval=$enable_intermodule; case "$enable_intermodule" in + yes) onestep="-onestep";; + *) onestep="";; +esac +else + onestep="" +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_intermodule" >&5 +$as_echo "$enable_intermodule" >&6; } + if test x$onestep = x-onestep; then + onestep_TRUE= + onestep_FALSE='#' +else + onestep_TRUE='#' + onestep_FALSE= +fi + + + +# Gets build, host, target, *_vendor, *_cpu, *_os, etc. +# +# You will slowly go insane if you do not grok the following fact: when +# building this library, the top-level /target/ becomes the library's /host/. +# +# configure then causes --target to default to --host, exactly like any +# other package using autoconf. Therefore, 'target' and 'host' will +# always be the same. This makes sense both for native and cross compilers +# just think about it for a little while. :-) +# +# Also, if this library is being configured as part of a cross compiler, the +# top-level configure script will pass the "real" host as $with_cross_host. +# +# Do not delete or change the following two lines. For why, see +# http://gcc.gnu.org/ml/libstdc++/2003-07/msg00451.html +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 +$as_echo_n "checking host system type... " >&6; } +if test "${ac_cv_host+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "x$host_alias" = x; then + ac_cv_host=$ac_cv_build +else + ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || + as_fn_error "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 +$as_echo "$ac_cv_host" >&6; } +case $ac_cv_host in +*-*-*) ;; +*) as_fn_error "invalid value of canonical host" "$LINENO" 5;; +esac +host=$ac_cv_host +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_host +shift +host_cpu=$1 +host_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +host_os=$* +IFS=$ac_save_IFS +case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking target system type" >&5 +$as_echo_n "checking target system type... " >&6; } +if test "${ac_cv_target+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "x$target_alias" = x; then + ac_cv_target=$ac_cv_host +else + ac_cv_target=`$SHELL "$ac_aux_dir/config.sub" $target_alias` || + as_fn_error "$SHELL $ac_aux_dir/config.sub $target_alias failed" "$LINENO" 5 +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_target" >&5 +$as_echo "$ac_cv_target" >&6; } +case $ac_cv_target in +*-*-*) ;; +*) as_fn_error "invalid value of canonical target" "$LINENO" 5;; +esac +target=$ac_cv_target +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_target +shift +target_cpu=$1 +target_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +target_os=$* +IFS=$ac_save_IFS +case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac + + +# The aliases save the names the user supplied, while $host etc. +# will get canonicalized. +test -n "$target_alias" && + test "$program_prefix$program_suffix$program_transform_name" = \ + NONENONEs,x,x, && + program_prefix=${target_alias}- + +target_alias=${target_alias-$host_alias} + +# Sets up automake. Must come after AC_CANONICAL_SYSTEM. Each of the +# following is magically included in AUTOMAKE_OPTIONS in each Makefile.am. +# 1.9.6: minimum required version +# no-define: PACKAGE and VERSION will not be #define'd in config.h (a bunch +# of other PACKAGE_* variables will, however, and there's nothing +# we can do about that; they come from AC_INIT). +# foreign: we don't follow the normal rules for GNU packages (no COPYING +# file in the top srcdir, etc, etc), so stop complaining. +# no-dist: we don't want 'dist' and related rules. +# -Wall: turns on all automake warnings... +# -Wno-portability: ...except this one, since GNU make is required. +am__api_version='1.11' + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +# Reject install programs that cannot install multiple files. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 +$as_echo_n "checking for a BSD-compatible install... " >&6; } +if test -z "$INSTALL"; then +if test "${ac_cv_path_install+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in #(( + ./ | .// | /[cC]/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + rm -rf conftest.one conftest.two conftest.dir + echo one > conftest.one + echo two > conftest.two + mkdir conftest.dir + if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && + test -s conftest.one && test -s conftest.two && + test -s conftest.dir/conftest.one && + test -s conftest.dir/conftest.two + then + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + fi + done + done + ;; +esac + + done +IFS=$as_save_IFS + +rm -rf conftest.one conftest.two conftest.dir + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. Don't cache a + # value for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + INSTALL=$ac_install_sh + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 +$as_echo "$INSTALL" >&6; } + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build environment is sane" >&5 +$as_echo_n "checking whether build environment is sane... " >&6; } +# Just in case +sleep 1 +echo timestamp > conftest.file +# Reject unsafe characters in $srcdir or the absolute working directory +# name. Accept space and tab only in the latter. +am_lf=' +' +case `pwd` in + *[\\\"\#\$\&\'\`$am_lf]*) + as_fn_error "unsafe absolute working directory name" "$LINENO" 5;; +esac +case $srcdir in + *[\\\"\#\$\&\'\`$am_lf\ \ ]*) + as_fn_error "unsafe srcdir value: \`$srcdir'" "$LINENO" 5;; +esac + +# Do `set' in a subshell so we don't clobber the current shell's +# arguments. Must try -L first in case configure is actually a +# symlink; some systems play weird games with the mod time of symlinks +# (eg FreeBSD returns the mod time of the symlink's containing +# directory). +if ( + set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` + if test "$*" = "X"; then + # -L didn't work. + set X `ls -t "$srcdir/configure" conftest.file` + fi + rm -f conftest.file + if test "$*" != "X $srcdir/configure conftest.file" \ + && test "$*" != "X conftest.file $srcdir/configure"; then + + # If neither matched, then we have a broken ls. This can happen + # if, for instance, CONFIG_SHELL is bash and it inherits a + # broken ls alias from the environment. This has actually + # happened. Such a system could not be considered "sane". + as_fn_error "ls -t appears to fail. Make sure there is not a broken +alias in your environment" "$LINENO" 5 + fi + + test "$2" = conftest.file + ) +then + # Ok. + : +else + as_fn_error "newly created file is older than distributed files! +Check your system clock" "$LINENO" 5 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +test "$program_prefix" != NONE && + program_transform_name="s&^&$program_prefix&;$program_transform_name" +# Use a double $ so make ignores it. +test "$program_suffix" != NONE && + program_transform_name="s&\$&$program_suffix&;$program_transform_name" +# Double any \ or $. +# By default was `s,x,x', remove it if useless. +ac_script='s/[\\$]/&&/g;s/;s,x,x,$//' +program_transform_name=`$as_echo "$program_transform_name" | sed "$ac_script"` + +# expand $ac_aux_dir to an absolute path +am_aux_dir=`cd $ac_aux_dir && pwd` + +if test x"${MISSING+set}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; + *) + MISSING="\${SHELL} $am_aux_dir/missing" ;; + esac +fi +# Use eval to expand $SHELL +if eval "$MISSING --run true"; then + am_missing_run="$MISSING --run " +else + am_missing_run= + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: \`missing' script is too old or missing" >&5 +$as_echo "$as_me: WARNING: \`missing' script is too old or missing" >&2;} +fi + +if test x"${install_sh}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; + *) + install_sh="\${SHELL} $am_aux_dir/install-sh" + esac +fi + +# Installed binaries are usually stripped using `strip' when the user +# run `make install-strip'. However `strip' might not be the right +# tool to use in cross-compilation environments, therefore Automake +# will honor the `STRIP' environment variable to overrule this program. +if test "$cross_compiling" != no; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. +set dummy ${ac_tool_prefix}strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_STRIP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$STRIP"; then + ac_cv_prog_STRIP="$STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_STRIP="${ac_tool_prefix}strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +STRIP=$ac_cv_prog_STRIP +if test -n "$STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 +$as_echo "$STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_STRIP"; then + ac_ct_STRIP=$STRIP + # Extract the first word of "strip", so it can be a program name with args. +set dummy strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_STRIP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_STRIP"; then + ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_STRIP="strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP +if test -n "$ac_ct_STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 +$as_echo "$ac_ct_STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_STRIP" = x; then + STRIP=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + STRIP=$ac_ct_STRIP + fi +else + STRIP="$ac_cv_prog_STRIP" +fi + +fi +INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5 +$as_echo_n "checking for a thread-safe mkdir -p... " >&6; } +if test -z "$MKDIR_P"; then + if test "${ac_cv_path_mkdir+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in mkdir gmkdir; do + for ac_exec_ext in '' $ac_executable_extensions; do + { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; } || continue + case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #( + 'mkdir (GNU coreutils) '* | \ + 'mkdir (coreutils) '* | \ + 'mkdir (fileutils) '4.1*) + ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext + break 3;; + esac + done + done + done +IFS=$as_save_IFS + +fi + + if test "${ac_cv_path_mkdir+set}" = set; then + MKDIR_P="$ac_cv_path_mkdir -p" + else + # As a last resort, use the slow shell script. Don't cache a + # value for MKDIR_P within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + test -d ./--version && rmdir ./--version + MKDIR_P="$ac_install_sh -d" + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR_P" >&5 +$as_echo "$MKDIR_P" >&6; } + +mkdir_p="$MKDIR_P" +case $mkdir_p in + [\\/$]* | ?:[\\/]*) ;; + */*) mkdir_p="\$(top_builddir)/$mkdir_p" ;; +esac + +for ac_prog in gawk mawk nawk awk +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_AWK+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AWK"; then + ac_cv_prog_AWK="$AWK" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_AWK="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AWK=$ac_cv_prog_AWK +if test -n "$AWK"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5 +$as_echo "$AWK" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$AWK" && break +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then : + $as_echo_n "(cached) " >&6 +else + cat >conftest.make <<\_ACEOF +SHELL = /bin/sh +all: + @echo '@@@%%%=$(MAKE)=@@@%%%' +_ACEOF +# GNU make sometimes prints "make[1]: Entering...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac +rm -f conftest.make +fi +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + SET_MAKE= +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + SET_MAKE="MAKE=${MAKE-make}" +fi + +rm -rf .tst 2>/dev/null +mkdir .tst 2>/dev/null +if test -d .tst; then + am__leading_dot=. +else + am__leading_dot=_ +fi +rmdir .tst 2>/dev/null + +if test "`cd $srcdir && pwd`" != "`pwd`"; then + # Use -I$(srcdir) only when $(srcdir) != ., so that make's output + # is not polluted with repeated "-I." + am__isrc=' -I$(srcdir)' + # test to see if srcdir already configured + if test -f $srcdir/config.status; then + as_fn_error "source directory already configured; run \"make distclean\" there first" "$LINENO" 5 + fi +fi + +# test whether we have cygpath +if test -z "$CYGPATH_W"; then + if (cygpath --version) >/dev/null 2>/dev/null; then + CYGPATH_W='cygpath -w' + else + CYGPATH_W=echo + fi +fi + + +# Define the identity of the package. + PACKAGE='libgfortran' + VERSION='0.3' + + +# Some tools Automake needs. + +ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"} + + +AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"} + + +AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"} + + +AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"} + + +MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"} + +# We need awk for the "check" target. The system "awk" is bad on +# some platforms. +# Always define AMTAR for backward compatibility. + +AMTAR=${AMTAR-"${am_missing_run}tar"} + +am__tar='${AMTAR} chof - "$$tardir"'; am__untar='${AMTAR} xf -' + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to enable maintainer-specific portions of Makefiles" >&5 +$as_echo_n "checking whether to enable maintainer-specific portions of Makefiles... " >&6; } + # Check whether --enable-maintainer-mode was given. +if test "${enable_maintainer_mode+set}" = set; then : + enableval=$enable_maintainer_mode; USE_MAINTAINER_MODE=$enableval +else + USE_MAINTAINER_MODE=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $USE_MAINTAINER_MODE" >&5 +$as_echo "$USE_MAINTAINER_MODE" >&6; } + if test $USE_MAINTAINER_MODE = yes; then + MAINTAINER_MODE_TRUE= + MAINTAINER_MODE_FALSE='#' +else + MAINTAINER_MODE_TRUE='#' + MAINTAINER_MODE_FALSE= +fi + + MAINT=$MAINTAINER_MODE_TRUE + + +# Default to --enable-multilib +# Check whether --enable-multilib was given. +if test "${enable_multilib+set}" = set; then : + enableval=$enable_multilib; case "$enableval" in + yes) multilib=yes ;; + no) multilib=no ;; + *) as_fn_error "bad value $enableval for multilib option" "$LINENO" 5 ;; + esac +else + multilib=yes +fi + + +# We may get other options which we leave undocumented: +# --with-target-subdir, --with-multisrctop, --with-multisubdir +# See config-ml.in if you want the gory details. + +if test "$srcdir" = "."; then + if test "$with_target_subdir" != "."; then + multi_basedir="$srcdir/$with_multisrctop../.." + else + multi_basedir="$srcdir/$with_multisrctop.." + fi +else + multi_basedir="$srcdir/.." +fi + + +# Even if the default multilib is not a cross compilation, +# it may be that some of the other multilibs are. +if test $cross_compiling = no && test $multilib = yes \ + && test "x${with_multisubdir}" != x ; then + cross_compiling=maybe +fi + +ac_config_commands="$ac_config_commands default-1" + + +# Handy for debugging: +#AC_MSG_NOTICE($build / $host / $target / $host_alias / $target_alias); sleep 5 + +# Are we being configured with some form of cross compiler? +# NB: We don't actually need to know this just now, but when, say, a test +# suite is included, we'll have to know. +if test "$build" != "$host"; then + LIBGFOR_IS_NATIVE=false + +else + LIBGFOR_IS_NATIVE=true +fi + +DEPDIR="${am__leading_dot}deps" + +ac_config_commands="$ac_config_commands depfiles" + + +am_make=${MAKE-make} +cat > confinc << 'END' +am__doit: + @echo this is the am__doit target +.PHONY: am__doit +END +# If we don't find an include directive, just comment out the code. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of include used by $am_make" >&5 +$as_echo_n "checking for style of include used by $am_make... " >&6; } +am__include="#" +am__quote= +_am_result=none +# First try GNU make style include. +echo "include confinc" > confmf +# Ignore all kinds of additional output from `make'. +case `$am_make -s -f confmf 2> /dev/null` in #( +*the\ am__doit\ target*) + am__include=include + am__quote= + _am_result=GNU + ;; +esac +# Now try BSD make style include. +if test "$am__include" = "#"; then + echo '.include "confinc"' > confmf + case `$am_make -s -f confmf 2> /dev/null` in #( + *the\ am__doit\ target*) + am__include=.include + am__quote="\"" + _am_result=BSD + ;; + esac +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $_am_result" >&5 +$as_echo "$_am_result" >&6; } +rm -f confinc confmf + +# Check whether --enable-dependency-tracking was given. +if test "${enable_dependency_tracking+set}" = set; then : + enableval=$enable_dependency_tracking; +fi + +if test "x$enable_dependency_tracking" != xno; then + am_depcomp="$ac_aux_dir/depcomp" + AMDEPBACKSLASH='\' +fi + if test "x$enable_dependency_tracking" != xno; then + AMDEP_TRUE= + AMDEP_FALSE='#' +else + AMDEP_TRUE='#' + AMDEP_FALSE= +fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error "no acceptable C compiler found in \$PATH +See \`config.log' for more details." "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + rm -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +# FIXME: Cleanup? +if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + gcc_no_link=no +else + gcc_no_link=yes +fi +if test x$gcc_no_link = xyes; then + # Setting cross_compile will disable run tests; it will + # also disable AC_CHECK_FILE but that's generally + # correct if we can't link. + cross_compiling=yes + EXEEXT= +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out conftest.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +if test -z "$ac_file"; then : + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ as_fn_set_status 77 +as_fn_error "C compiler cannot create executables +See \`config.log' for more details." "$LINENO" 5; }; } +fi +ac_exeext=$ac_cv_exeext + +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +# If not cross compiling, check that we can run a simple program. +if test "$cross_compiling" != yes; then + if { ac_try='./$ac_file' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out conftest.out +ac_clean_files=$ac_clean_files_save +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." "$LINENO" 5; } +fi +rm -f conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if test "${ac_cv_objext+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error "cannot compute suffix of object files: cannot compile +See \`config.log' for more details." "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if test "${ac_cv_c_compiler_gnu+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if test "${ac_cv_prog_cc_g+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if test "${ac_cv_prog_cc_c89+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +depcc="$CC" am_compiler_list= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 +$as_echo_n "checking dependency style of $depcc... " >&6; } +if test "${am_cv_CC_dependencies_compiler_type+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named `D' -- because `-MD' means `put the output + # in D'. + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_CC_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` + fi + am__universal=false + case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac + + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + # Using `: > sub/conftst$i.h' creates only sub/conftst1.h with + # Solaris 8's {/usr,}/bin/sh. + touch sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + # We check with `-c' and `-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle `-M -o', and we need to detect this. Also, some Intel + # versions had trouble with output in subdirs + am__obj=sub/conftest.${OBJEXT-o} + am__minus_obj="-o $am__obj" + case $depmode in + gcc) + # This depmode causes a compiler race in universal mode. + test "$am__universal" = false || continue + ;; + nosideeffect) + # after this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + msvisualcpp | msvcmsys) + # This compiler won't grok `-c -o', but also, the minuso test has + # not run yet. These depmodes are late enough in the game, and + # so weak that their functioning should not be impacted. + am__obj=conftest.${OBJEXT-o} + am__minus_obj= + ;; + none) break ;; + esac + if depmode=$depmode \ + source=sub/conftest.c object=$am__obj \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep $am__obj sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # or remarks (even with -Werror). So we grep stderr for any message + # that says an option was ignored or not supported. + # When given -MP, icc 7.0 and 7.1 complain thusly: + # icc: Command line warning: ignoring option '-M'; no argument required + # The diagnosis changed in icc 8.0: + # icc: Command line remark: option '-MP' not supported + if (grep 'ignoring option' conftest.err || + grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else + am_cv_CC_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_CC_dependencies_compiler_type=none +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CC_dependencies_compiler_type" >&5 +$as_echo "$am_cv_CC_dependencies_compiler_type" >&6; } +CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type + + if + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_CC_dependencies_compiler_type" = gcc3; then + am__fastdepCC_TRUE= + am__fastdepCC_FALSE='#' +else + am__fastdepCC_TRUE='#' + am__fastdepCC_FALSE= +fi + + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if test "${ac_cv_prog_CPP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details." "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if test "${ac_cv_path_GREP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if test "${ac_cv_path_EGREP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if test "${ac_cv_header_stdc+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +eval as_val=\$$as_ac_Header + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + + + ac_fn_c_check_header_mongrel "$LINENO" "minix/config.h" "ac_cv_header_minix_config_h" "$ac_includes_default" +if test "x$ac_cv_header_minix_config_h" = x""yes; then : + MINIX=yes +else + MINIX= +fi + + + if test "$MINIX" = yes; then + +$as_echo "#define _POSIX_SOURCE 1" >>confdefs.h + + +$as_echo "#define _POSIX_1_SOURCE 2" >>confdefs.h + + +$as_echo "#define _MINIX 1" >>confdefs.h + + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether it is safe to define __EXTENSIONS__" >&5 +$as_echo_n "checking whether it is safe to define __EXTENSIONS__... " >&6; } +if test "${ac_cv_safe_to_define___extensions__+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +# define __EXTENSIONS__ 1 + $ac_includes_default +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_safe_to_define___extensions__=yes +else + ac_cv_safe_to_define___extensions__=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_safe_to_define___extensions__" >&5 +$as_echo "$ac_cv_safe_to_define___extensions__" >&6; } + test $ac_cv_safe_to_define___extensions__ = yes && + $as_echo "#define __EXTENSIONS__ 1" >>confdefs.h + + $as_echo "#define _ALL_SOURCE 1" >>confdefs.h + + $as_echo "#define _GNU_SOURCE 1" >>confdefs.h + + $as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + + $as_echo "#define _TANDEM_SOURCE 1" >>confdefs.h + + + +# Calculate toolexeclibdir +# Also toolexecdir, though it's only used in toolexeclibdir +case ${version_specific_libs} in + yes) + # Need the gcc compiler version to know where to install libraries + # and header files if --enable-version-specific-runtime-libs option + # is selected. + toolexecdir='$(libdir)/gcc/$(target_alias)' + toolexeclibdir='$(toolexecdir)/$(gcc_version)$(MULTISUBDIR)' + ;; + no) + if test -n "$with_cross_host" && + test x"$with_cross_host" != x"no"; then + # Install a library built with a cross compiler in tooldir, not libdir. + toolexecdir='$(exec_prefix)/$(target_alias)' + toolexeclibdir='$(toolexecdir)/lib' + else + toolexecdir='$(libdir)/gcc-lib/$(target_alias)' + toolexeclibdir='$(libdir)' + fi + multi_os_directory=`$CC -print-multi-os-directory` + case $multi_os_directory in + .) ;; # Avoid trailing /. + *) toolexeclibdir=$toolexeclibdir/$multi_os_directory ;; + esac + ;; +esac + + + +# Create a spec file, so that compile/link tests don't fail +test -f libgfortran.spec || touch libgfortran.spec + +# Check the compiler. +# The same as in boehm-gc and libstdc++. Have to borrow it from there. +# We must force CC to /not/ be precious variables; otherwise +# the wrong, non-multilib-adjusted value will be used in multilibs. +# As a side effect, we have to subst CFLAGS ourselves. + + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error "no acceptable C compiler found in \$PATH +See \`config.log' for more details." "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + rm -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if test "${ac_cv_c_compiler_gnu+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if test "${ac_cv_prog_cc_g+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if test "${ac_cv_prog_cc_c89+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +depcc="$CC" am_compiler_list= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 +$as_echo_n "checking dependency style of $depcc... " >&6; } +if test "${am_cv_CC_dependencies_compiler_type+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named `D' -- because `-MD' means `put the output + # in D'. + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_CC_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` + fi + am__universal=false + case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac + + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + # Using `: > sub/conftst$i.h' creates only sub/conftst1.h with + # Solaris 8's {/usr,}/bin/sh. + touch sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + # We check with `-c' and `-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle `-M -o', and we need to detect this. Also, some Intel + # versions had trouble with output in subdirs + am__obj=sub/conftest.${OBJEXT-o} + am__minus_obj="-o $am__obj" + case $depmode in + gcc) + # This depmode causes a compiler race in universal mode. + test "$am__universal" = false || continue + ;; + nosideeffect) + # after this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + msvisualcpp | msvcmsys) + # This compiler won't grok `-c -o', but also, the minuso test has + # not run yet. These depmodes are late enough in the game, and + # so weak that their functioning should not be impacted. + am__obj=conftest.${OBJEXT-o} + am__minus_obj= + ;; + none) break ;; + esac + if depmode=$depmode \ + source=sub/conftest.c object=$am__obj \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep $am__obj sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # or remarks (even with -Werror). So we grep stderr for any message + # that says an option was ignored or not supported. + # When given -MP, icc 7.0 and 7.1 complain thusly: + # icc: Command line warning: ignoring option '-M'; no argument required + # The diagnosis changed in icc 8.0: + # icc: Command line remark: option '-MP' not supported + if (grep 'ignoring option' conftest.err || + grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else + am_cv_CC_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_CC_dependencies_compiler_type=none +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CC_dependencies_compiler_type" >&5 +$as_echo "$am_cv_CC_dependencies_compiler_type" >&6; } +CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type + + if + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_CC_dependencies_compiler_type" = gcc3; then + am__fastdepCC_TRUE= + am__fastdepCC_FALSE='#' +else + am__fastdepCC_TRUE='#' + am__fastdepCC_FALSE= +fi + + + + +# Add -Wall -fno-repack-arrays -fno-underscoring if we are using GCC. +if test "x$GCC" = "xyes"; then + AM_FCFLAGS="-I . -Wall -Werror -fimplicit-none -fno-repack-arrays -fno-underscoring" + ## We like to use C99 routines when available. This makes sure that + ## __STDC_VERSION__ is set such that libc includes make them available. + AM_CFLAGS="-std=gnu99 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings" + ## Compile the following tests with the same system header contents + ## that we'll encounter when compiling our own source files. + CFLAGS="-std=gnu99 $CFLAGS" +fi + + + + +# Check for symbol versioning (copied from libssp). +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether symbol versioning is supported" >&5 +$as_echo_n "checking whether symbol versioning is supported... " >&6; } +# Check whether --enable-symvers was given. +if test "${enable_symvers+set}" = set; then : + enableval=$enable_symvers; gfortran_use_symver=$enableval +else + gfortran_use_symver=yes +fi + +if test "x$gfortran_use_symver" = xyes; then + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS -fPIC -shared -Wl,--version-script,./conftest.map" + cat > conftest.map <conftest.$ac_ext +/* end confdefs.h. */ +int foo; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gfortran_use_symver=gnu +else + gfortran_use_symver=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + if test x$gfortran_use_symver = xno; then + case "$target_os" in + solaris2*) + LDFLAGS="$save_LDFLAGS" + LDFLAGS="$LDFLAGS -fPIC -shared -Wl,-M,./conftest.map" + # Sun ld cannot handle wildcards and treats all entries as undefined. + cat > conftest.map <conftest.$ac_ext +/* end confdefs.h. */ +int foo; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gfortran_use_symver=sun +else + gfortran_use_symver=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + ;; + esac + fi + LDFLAGS="$save_LDFLAGS" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gfortran_use_symver" >&5 +$as_echo "$gfortran_use_symver" >&6; } + if test "x$gfortran_use_symver" != xno; then + LIBGFOR_USE_SYMVER_TRUE= + LIBGFOR_USE_SYMVER_FALSE='#' +else + LIBGFOR_USE_SYMVER_TRUE='#' + LIBGFOR_USE_SYMVER_FALSE= +fi + + if test "x$gfortran_use_symver" = xgnu; then + LIBGFOR_USE_SYMVER_GNU_TRUE= + LIBGFOR_USE_SYMVER_GNU_FALSE='#' +else + LIBGFOR_USE_SYMVER_GNU_TRUE='#' + LIBGFOR_USE_SYMVER_GNU_FALSE= +fi + + if test "x$gfortran_use_symver" = xsun; then + LIBGFOR_USE_SYMVER_SUN_TRUE= + LIBGFOR_USE_SYMVER_SUN_FALSE='#' +else + LIBGFOR_USE_SYMVER_SUN_TRUE='#' + LIBGFOR_USE_SYMVER_SUN_FALSE= +fi + + +# Figure out whether the compiler supports "-ffunction-sections -fdata-sections", +# similarly to how libstdc++ does it +ac_test_CFLAGS="${CFLAGS+set}" +ac_save_CFLAGS="$CFLAGS" + +# Check for -ffunction-sections -fdata-sections +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc that supports -ffunction-sections -fdata-sections" >&5 +$as_echo_n "checking for gcc that supports -ffunction-sections -fdata-sections... " >&6; } +CFLAGS='-Werror -ffunction-sections -fdata-sections' +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +int foo; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_fdsections=yes +else + ac_fdsections=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +if test "$ac_test_CFLAGS" = set; then + CFLAGS="$ac_save_CFLAGS" +else + # this is the suspicious part + CFLAGS="" +fi +if test x"$ac_fdsections" = x"yes"; then + SECTION_FLAGS='-ffunction-sections -fdata-sections' +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_fdsections" >&5 +$as_echo "$ac_fdsections" >&6; } + + +# Find other programs we need. +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}as", so it can be a program name with args. +set dummy ${ac_tool_prefix}as; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_AS+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AS"; then + ac_cv_prog_AS="$AS" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_AS="${ac_tool_prefix}as" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AS=$ac_cv_prog_AS +if test -n "$AS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AS" >&5 +$as_echo "$AS" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_AS"; then + ac_ct_AS=$AS + # Extract the first word of "as", so it can be a program name with args. +set dummy as; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_AS+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AS"; then + ac_cv_prog_ac_ct_AS="$ac_ct_AS" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_AS="as" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AS=$ac_cv_prog_ac_ct_AS +if test -n "$ac_ct_AS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AS" >&5 +$as_echo "$ac_ct_AS" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_AS" = x; then + AS="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AS=$ac_ct_AS + fi +else + AS="$ac_cv_prog_AS" +fi + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. +set dummy ${ac_tool_prefix}ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_AR+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_AR="${ac_tool_prefix}ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_AR"; then + ac_ct_AR=$AR + # Extract the first word of "ar", so it can be a program name with args. +set dummy ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_AR+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_AR="ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_AR" = x; then + AR="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +else + AR="$ac_cv_prog_AR" +fi + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_RANLIB+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB="ranlib-not-found-in-path-error" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if { as_var=ac_cv_prog_make_${ac_make}_set; eval "test \"\${$as_var+set}\" = set"; }; then : + $as_echo_n "(cached) " >&6 +else + cat >conftest.make <<\_ACEOF +SHELL = /bin/sh +all: + @echo '@@@%%%=$(MAKE)=@@@%%%' +_ACEOF +# GNU make sometimes prints "make[1]: Entering...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac +rm -f conftest.make +fi +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + SET_MAKE= +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + SET_MAKE="MAKE=${MAKE-make}" +fi + + + +# Configure libtool +#AC_MSG_NOTICE([====== Starting libtool configuration]) +enable_dlopen=yes + + + +case `pwd` in + *\ * | *\ *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5 +$as_echo "$as_me: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&2;} ;; +esac + + + +macro_version='2.2.7a' +macro_revision='1.3134' + + + + + + + + + + + + + +ltmain="$ac_aux_dir/ltmain.sh" + +# Backslashify metacharacters that are still active within +# double-quoted strings. +sed_quote_subst='s/\(["`$\\]\)/\\\1/g' + +# Same as above, but do not quote variable references. +double_quote_subst='s/\(["`\\]\)/\\\1/g' + +# Sed substitution to delay expansion of an escaped shell variable in a +# double_quote_subst'ed string. +delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g' + +# Sed substitution to delay expansion of an escaped single quote. +delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g' + +# Sed substitution to avoid accidental globbing in evaled expressions +no_glob_subst='s/\*/\\\*/g' + +ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO +ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to print strings" >&5 +$as_echo_n "checking how to print strings... " >&6; } +# Test print first, because it will be a builtin if present. +if test "X`print -r -- -n 2>/dev/null`" = X-n && \ + test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then + ECHO='print -r --' +elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then + ECHO='printf %s\n' +else + # Use this function as a fallback that always works. + func_fallback_echo () + { + eval 'cat <<_LTECHO_EOF +$1 +_LTECHO_EOF' + } + ECHO='func_fallback_echo' +fi + +# func_echo_all arg... +# Invoke $ECHO with all args, space-separated. +func_echo_all () +{ + $ECHO "" +} + +case "$ECHO" in + printf*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: printf" >&5 +$as_echo "printf" >&6; } ;; + print*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: print -r" >&5 +$as_echo "print -r" >&6; } ;; + *) { $as_echo "$as_me:${as_lineno-$LINENO}: result: cat" >&5 +$as_echo "cat" >&6; } ;; +esac + + + + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a sed that does not truncate output" >&5 +$as_echo_n "checking for a sed that does not truncate output... " >&6; } +if test "${ac_cv_path_SED+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/ + for ac_i in 1 2 3 4 5 6 7; do + ac_script="$ac_script$as_nl$ac_script" + done + echo "$ac_script" 2>/dev/null | sed 99q >conftest.sed + { ac_script=; unset ac_script;} + if test -z "$SED"; then + ac_path_SED_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in sed gsed; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_SED="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_SED" && $as_test_x "$ac_path_SED"; } || continue +# Check for GNU ac_path_SED and select it if it is found. + # Check for GNU $ac_path_SED +case `"$ac_path_SED" --version 2>&1` in +*GNU*) + ac_cv_path_SED="$ac_path_SED" ac_path_SED_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo '' >> "conftest.nl" + "$ac_path_SED" -f conftest.sed < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_SED_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_SED="$ac_path_SED" + ac_path_SED_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_SED_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_SED"; then + as_fn_error "no acceptable sed could be found in \$PATH" "$LINENO" 5 + fi +else + ac_cv_path_SED=$SED +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_SED" >&5 +$as_echo "$ac_cv_path_SED" >&6; } + SED="$ac_cv_path_SED" + rm -f conftest.sed + +test -z "$SED" && SED=sed +Xsed="$SED -e 1s/^X//" + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fgrep" >&5 +$as_echo_n "checking for fgrep... " >&6; } +if test "${ac_cv_path_FGREP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if echo 'ab*c' | $GREP -F 'ab*c' >/dev/null 2>&1 + then ac_cv_path_FGREP="$GREP -F" + else + if test -z "$FGREP"; then + ac_path_FGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in fgrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_FGREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_FGREP" && $as_test_x "$ac_path_FGREP"; } || continue +# Check for GNU ac_path_FGREP and select it if it is found. + # Check for GNU $ac_path_FGREP +case `"$ac_path_FGREP" --version 2>&1` in +*GNU*) + ac_cv_path_FGREP="$ac_path_FGREP" ac_path_FGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'FGREP' >> "conftest.nl" + "$ac_path_FGREP" FGREP < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_FGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_FGREP="$ac_path_FGREP" + ac_path_FGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_FGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_FGREP"; then + as_fn_error "no acceptable fgrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_FGREP=$FGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_FGREP" >&5 +$as_echo "$ac_cv_path_FGREP" >&6; } + FGREP="$ac_cv_path_FGREP" + + +test -z "$GREP" && GREP=grep + + + + + + + + + + + + + + + + + + + +# Check whether --with-gnu-ld was given. +if test "${with_gnu_ld+set}" = set; then : + withval=$with_gnu_ld; test "$withval" = no || with_gnu_ld=yes +else + with_gnu_ld=no +fi + +ac_prog=ld +if test "$GCC" = yes; then + # Check if gcc -print-prog-name=ld gives a path. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5 +$as_echo_n "checking for ld used by $CC... " >&6; } + case $host in + *-*-mingw*) + # gcc leaves a trailing carriage return which upsets mingw + ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; + *) + ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; + esac + case $ac_prog in + # Accept absolute paths. + [\\/]* | ?:[\\/]*) + re_direlt='/[^/][^/]*/\.\./' + # Canonicalize the pathname of ld + ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'` + while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do + ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"` + done + test -z "$LD" && LD="$ac_prog" + ;; + "") + # If it fails, then pretend we aren't using GCC. + ac_prog=ld + ;; + *) + # If it is relative, then search for the first ld in PATH. + with_gnu_ld=unknown + ;; + esac +elif test "$with_gnu_ld" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5 +$as_echo_n "checking for GNU ld... " >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5 +$as_echo_n "checking for non-GNU ld... " >&6; } +fi +if test "${lt_cv_path_LD+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$LD"; then + lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR + for ac_dir in $PATH; do + IFS="$lt_save_ifs" + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then + lt_cv_path_LD="$ac_dir/$ac_prog" + # Check to see if the program is GNU ld. I'd rather use --version, + # but apparently some variants of GNU ld only accept -v. + # Break only if it was the GNU/non-GNU ld that we prefer. + case `"$lt_cv_path_LD" -v 2>&1 &5 +$as_echo "$LD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +test -z "$LD" && as_fn_error "no acceptable ld found in \$PATH" "$LINENO" 5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5 +$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; } +if test "${lt_cv_prog_gnu_ld+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + # I'd rather use --version here, but apparently some GNU lds only accept -v. +case `$LD -v 2>&1 &5 +$as_echo "$lt_cv_prog_gnu_ld" >&6; } +with_gnu_ld=$lt_cv_prog_gnu_ld + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for BSD- or MS-compatible name lister (nm)" >&5 +$as_echo_n "checking for BSD- or MS-compatible name lister (nm)... " >&6; } +if test "${lt_cv_path_NM+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$NM"; then + # Let the user override the test. + lt_cv_path_NM="$NM" +else + lt_nm_to_check="${ac_tool_prefix}nm" + if test -n "$ac_tool_prefix" && test "$build" = "$host"; then + lt_nm_to_check="$lt_nm_to_check nm" + fi + for lt_tmp_nm in $lt_nm_to_check; do + lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR + for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do + IFS="$lt_save_ifs" + test -z "$ac_dir" && ac_dir=. + tmp_nm="$ac_dir/$lt_tmp_nm" + if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext" ; then + # Check to see if the nm accepts a BSD-compat flag. + # Adding the `sed 1q' prevents false positives on HP-UX, which says: + # nm: unknown option "B" ignored + # Tru64's nm complains that /dev/null is an invalid object file + case `"$tmp_nm" -B /dev/null 2>&1 | sed '1q'` in + */dev/null* | *'Invalid file or object type'*) + lt_cv_path_NM="$tmp_nm -B" + break + ;; + *) + case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in + */dev/null*) + lt_cv_path_NM="$tmp_nm -p" + break + ;; + *) + lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but + continue # so that we can try to find one that supports BSD flags + ;; + esac + ;; + esac + fi + done + IFS="$lt_save_ifs" + done + : ${lt_cv_path_NM=no} +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_NM" >&5 +$as_echo "$lt_cv_path_NM" >&6; } +if test "$lt_cv_path_NM" != "no"; then + NM="$lt_cv_path_NM" +else + # Didn't find any BSD compatible name lister, look for dumpbin. + if test -n "$DUMPBIN"; then : + # Let the user override the test. + else + if test -n "$ac_tool_prefix"; then + for ac_prog in dumpbin "link -dump" + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_DUMPBIN+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DUMPBIN"; then + ac_cv_prog_DUMPBIN="$DUMPBIN" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_DUMPBIN="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DUMPBIN=$ac_cv_prog_DUMPBIN +if test -n "$DUMPBIN"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DUMPBIN" >&5 +$as_echo "$DUMPBIN" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$DUMPBIN" && break + done +fi +if test -z "$DUMPBIN"; then + ac_ct_DUMPBIN=$DUMPBIN + for ac_prog in dumpbin "link -dump" +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_DUMPBIN+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DUMPBIN"; then + ac_cv_prog_ac_ct_DUMPBIN="$ac_ct_DUMPBIN" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_DUMPBIN="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DUMPBIN=$ac_cv_prog_ac_ct_DUMPBIN +if test -n "$ac_ct_DUMPBIN"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DUMPBIN" >&5 +$as_echo "$ac_ct_DUMPBIN" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_DUMPBIN" && break +done + + if test "x$ac_ct_DUMPBIN" = x; then + DUMPBIN=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DUMPBIN=$ac_ct_DUMPBIN + fi +fi + + case `$DUMPBIN -symbols /dev/null 2>&1 | sed '1q'` in + *COFF*) + DUMPBIN="$DUMPBIN -symbols" + ;; + *) + DUMPBIN=: + ;; + esac + fi + + if test "$DUMPBIN" != ":"; then + NM="$DUMPBIN" + fi +fi +test -z "$NM" && NM=nm + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the name lister ($NM) interface" >&5 +$as_echo_n "checking the name lister ($NM) interface... " >&6; } +if test "${lt_cv_nm_interface+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_nm_interface="BSD nm" + echo "int some_variable = 0;" > conftest.$ac_ext + (eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&5) + (eval "$ac_compile" 2>conftest.err) + cat conftest.err >&5 + (eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&5) + (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) + cat conftest.err >&5 + (eval echo "\"\$as_me:$LINENO: output\"" >&5) + cat conftest.out >&5 + if $GREP 'External.*some_variable' conftest.out > /dev/null; then + lt_cv_nm_interface="MS dumpbin" + fi + rm -f conftest* +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_nm_interface" >&5 +$as_echo "$lt_cv_nm_interface" >&6; } + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5 +$as_echo_n "checking whether ln -s works... " >&6; } +LN_S=$as_ln_s +if test "$LN_S" = "ln -s"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5 +$as_echo "no, using $LN_S" >&6; } +fi + +# find the maximum length of command line arguments +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the maximum length of command line arguments" >&5 +$as_echo_n "checking the maximum length of command line arguments... " >&6; } +if test "${lt_cv_sys_max_cmd_len+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + i=0 + teststring="ABCD" + + case $build_os in + msdosdjgpp*) + # On DJGPP, this test can blow up pretty badly due to problems in libc + # (any single argument exceeding 2000 bytes causes a buffer overrun + # during glob expansion). Even if it were fixed, the result of this + # check would be larger than it should be. + lt_cv_sys_max_cmd_len=12288; # 12K is about right + ;; + + gnu*) + # Under GNU Hurd, this test is not required because there is + # no limit to the length of command line arguments. + # Libtool will interpret -1 as no limit whatsoever + lt_cv_sys_max_cmd_len=-1; + ;; + + cygwin* | mingw* | cegcc*) + # On Win9x/ME, this test blows up -- it succeeds, but takes + # about 5 minutes as the teststring grows exponentially. + # Worse, since 9x/ME are not pre-emptively multitasking, + # you end up with a "frozen" computer, even though with patience + # the test eventually succeeds (with a max line length of 256k). + # Instead, let's just punt: use the minimum linelength reported by + # all of the supported platforms: 8192 (on NT/2K/XP). + lt_cv_sys_max_cmd_len=8192; + ;; + + mint*) + # On MiNT this can take a long time and run out of memory. + lt_cv_sys_max_cmd_len=8192; + ;; + + amigaos*) + # On AmigaOS with pdksh, this test takes hours, literally. + # So we just punt and use a minimum line length of 8192. + lt_cv_sys_max_cmd_len=8192; + ;; + + netbsd* | freebsd* | openbsd* | darwin* | dragonfly*) + # This has been around since 386BSD, at least. Likely further. + if test -x /sbin/sysctl; then + lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax` + elif test -x /usr/sbin/sysctl; then + lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax` + else + lt_cv_sys_max_cmd_len=65536 # usable default for all BSDs + fi + # And add a safety zone + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` + ;; + + interix*) + # We know the value 262144 and hardcode it with a safety zone (like BSD) + lt_cv_sys_max_cmd_len=196608 + ;; + + osf*) + # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure + # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not + # nice to cause kernel panics so lets avoid the loop below. + # First set a reasonable default. + lt_cv_sys_max_cmd_len=16384 + # + if test -x /sbin/sysconfig; then + case `/sbin/sysconfig -q proc exec_disable_arg_limit` in + *1*) lt_cv_sys_max_cmd_len=-1 ;; + esac + fi + ;; + sco3.2v5*) + lt_cv_sys_max_cmd_len=102400 + ;; + sysv5* | sco5v6* | sysv4.2uw2*) + kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null` + if test -n "$kargmax"; then + lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[ ]//'` + else + lt_cv_sys_max_cmd_len=32768 + fi + ;; + *) + lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null` + if test -n "$lt_cv_sys_max_cmd_len"; then + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` + else + # Make teststring a little bigger before we do anything with it. + # a 1K string should be a reasonable start. + for i in 1 2 3 4 5 6 7 8 ; do + teststring=$teststring$teststring + done + SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}} + # If test is not a shell built-in, we'll probably end up computing a + # maximum length that is only half of the actual maximum length, but + # we can't tell. + while { test "X"`func_fallback_echo "$teststring$teststring" 2>/dev/null` \ + = "X$teststring$teststring"; } >/dev/null 2>&1 && + test $i != 17 # 1/2 MB should be enough + do + i=`expr $i + 1` + teststring=$teststring$teststring + done + # Only check the string length outside the loop. + lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1` + teststring= + # Add a significant safety factor because C++ compilers can tack on + # massive amounts of additional arguments before passing them to the + # linker. It appears as though 1/2 is a usable value. + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2` + fi + ;; + esac + +fi + +if test -n $lt_cv_sys_max_cmd_len ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sys_max_cmd_len" >&5 +$as_echo "$lt_cv_sys_max_cmd_len" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 +$as_echo "none" >&6; } +fi +max_cmd_len=$lt_cv_sys_max_cmd_len + + + + + + +: ${CP="cp -f"} +: ${MV="mv -f"} +: ${RM="rm -f"} + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the shell understands some XSI constructs" >&5 +$as_echo_n "checking whether the shell understands some XSI constructs... " >&6; } +# Try some XSI features +xsi_shell=no +( _lt_dummy="a/b/c" + test "${_lt_dummy##*/},${_lt_dummy%/*},"${_lt_dummy%"$_lt_dummy"}, \ + = c,a/b,, \ + && eval 'test $(( 1 + 1 )) -eq 2 \ + && test "${#_lt_dummy}" -eq 5' ) >/dev/null 2>&1 \ + && xsi_shell=yes +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $xsi_shell" >&5 +$as_echo "$xsi_shell" >&6; } + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the shell understands \"+=\"" >&5 +$as_echo_n "checking whether the shell understands \"+=\"... " >&6; } +lt_shell_append=no +( foo=bar; set foo baz; eval "$1+=\$2" && test "$foo" = barbaz ) \ + >/dev/null 2>&1 \ + && lt_shell_append=yes +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_shell_append" >&5 +$as_echo "$lt_shell_append" >&6; } + + +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + lt_unset=unset +else + lt_unset=false +fi + + + + + +# test EBCDIC or ASCII +case `echo X|tr X '\101'` in + A) # ASCII based system + # \n is not interpreted correctly by Solaris 8 /usr/ucb/tr + lt_SP2NL='tr \040 \012' + lt_NL2SP='tr \015\012 \040\040' + ;; + *) # EBCDIC based system + lt_SP2NL='tr \100 \n' + lt_NL2SP='tr \r\n \100\100' + ;; +esac + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $LD option to reload object files" >&5 +$as_echo_n "checking for $LD option to reload object files... " >&6; } +if test "${lt_cv_ld_reload_flag+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_reload_flag='-r' +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_reload_flag" >&5 +$as_echo "$lt_cv_ld_reload_flag" >&6; } +reload_flag=$lt_cv_ld_reload_flag +case $reload_flag in +"" | " "*) ;; +*) reload_flag=" $reload_flag" ;; +esac +reload_cmds='$LD$reload_flag -o $output$reload_objs' +case $host_os in + darwin*) + if test "$GCC" = yes; then + reload_cmds='$LTCC $LTCFLAGS -nostdlib ${wl}-r -o $output$reload_objs' + else + reload_cmds='$LD$reload_flag -o $output$reload_objs' + fi + ;; +esac + + + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args. +set dummy ${ac_tool_prefix}objdump; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_OBJDUMP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OBJDUMP"; then + ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OBJDUMP=$ac_cv_prog_OBJDUMP +if test -n "$OBJDUMP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5 +$as_echo "$OBJDUMP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OBJDUMP"; then + ac_ct_OBJDUMP=$OBJDUMP + # Extract the first word of "objdump", so it can be a program name with args. +set dummy objdump; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_OBJDUMP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OBJDUMP"; then + ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_OBJDUMP="objdump" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP +if test -n "$ac_ct_OBJDUMP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5 +$as_echo "$ac_ct_OBJDUMP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OBJDUMP" = x; then + OBJDUMP="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OBJDUMP=$ac_ct_OBJDUMP + fi +else + OBJDUMP="$ac_cv_prog_OBJDUMP" +fi + +test -z "$OBJDUMP" && OBJDUMP=objdump + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to recognize dependent libraries" >&5 +$as_echo_n "checking how to recognize dependent libraries... " >&6; } +if test "${lt_cv_deplibs_check_method+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_file_magic_cmd='$MAGIC_CMD' +lt_cv_file_magic_test_file= +lt_cv_deplibs_check_method='unknown' +# Need to set the preceding variable on all platforms that support +# interlibrary dependencies. +# 'none' -- dependencies not supported. +# `unknown' -- same as none, but documents that we really don't know. +# 'pass_all' -- all dependencies passed with no checks. +# 'test_compile' -- check by making test program. +# 'file_magic [[regex]]' -- check by looking for files in library path +# which responds to the $file_magic_cmd with a given extended regex. +# If you have `file' or equivalent on your system and you're not sure +# whether `pass_all' will *always* work, you probably want this one. + +case $host_os in +aix[4-9]*) + lt_cv_deplibs_check_method=pass_all + ;; + +beos*) + lt_cv_deplibs_check_method=pass_all + ;; + +bsdi[45]*) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)' + lt_cv_file_magic_cmd='/usr/bin/file -L' + lt_cv_file_magic_test_file=/shlib/libc.so + ;; + +cygwin*) + # func_win32_libid is a shell function defined in ltmain.sh + lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' + lt_cv_file_magic_cmd='func_win32_libid' + ;; + +mingw* | pw32*) + # Base MSYS/MinGW do not provide the 'file' command needed by + # func_win32_libid shell function, so use a weaker test based on 'objdump', + # unless we find 'file', for example because we are cross-compiling. + # func_win32_libid assumes BSD nm, so disallow it if using MS dumpbin. + if ( test "$lt_cv_nm_interface" = "BSD nm" && file / ) >/dev/null 2>&1; then + lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' + lt_cv_file_magic_cmd='func_win32_libid' + else + lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?' + lt_cv_file_magic_cmd='$OBJDUMP -f' + fi + ;; + +cegcc*) + # use the weaker test based on 'objdump'. See mingw*. + lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?' + lt_cv_file_magic_cmd='$OBJDUMP -f' + ;; + +darwin* | rhapsody*) + lt_cv_deplibs_check_method=pass_all + ;; + +freebsd* | dragonfly*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then + case $host_cpu in + i*86 ) + # Not sure whether the presence of OpenBSD here was a mistake. + # Let's accept both of them until this is cleared up. + lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[3-9]86 (compact )?demand paged shared library' + lt_cv_file_magic_cmd=/usr/bin/file + lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*` + ;; + esac + else + lt_cv_deplibs_check_method=pass_all + fi + ;; + +gnu*) + lt_cv_deplibs_check_method=pass_all + ;; + +haiku*) + lt_cv_deplibs_check_method=pass_all + ;; + +hpux10.20* | hpux11*) + lt_cv_file_magic_cmd=/usr/bin/file + case $host_cpu in + ia64*) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - IA64' + lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so + ;; + hppa*64*) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]' + lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl + ;; + *) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9]\.[0-9]) shared library' + lt_cv_file_magic_test_file=/usr/lib/libc.sl + ;; + esac + ;; + +interix[3-9]*) + # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|\.a)$' + ;; + +irix5* | irix6* | nonstopux*) + case $LD in + *-32|*"-32 ") libmagic=32-bit;; + *-n32|*"-n32 ") libmagic=N32;; + *-64|*"-64 ") libmagic=64-bit;; + *) libmagic=never-match;; + esac + lt_cv_deplibs_check_method=pass_all + ;; + +# This must be Linux ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu) + lt_cv_deplibs_check_method=pass_all + ;; + +netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' + else + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|_pic\.a)$' + fi + ;; + +newos6*) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (executable|dynamic lib)' + lt_cv_file_magic_cmd=/usr/bin/file + lt_cv_file_magic_test_file=/usr/lib/libnls.so + ;; + +*nto* | *qnx*) + lt_cv_deplibs_check_method=pass_all + ;; + +openbsd*) + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|\.so|_pic\.a)$' + else + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' + fi + ;; + +osf3* | osf4* | osf5*) + lt_cv_deplibs_check_method=pass_all + ;; + +rdos*) + lt_cv_deplibs_check_method=pass_all + ;; + +solaris*) + lt_cv_deplibs_check_method=pass_all + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + lt_cv_deplibs_check_method=pass_all + ;; + +sysv4 | sysv4.3*) + case $host_vendor in + motorola) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]' + lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*` + ;; + ncr) + lt_cv_deplibs_check_method=pass_all + ;; + sequent) + lt_cv_file_magic_cmd='/bin/file' + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )' + ;; + sni) + lt_cv_file_magic_cmd='/bin/file' + lt_cv_deplibs_check_method="file_magic ELF [0-9][0-9]*-bit [LM]SB dynamic lib" + lt_cv_file_magic_test_file=/lib/libc.so + ;; + siemens) + lt_cv_deplibs_check_method=pass_all + ;; + pc) + lt_cv_deplibs_check_method=pass_all + ;; + esac + ;; + +tpf*) + lt_cv_deplibs_check_method=pass_all + ;; +esac + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_deplibs_check_method" >&5 +$as_echo "$lt_cv_deplibs_check_method" >&6; } +file_magic_cmd=$lt_cv_file_magic_cmd +deplibs_check_method=$lt_cv_deplibs_check_method +test -z "$deplibs_check_method" && deplibs_check_method=unknown + + + + + + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. +set dummy ${ac_tool_prefix}ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_AR+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_AR="${ac_tool_prefix}ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_AR"; then + ac_ct_AR=$AR + # Extract the first word of "ar", so it can be a program name with args. +set dummy ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_AR+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_AR="ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_AR" = x; then + AR="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +else + AR="$ac_cv_prog_AR" +fi + +test -z "$AR" && AR=ar +test -z "$AR_FLAGS" && AR_FLAGS=cru + + + + + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. +set dummy ${ac_tool_prefix}strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_STRIP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$STRIP"; then + ac_cv_prog_STRIP="$STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_STRIP="${ac_tool_prefix}strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +STRIP=$ac_cv_prog_STRIP +if test -n "$STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 +$as_echo "$STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_STRIP"; then + ac_ct_STRIP=$STRIP + # Extract the first word of "strip", so it can be a program name with args. +set dummy strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_STRIP+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_STRIP"; then + ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_STRIP="strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP +if test -n "$ac_ct_STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 +$as_echo "$ac_ct_STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_STRIP" = x; then + STRIP=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + STRIP=$ac_ct_STRIP + fi +else + STRIP="$ac_cv_prog_STRIP" +fi + +test -z "$STRIP" && STRIP=: + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_RANLIB+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + +test -z "$RANLIB" && RANLIB=: + + + + + + +# Determine commands to create old-style static archives. +old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs' +old_postinstall_cmds='chmod 644 $oldlib' +old_postuninstall_cmds= + +if test -n "$RANLIB"; then + case $host_os in + openbsd*) + old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$oldlib" + ;; + *) + old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$oldlib" + ;; + esac + old_archive_cmds="$old_archive_cmds~\$RANLIB \$oldlib" +fi + +case $host_os in + darwin*) + lock_old_archive_extraction=yes ;; + *) + lock_old_archive_extraction=no ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + + +# Check for command to grab the raw symbol name followed by C symbol from nm. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking command to parse $NM output from $compiler object" >&5 +$as_echo_n "checking command to parse $NM output from $compiler object... " >&6; } +if test "${lt_cv_sys_global_symbol_pipe+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + +# These are sane defaults that work on at least a few old systems. +# [They come from Ultrix. What could be older than Ultrix?!! ;)] + +# Character class describing NM global symbol codes. +symcode='[BCDEGRST]' + +# Regexp to match symbols that can be accessed directly from C. +sympat='\([_A-Za-z][_A-Za-z0-9]*\)' + +# Define system-specific variables. +case $host_os in +aix*) + symcode='[BCDT]' + ;; +cygwin* | mingw* | pw32* | cegcc*) + symcode='[ABCDGISTW]' + ;; +hpux*) + if test "$host_cpu" = ia64; then + symcode='[ABCDEGRST]' + fi + ;; +irix* | nonstopux*) + symcode='[BCDEGRST]' + ;; +osf*) + symcode='[BCDEGQRST]' + ;; +solaris*) + symcode='[BDRT]' + ;; +sco3.2v5*) + symcode='[DT]' + ;; +sysv4.2uw2*) + symcode='[DT]' + ;; +sysv5* | sco5v6* | unixware* | OpenUNIX*) + symcode='[ABDT]' + ;; +sysv4) + symcode='[DFNSTU]' + ;; +esac + +# If we're using GNU nm, then use its standard symbol codes. +case `$NM -V 2>&1` in +*GNU* | *'with BFD'*) + symcode='[ABCDGIRSTW]' ;; +esac + +# Transform an extracted symbol line into a proper C declaration. +# Some systems (esp. on ia64) link data and code symbols differently, +# so use this general approach. +lt_cv_sys_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern int \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'" + +# Transform an extracted symbol line into symbol name and symbol address +lt_cv_sys_global_symbol_to_c_name_address="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"\2\", (void *) \&\2},/p'" +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([^ ]*\) \(lib[^ ]*\)$/ {\"\2\", (void *) \&\2},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"lib\2\", (void *) \&\2},/p'" + +# Handle CRLF in mingw tool chain +opt_cr= +case $build_os in +mingw*) + opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp + ;; +esac + +# Try without a prefix underscore, then with it. +for ac_symprfx in "" "_"; do + + # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol. + symxfrm="\\1 $ac_symprfx\\2 \\2" + + # Write the raw and C identifiers. + if test "$lt_cv_nm_interface" = "MS dumpbin"; then + # Fake it for dumpbin and say T for any non-static function + # and D for any global variable. + # Also find C++ and __fastcall symbols from MSVC++, + # which start with @ or ?. + lt_cv_sys_global_symbol_pipe="$AWK '"\ +" {last_section=section; section=\$ 3};"\ +" /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\ +" \$ 0!~/External *\|/{next};"\ +" / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\ +" {if(hide[section]) next};"\ +" {f=0}; \$ 0~/\(\).*\|/{f=1}; {printf f ? \"T \" : \"D \"};"\ +" {split(\$ 0, a, /\||\r/); split(a[2], s)};"\ +" s[1]~/^[@?]/{print s[1], s[1]; next};"\ +" s[1]~prfx {split(s[1],t,\"@\"); print t[1], substr(t[1],length(prfx))}"\ +" ' prfx=^$ac_symprfx" + else + lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[ ]\($symcode$symcode*\)[ ][ ]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'" + fi + + # Check to see that the pipe works correctly. + pipe_works=no + + rm -f conftest* + cat > conftest.$ac_ext <<_LT_EOF +#ifdef __cplusplus +extern "C" { +#endif +char nm_test_var; +void nm_test_func(void); +void nm_test_func(void){} +#ifdef __cplusplus +} +#endif +int main(){nm_test_var='a';nm_test_func();return(0);} +_LT_EOF + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + # Now try to grab the symbols. + nlist=conftest.nm + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist\""; } >&5 + (eval $NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s "$nlist"; then + # Try sorting and uniquifying the output. + if sort "$nlist" | uniq > "$nlist"T; then + mv -f "$nlist"T "$nlist" + else + rm -f "$nlist"T + fi + + # Make sure that we snagged all the symbols we need. + if $GREP ' nm_test_var$' "$nlist" >/dev/null; then + if $GREP ' nm_test_func$' "$nlist" >/dev/null; then + cat <<_LT_EOF > conftest.$ac_ext +#ifdef __cplusplus +extern "C" { +#endif + +_LT_EOF + # Now generate the symbol file. + eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext' + + cat <<_LT_EOF >> conftest.$ac_ext + +/* The mapping between symbol names and symbols. */ +const struct { + const char *name; + void *address; +} +lt__PROGRAM__LTX_preloaded_symbols[] = +{ + { "@PROGRAM@", (void *) 0 }, +_LT_EOF + $SED "s/^$symcode$symcode* \(.*\) \(.*\)$/ {\"\2\", (void *) \&\2},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext + cat <<\_LT_EOF >> conftest.$ac_ext + {0, (void *) 0} +}; + +/* This works around a problem in FreeBSD linker */ +#ifdef FREEBSD_WORKAROUND +static const void *lt_preloaded_setup() { + return lt__PROGRAM__LTX_preloaded_symbols; +} +#endif + +#ifdef __cplusplus +} +#endif +_LT_EOF + # Now try linking the two files. + mv conftest.$ac_objext conftstm.$ac_objext + lt_save_LIBS="$LIBS" + lt_save_CFLAGS="$CFLAGS" + LIBS="conftstm.$ac_objext" + CFLAGS="$CFLAGS$lt_prog_compiler_no_builtin_flag" + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s conftest${ac_exeext}; then + pipe_works=yes + fi + LIBS="$lt_save_LIBS" + CFLAGS="$lt_save_CFLAGS" + else + echo "cannot find nm_test_func in $nlist" >&5 + fi + else + echo "cannot find nm_test_var in $nlist" >&5 + fi + else + echo "cannot run $lt_cv_sys_global_symbol_pipe" >&5 + fi + else + echo "$progname: failed program was:" >&5 + cat conftest.$ac_ext >&5 + fi + rm -rf conftest* conftst* + + # Do not use the global_symbol_pipe unless it works. + if test "$pipe_works" = yes; then + break + else + lt_cv_sys_global_symbol_pipe= + fi +done + +fi + +if test -z "$lt_cv_sys_global_symbol_pipe"; then + lt_cv_sys_global_symbol_to_cdecl= +fi +if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: failed" >&5 +$as_echo "failed" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 +$as_echo "ok" >&6; } +fi + + + + + + + + + + + + + + + + + + + + + + +# Check whether --enable-libtool-lock was given. +if test "${enable_libtool_lock+set}" = set; then : + enableval=$enable_libtool_lock; +fi + +test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes + +# Some flags need to be propagated to the compiler or linker for good +# libtool support. +case $host in +ia64-*-hpux*) + # Find out which ABI we are using. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.$ac_objext` in + *ELF-32*) + HPUX_IA64_MODE="32" + ;; + *ELF-64*) + HPUX_IA64_MODE="64" + ;; + esac + fi + rm -rf conftest* + ;; +*-*-irix6*) + # Find out which ABI we are using. + echo '#line '$LINENO' "configure"' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + if test "$lt_cv_prog_gnu_ld" = yes; then + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + LD="${LD-ld} -melf32bsmip" + ;; + *N32*) + LD="${LD-ld} -melf32bmipn32" + ;; + *64-bit*) + LD="${LD-ld} -melf64bmip" + ;; + esac + else + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + LD="${LD-ld} -32" + ;; + *N32*) + LD="${LD-ld} -n32" + ;; + *64-bit*) + LD="${LD-ld} -64" + ;; + esac + fi + fi + rm -rf conftest* + ;; + +x86_64-*kfreebsd*-gnu|x86_64-*linux*|ppc*-*linux*|powerpc*-*linux*| \ +s390*-*linux*|s390*-*tpf*|sparc*-*linux*) + # Find out which ABI we are using. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.o` in + *32-bit*) + case $host in + x86_64-*kfreebsd*-gnu) + LD="${LD-ld} -m elf_i386_fbsd" + ;; + x86_64-*linux*) + LD="${LD-ld} -m elf_i386" + ;; + ppc64-*linux*|powerpc64-*linux*) + LD="${LD-ld} -m elf32ppclinux" + ;; + s390x-*linux*) + LD="${LD-ld} -m elf_s390" + ;; + sparc64-*linux*) + LD="${LD-ld} -m elf32_sparc" + ;; + esac + ;; + *64-bit*) + case $host in + x86_64-*kfreebsd*-gnu) + LD="${LD-ld} -m elf_x86_64_fbsd" + ;; + x86_64-*linux*) + LD="${LD-ld} -m elf_x86_64" + ;; + ppc*-*linux*|powerpc*-*linux*) + LD="${LD-ld} -m elf64ppc" + ;; + s390*-*linux*|s390*-*tpf*) + LD="${LD-ld} -m elf64_s390" + ;; + sparc*-*linux*) + LD="${LD-ld} -m elf64_sparc" + ;; + esac + ;; + esac + fi + rm -rf conftest* + ;; + +*-*-sco3.2v5*) + # On SCO OpenServer 5, we need -belf to get full-featured binaries. + SAVE_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -belf" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler needs -belf" >&5 +$as_echo_n "checking whether the C compiler needs -belf... " >&6; } +if test "${lt_cv_cc_needs_belf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + lt_cv_cc_needs_belf=yes +else + lt_cv_cc_needs_belf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_cc_needs_belf" >&5 +$as_echo "$lt_cv_cc_needs_belf" >&6; } + if test x"$lt_cv_cc_needs_belf" != x"yes"; then + # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf + CFLAGS="$SAVE_CFLAGS" + fi + ;; +sparc*-*solaris*) + # Find out which ABI we are using. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.o` in + *64-bit*) + case $lt_cv_prog_gnu_ld in + yes*) LD="${LD-ld} -m elf64_sparc" ;; + *) + if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then + LD="${LD-ld} -64" + fi + ;; + esac + ;; + esac + fi + rm -rf conftest* + ;; +esac + +need_locks="$enable_libtool_lock" + + + case $host_os in + rhapsody* | darwin*) + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}dsymutil", so it can be a program name with args. +set dummy ${ac_tool_prefix}dsymutil; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_DSYMUTIL+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DSYMUTIL"; then + ac_cv_prog_DSYMUTIL="$DSYMUTIL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_DSYMUTIL="${ac_tool_prefix}dsymutil" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DSYMUTIL=$ac_cv_prog_DSYMUTIL +if test -n "$DSYMUTIL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DSYMUTIL" >&5 +$as_echo "$DSYMUTIL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_DSYMUTIL"; then + ac_ct_DSYMUTIL=$DSYMUTIL + # Extract the first word of "dsymutil", so it can be a program name with args. +set dummy dsymutil; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_DSYMUTIL+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DSYMUTIL"; then + ac_cv_prog_ac_ct_DSYMUTIL="$ac_ct_DSYMUTIL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_DSYMUTIL="dsymutil" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DSYMUTIL=$ac_cv_prog_ac_ct_DSYMUTIL +if test -n "$ac_ct_DSYMUTIL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DSYMUTIL" >&5 +$as_echo "$ac_ct_DSYMUTIL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_DSYMUTIL" = x; then + DSYMUTIL=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DSYMUTIL=$ac_ct_DSYMUTIL + fi +else + DSYMUTIL="$ac_cv_prog_DSYMUTIL" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}nmedit", so it can be a program name with args. +set dummy ${ac_tool_prefix}nmedit; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_NMEDIT+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$NMEDIT"; then + ac_cv_prog_NMEDIT="$NMEDIT" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_NMEDIT="${ac_tool_prefix}nmedit" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +NMEDIT=$ac_cv_prog_NMEDIT +if test -n "$NMEDIT"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $NMEDIT" >&5 +$as_echo "$NMEDIT" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_NMEDIT"; then + ac_ct_NMEDIT=$NMEDIT + # Extract the first word of "nmedit", so it can be a program name with args. +set dummy nmedit; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_NMEDIT+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_NMEDIT"; then + ac_cv_prog_ac_ct_NMEDIT="$ac_ct_NMEDIT" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_NMEDIT="nmedit" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_NMEDIT=$ac_cv_prog_ac_ct_NMEDIT +if test -n "$ac_ct_NMEDIT"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_NMEDIT" >&5 +$as_echo "$ac_ct_NMEDIT" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_NMEDIT" = x; then + NMEDIT=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + NMEDIT=$ac_ct_NMEDIT + fi +else + NMEDIT="$ac_cv_prog_NMEDIT" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}lipo", so it can be a program name with args. +set dummy ${ac_tool_prefix}lipo; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_LIPO+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$LIPO"; then + ac_cv_prog_LIPO="$LIPO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_LIPO="${ac_tool_prefix}lipo" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +LIPO=$ac_cv_prog_LIPO +if test -n "$LIPO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIPO" >&5 +$as_echo "$LIPO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_LIPO"; then + ac_ct_LIPO=$LIPO + # Extract the first word of "lipo", so it can be a program name with args. +set dummy lipo; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_LIPO+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_LIPO"; then + ac_cv_prog_ac_ct_LIPO="$ac_ct_LIPO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_LIPO="lipo" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_LIPO=$ac_cv_prog_ac_ct_LIPO +if test -n "$ac_ct_LIPO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_LIPO" >&5 +$as_echo "$ac_ct_LIPO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_LIPO" = x; then + LIPO=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + LIPO=$ac_ct_LIPO + fi +else + LIPO="$ac_cv_prog_LIPO" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}otool", so it can be a program name with args. +set dummy ${ac_tool_prefix}otool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_OTOOL+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OTOOL"; then + ac_cv_prog_OTOOL="$OTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_OTOOL="${ac_tool_prefix}otool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OTOOL=$ac_cv_prog_OTOOL +if test -n "$OTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL" >&5 +$as_echo "$OTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OTOOL"; then + ac_ct_OTOOL=$OTOOL + # Extract the first word of "otool", so it can be a program name with args. +set dummy otool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_OTOOL+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OTOOL"; then + ac_cv_prog_ac_ct_OTOOL="$ac_ct_OTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_OTOOL="otool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OTOOL=$ac_cv_prog_ac_ct_OTOOL +if test -n "$ac_ct_OTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL" >&5 +$as_echo "$ac_ct_OTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OTOOL" = x; then + OTOOL=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OTOOL=$ac_ct_OTOOL + fi +else + OTOOL="$ac_cv_prog_OTOOL" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}otool64", so it can be a program name with args. +set dummy ${ac_tool_prefix}otool64; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_OTOOL64+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OTOOL64"; then + ac_cv_prog_OTOOL64="$OTOOL64" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_OTOOL64="${ac_tool_prefix}otool64" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OTOOL64=$ac_cv_prog_OTOOL64 +if test -n "$OTOOL64"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL64" >&5 +$as_echo "$OTOOL64" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OTOOL64"; then + ac_ct_OTOOL64=$OTOOL64 + # Extract the first word of "otool64", so it can be a program name with args. +set dummy otool64; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_OTOOL64+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OTOOL64"; then + ac_cv_prog_ac_ct_OTOOL64="$ac_ct_OTOOL64" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_OTOOL64="otool64" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OTOOL64=$ac_cv_prog_ac_ct_OTOOL64 +if test -n "$ac_ct_OTOOL64"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL64" >&5 +$as_echo "$ac_ct_OTOOL64" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OTOOL64" = x; then + OTOOL64=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OTOOL64=$ac_ct_OTOOL64 + fi +else + OTOOL64="$ac_cv_prog_OTOOL64" +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -single_module linker flag" >&5 +$as_echo_n "checking for -single_module linker flag... " >&6; } +if test "${lt_cv_apple_cc_single_mod+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_apple_cc_single_mod=no + if test -z "${LT_MULTI_MODULE}"; then + # By default we will add the -single_module flag. You can override + # by either setting the environment variable LT_MULTI_MODULE + # non-empty at configure time, or by adding -multi_module to the + # link flags. + rm -rf libconftest.dylib* + echo "int foo(void){return 1;}" > conftest.c + echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ +-dynamiclib -Wl,-single_module conftest.c" >&5 + $LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ + -dynamiclib -Wl,-single_module conftest.c 2>conftest.err + _lt_result=$? + if test -f libconftest.dylib && test ! -s conftest.err && test $_lt_result = 0; then + lt_cv_apple_cc_single_mod=yes + else + cat conftest.err >&5 + fi + rm -rf libconftest.dylib* + rm -f conftest.* + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_apple_cc_single_mod" >&5 +$as_echo "$lt_cv_apple_cc_single_mod" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -exported_symbols_list linker flag" >&5 +$as_echo_n "checking for -exported_symbols_list linker flag... " >&6; } +if test "${lt_cv_ld_exported_symbols_list+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_exported_symbols_list=no + save_LDFLAGS=$LDFLAGS + echo "_main" > conftest.sym + LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym" + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + lt_cv_ld_exported_symbols_list=yes +else + lt_cv_ld_exported_symbols_list=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS="$save_LDFLAGS" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_exported_symbols_list" >&5 +$as_echo "$lt_cv_ld_exported_symbols_list" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -force_load linker flag" >&5 +$as_echo_n "checking for -force_load linker flag... " >&6; } +if test "${lt_cv_ld_force_load+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_force_load=no + cat > conftest.c << _LT_EOF +int forced_loaded() { return 2;} +_LT_EOF + echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&5 + $LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&5 + echo "$AR cru libconftest.a conftest.o" >&5 + $AR cru libconftest.a conftest.o 2>&5 + cat > conftest.c << _LT_EOF +int main() { return 0;} +_LT_EOF + echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&5 + $LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err + _lt_result=$? + if test -f conftest && test ! -s conftest.err && test $_lt_result = 0 && $GREP forced_load conftest 2>&1 >/dev/null; then + lt_cv_ld_force_load=yes + else + cat conftest.err >&5 + fi + rm -f conftest.err libconftest.a conftest conftest.c + rm -rf conftest.dSYM + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_force_load" >&5 +$as_echo "$lt_cv_ld_force_load" >&6; } + case $host_os in + rhapsody* | darwin1.[012]) + _lt_dar_allow_undefined='${wl}-undefined ${wl}suppress' ;; + darwin1.*) + _lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;; + darwin*) # darwin 5.x on + # if running on 10.5 or later, the deployment target defaults + # to the OS version, if on x86, and 10.4, the deployment + # target defaults to 10.4. Don't you love it? + case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in + 10.0,*86*-darwin8*|10.0,*-darwin[91]*) + _lt_dar_allow_undefined='${wl}-undefined ${wl}dynamic_lookup' ;; + 10.[012]*) + _lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;; + 10.*) + _lt_dar_allow_undefined='${wl}-undefined ${wl}dynamic_lookup' ;; + esac + ;; + esac + if test "$lt_cv_apple_cc_single_mod" = "yes"; then + _lt_dar_single_mod='$single_module' + fi + if test "$lt_cv_ld_exported_symbols_list" = "yes"; then + _lt_dar_export_syms=' ${wl}-exported_symbols_list,$output_objdir/${libname}-symbols.expsym' + else + _lt_dar_export_syms='~$NMEDIT -s $output_objdir/${libname}-symbols.expsym ${lib}' + fi + if test "$DSYMUTIL" != ":" && test "$lt_cv_ld_force_load" = "no"; then + _lt_dsymutil='~$DSYMUTIL $lib || :' + else + _lt_dsymutil= + fi + ;; + esac + +for ac_header in dlfcn.h +do : + ac_fn_c_check_header_compile "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default +" +if test "x$ac_cv_header_dlfcn_h" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_DLFCN_H 1 +_ACEOF + +fi + +done + + + + + +# Set options + + + + + enable_win32_dll=no + + + # Check whether --enable-shared was given. +if test "${enable_shared+set}" = set; then : + enableval=$enable_shared; p=${PACKAGE-default} + case $enableval in + yes) enable_shared=yes ;; + no) enable_shared=no ;; + *) + enable_shared=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," + for pkg in $enableval; do + IFS="$lt_save_ifs" + if test "X$pkg" = "X$p"; then + enable_shared=yes + fi + done + IFS="$lt_save_ifs" + ;; + esac +else + enable_shared=yes +fi + + + + + + + + + + # Check whether --enable-static was given. +if test "${enable_static+set}" = set; then : + enableval=$enable_static; p=${PACKAGE-default} + case $enableval in + yes) enable_static=yes ;; + no) enable_static=no ;; + *) + enable_static=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," + for pkg in $enableval; do + IFS="$lt_save_ifs" + if test "X$pkg" = "X$p"; then + enable_static=yes + fi + done + IFS="$lt_save_ifs" + ;; + esac +else + enable_static=yes +fi + + + + + + + + + + +# Check whether --with-pic was given. +if test "${with_pic+set}" = set; then : + withval=$with_pic; pic_mode="$withval" +else + pic_mode=default +fi + + +test -z "$pic_mode" && pic_mode=default + + + + + + + + # Check whether --enable-fast-install was given. +if test "${enable_fast_install+set}" = set; then : + enableval=$enable_fast_install; p=${PACKAGE-default} + case $enableval in + yes) enable_fast_install=yes ;; + no) enable_fast_install=no ;; + *) + enable_fast_install=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," + for pkg in $enableval; do + IFS="$lt_save_ifs" + if test "X$pkg" = "X$p"; then + enable_fast_install=yes + fi + done + IFS="$lt_save_ifs" + ;; + esac +else + enable_fast_install=yes +fi + + + + + + + + + + + +# This can be used to rebuild libtool when needed +LIBTOOL_DEPS="$ltmain" + +# Always use our own libtool. +LIBTOOL='$(SHELL) $(top_builddir)/libtool' + + + + + + + + + + + + + + + + + + + + + + + + + + +test -z "$LN_S" && LN_S="ln -s" + + + + + + + + + + + + + + +if test -n "${ZSH_VERSION+set}" ; then + setopt NO_GLOB_SUBST +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for objdir" >&5 +$as_echo_n "checking for objdir... " >&6; } +if test "${lt_cv_objdir+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + rm -f .libs 2>/dev/null +mkdir .libs 2>/dev/null +if test -d .libs; then + lt_cv_objdir=.libs +else + # MS-DOS does not allow filenames that begin with a dot. + lt_cv_objdir=_libs +fi +rmdir .libs 2>/dev/null +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_objdir" >&5 +$as_echo "$lt_cv_objdir" >&6; } +objdir=$lt_cv_objdir + + + + + +cat >>confdefs.h <<_ACEOF +#define LT_OBJDIR "$lt_cv_objdir/" +_ACEOF + + + + +case $host_os in +aix3*) + # AIX sometimes has problems with the GCC collect2 program. For some + # reason, if we set the COLLECT_NAMES environment variable, the problems + # vanish in a puff of smoke. + if test "X${COLLECT_NAMES+set}" != Xset; then + COLLECT_NAMES= + export COLLECT_NAMES + fi + ;; +esac + +# Global variables: +ofile=libtool +can_build_shared=yes + +# All known linkers require a `.a' archive for static linking (except MSVC, +# which needs '.lib'). +libext=a + +with_gnu_ld="$lt_cv_prog_gnu_ld" + +old_CC="$CC" +old_CFLAGS="$CFLAGS" + +# Set sane defaults for various variables +test -z "$CC" && CC=cc +test -z "$LTCC" && LTCC=$CC +test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS +test -z "$LD" && LD=ld +test -z "$ac_objext" && ac_objext=o + +for cc_temp in $compiler""; do + case $cc_temp in + compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; + distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; + \-*) ;; + *) break;; + esac +done +cc_basename=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"` + + +# Only perform the check for file, if the check method requires it +test -z "$MAGIC_CMD" && MAGIC_CMD=file +case $deplibs_check_method in +file_magic*) + if test "$file_magic_cmd" = '$MAGIC_CMD'; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${ac_tool_prefix}file" >&5 +$as_echo_n "checking for ${ac_tool_prefix}file... " >&6; } +if test "${lt_cv_path_MAGIC_CMD+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $MAGIC_CMD in +[\\/*] | ?:[\\/]*) + lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path. + ;; +*) + lt_save_MAGIC_CMD="$MAGIC_CMD" + lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR + ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" + for ac_dir in $ac_dummy; do + IFS="$lt_save_ifs" + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/${ac_tool_prefix}file; then + lt_cv_path_MAGIC_CMD="$ac_dir/${ac_tool_prefix}file" + if test -n "$file_magic_test_file"; then + case $deplibs_check_method in + "file_magic "*) + file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` + MAGIC_CMD="$lt_cv_path_MAGIC_CMD" + if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | + $EGREP "$file_magic_regex" > /dev/null; then + : + else + cat <<_LT_EOF 1>&2 + +*** Warning: the command libtool uses to detect shared libraries, +*** $file_magic_cmd, produces output that libtool cannot recognize. +*** The result is that libtool may fail to recognize shared libraries +*** as such. This will affect the creation of libtool libraries that +*** depend on shared libraries, but programs linked with such libtool +*** libraries will work regardless of this problem. Nevertheless, you +*** may want to report the problem to your system manager and/or to +*** bug-libtool@gnu.org + +_LT_EOF + fi ;; + esac + fi + break + fi + done + IFS="$lt_save_ifs" + MAGIC_CMD="$lt_save_MAGIC_CMD" + ;; +esac +fi + +MAGIC_CMD="$lt_cv_path_MAGIC_CMD" +if test -n "$MAGIC_CMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5 +$as_echo "$MAGIC_CMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + + +if test -z "$lt_cv_path_MAGIC_CMD"; then + if test -n "$ac_tool_prefix"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for file" >&5 +$as_echo_n "checking for file... " >&6; } +if test "${lt_cv_path_MAGIC_CMD+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $MAGIC_CMD in +[\\/*] | ?:[\\/]*) + lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path. + ;; +*) + lt_save_MAGIC_CMD="$MAGIC_CMD" + lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR + ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" + for ac_dir in $ac_dummy; do + IFS="$lt_save_ifs" + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/file; then + lt_cv_path_MAGIC_CMD="$ac_dir/file" + if test -n "$file_magic_test_file"; then + case $deplibs_check_method in + "file_magic "*) + file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` + MAGIC_CMD="$lt_cv_path_MAGIC_CMD" + if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | + $EGREP "$file_magic_regex" > /dev/null; then + : + else + cat <<_LT_EOF 1>&2 + +*** Warning: the command libtool uses to detect shared libraries, +*** $file_magic_cmd, produces output that libtool cannot recognize. +*** The result is that libtool may fail to recognize shared libraries +*** as such. This will affect the creation of libtool libraries that +*** depend on shared libraries, but programs linked with such libtool +*** libraries will work regardless of this problem. Nevertheless, you +*** may want to report the problem to your system manager and/or to +*** bug-libtool@gnu.org + +_LT_EOF + fi ;; + esac + fi + break + fi + done + IFS="$lt_save_ifs" + MAGIC_CMD="$lt_save_MAGIC_CMD" + ;; +esac +fi + +MAGIC_CMD="$lt_cv_path_MAGIC_CMD" +if test -n "$MAGIC_CMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5 +$as_echo "$MAGIC_CMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + else + MAGIC_CMD=: + fi +fi + + fi + ;; +esac + +# Use C for the default configuration in the libtool script + +lt_save_CC="$CC" +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +# Source file extension for C test sources. +ac_ext=c + +# Object file extension for compiled C test sources. +objext=o +objext=$objext + +# Code to be used in simple compile tests +lt_simple_compile_test_code="int some_variable = 0;" + +# Code to be used in simple link tests +lt_simple_link_test_code='int main(){return(0);}' + + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + +# Save the default compiler, since it gets overwritten when the other +# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP. +compiler_DEFAULT=$CC + +# save warnings/boilerplate of simple test code +ac_outfile=conftest.$ac_objext +echo "$lt_simple_compile_test_code" >conftest.$ac_ext +eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_compiler_boilerplate=`cat conftest.err` +$RM conftest* + +ac_outfile=conftest.$ac_objext +echo "$lt_simple_link_test_code" >conftest.$ac_ext +eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_linker_boilerplate=`cat conftest.err` +$RM -r conftest* + + +## CAVEAT EMPTOR: +## There is no encapsulation within the following macros, do not change +## the running order or otherwise move them around unless you know exactly +## what you are doing... +if test -n "$compiler"; then + +lt_prog_compiler_no_builtin_flag= + +if test "$GCC" = yes; then + case $cc_basename in + nvcc*) + lt_prog_compiler_no_builtin_flag=' -Xcompiler -fno-builtin' ;; + *) + lt_prog_compiler_no_builtin_flag=' -fno-builtin' ;; + esac + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -fno-rtti -fno-exceptions" >&5 +$as_echo_n "checking if $compiler supports -fno-rtti -fno-exceptions... " >&6; } +if test "${lt_cv_prog_compiler_rtti_exceptions+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_rtti_exceptions=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="-fno-rtti -fno-exceptions" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_rtti_exceptions=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_rtti_exceptions" >&5 +$as_echo "$lt_cv_prog_compiler_rtti_exceptions" >&6; } + +if test x"$lt_cv_prog_compiler_rtti_exceptions" = xyes; then + lt_prog_compiler_no_builtin_flag="$lt_prog_compiler_no_builtin_flag -fno-rtti -fno-exceptions" +else + : +fi + +fi + + + + + + + lt_prog_compiler_wl= +lt_prog_compiler_pic= +lt_prog_compiler_static= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 +$as_echo_n "checking for $compiler option to produce PIC... " >&6; } + + if test "$GCC" = yes; then + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_static='-static' + + case $host_os in + aix*) + # All AIX code is PIC. + if test "$host_cpu" = ia64; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static='-Bstatic' + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + lt_prog_compiler_pic='-fPIC' + ;; + m68k) + # FIXME: we need at least 68020 code to build shared libraries, but + # adding the `-m68020' flag to GCC prevents building anything better, + # like `-m68040'. + lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4' + ;; + esac + ;; + + beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) + # PIC is the default for these OSes. + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + # Although the cygwin gcc ignores -fPIC, still need this for old-style + # (--disable-auto-import) libraries + lt_prog_compiler_pic='-DDLL_EXPORT' + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic='-fno-common' + ;; + + haiku*) + # PIC is the default for Haiku. + # The "-static" flag exists, but is broken. + lt_prog_compiler_static= + ;; + + hpux*) + # PIC is the default for 64-bit PA HP-UX, but not for 32-bit + # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag + # sets the default TLS model and affects inlining. + case $host_cpu in + hppa*64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic='-fPIC' + ;; + esac + ;; + + interix[3-9]*) + # Interix 3.x gcc -fpic/-fPIC options generate broken code. + # Instead, we relocate shared libraries at runtime. + ;; + + msdosdjgpp*) + # Just because we use GCC doesn't mean we suddenly get shared libraries + # on systems that don't support them. + lt_prog_compiler_can_build_shared=no + enable_shared=no + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic='-fPIC -shared' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic=-Kconform_pic + fi + ;; + + *) + lt_prog_compiler_pic='-fPIC' + ;; + esac + + case $cc_basename in + nvcc*) # Cuda Compiler Driver 2.2 + lt_prog_compiler_wl='-Xlinker ' + lt_prog_compiler_pic='-Xcompiler -fPIC' + ;; + esac + else + # PORTME Check for flag to pass linker flags through the system compiler. + case $host_os in + aix*) + lt_prog_compiler_wl='-Wl,' + if test "$host_cpu" = ia64; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static='-Bstatic' + else + lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp' + fi + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + lt_prog_compiler_pic='-DDLL_EXPORT' + ;; + + hpux9* | hpux10* | hpux11*) + lt_prog_compiler_wl='-Wl,' + # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but + # not for PA HP-UX. + case $host_cpu in + hppa*64*|ia64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic='+Z' + ;; + esac + # Is there a better lt_prog_compiler_static that works with the bundled CC? + lt_prog_compiler_static='${wl}-a ${wl}archive' + ;; + + irix5* | irix6* | nonstopux*) + lt_prog_compiler_wl='-Wl,' + # PIC (with -KPIC) is the default. + lt_prog_compiler_static='-non_shared' + ;; + + linux* | k*bsd*-gnu | kopensolaris*-gnu) + case $cc_basename in + # old Intel for x86_64 which still supported -KPIC. + ecc*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-static' + ;; + # icc used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + icc* | ifort*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fPIC' + lt_prog_compiler_static='-static' + ;; + # Lahey Fortran 8.1. + lf95*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='--shared' + lt_prog_compiler_static='--static' + ;; + pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group compilers (*not* the Pentium gcc compiler, + # which looks to be a dead project) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fpic' + lt_prog_compiler_static='-Bstatic' + ;; + ccc*) + lt_prog_compiler_wl='-Wl,' + # All Alpha code is PIC. + lt_prog_compiler_static='-non_shared' + ;; + xl* | bgxl* | bgf* | mpixl*) + # IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-qpic' + lt_prog_compiler_static='-qstaticlink' + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ F* | *Sun*Fortran*) + # Sun Fortran 8.3 passes all unrecognized flags to the linker + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + lt_prog_compiler_wl='' + ;; + *Sun\ C*) + # Sun C 5.9 + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + lt_prog_compiler_wl='-Wl,' + ;; + esac + ;; + esac + ;; + + newsos6) + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic='-fPIC -shared' + ;; + + osf3* | osf4* | osf5*) + lt_prog_compiler_wl='-Wl,' + # All OSF/1 code is PIC. + lt_prog_compiler_static='-non_shared' + ;; + + rdos*) + lt_prog_compiler_static='-non_shared' + ;; + + solaris*) + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + case $cc_basename in + f77* | f90* | f95*) + lt_prog_compiler_wl='-Qoption ld ';; + *) + lt_prog_compiler_wl='-Wl,';; + esac + ;; + + sunos4*) + lt_prog_compiler_wl='-Qoption ld ' + lt_prog_compiler_pic='-PIC' + lt_prog_compiler_static='-Bstatic' + ;; + + sysv4 | sysv4.2uw2* | sysv4.3*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + sysv4*MP*) + if test -d /usr/nec ;then + lt_prog_compiler_pic='-Kconform_pic' + lt_prog_compiler_static='-Bstatic' + fi + ;; + + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + unicos*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_can_build_shared=no + ;; + + uts4*) + lt_prog_compiler_pic='-pic' + lt_prog_compiler_static='-Bstatic' + ;; + + *) + lt_prog_compiler_can_build_shared=no + ;; + esac + fi + +case $host_os in + # For platforms which do not support PIC, -DPIC is meaningless: + *djgpp*) + lt_prog_compiler_pic= + ;; + *) + lt_prog_compiler_pic="$lt_prog_compiler_pic -DPIC" + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_prog_compiler_pic" >&5 +$as_echo "$lt_prog_compiler_pic" >&6; } + + + + + + +# +# Check to make sure the PIC flag actually works. +# +if test -n "$lt_prog_compiler_pic"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5 +$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic works... " >&6; } +if test "${lt_cv_prog_compiler_pic_works+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_works=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="$lt_prog_compiler_pic -DPIC" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_pic_works=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works" >&5 +$as_echo "$lt_cv_prog_compiler_pic_works" >&6; } + +if test x"$lt_cv_prog_compiler_pic_works" = xyes; then + case $lt_prog_compiler_pic in + "" | " "*) ;; + *) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;; + esac +else + lt_prog_compiler_pic= + lt_prog_compiler_can_build_shared=no +fi + +fi + + + + + + +# +# Check to make sure the static flag actually works. +# +wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 +$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } +if test "${lt_cv_prog_compiler_static_works+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_static_works=no + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS $lt_tmp_static_flag" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_static_works=yes + fi + else + lt_cv_prog_compiler_static_works=yes + fi + fi + $RM -r conftest* + LDFLAGS="$save_LDFLAGS" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works" >&5 +$as_echo "$lt_cv_prog_compiler_static_works" >&6; } + +if test x"$lt_cv_prog_compiler_static_works" = xyes; then + : +else + lt_prog_compiler_static= +fi + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if test "${lt_cv_prog_compiler_c_o+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5 +$as_echo "$lt_cv_prog_compiler_c_o" >&6; } + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if test "${lt_cv_prog_compiler_c_o+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5 +$as_echo "$lt_cv_prog_compiler_c_o" >&6; } + + + + +hard_links="nottested" +if test "$lt_cv_prog_compiler_c_o" = no && test "$need_locks" != no; then + # do not overwrite the value of need_locks provided by the user + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 +$as_echo_n "checking if we can lock with hard links... " >&6; } + hard_links=yes + $RM conftest* + ln conftest.a conftest.b 2>/dev/null && hard_links=no + touch conftest.a + ln conftest.a conftest.b 2>&5 || hard_links=no + ln conftest.a conftest.b 2>/dev/null && hard_links=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 +$as_echo "$hard_links" >&6; } + if test "$hard_links" = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5 +$as_echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;} + need_locks=warn + fi +else + need_locks=no +fi + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + + runpath_var= + allow_undefined_flag= + always_export_symbols=no + archive_cmds= + archive_expsym_cmds= + compiler_needs_object=no + enable_shared_with_static_runtimes=no + export_dynamic_flag_spec= + export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + hardcode_automatic=no + hardcode_direct=no + hardcode_direct_absolute=no + hardcode_libdir_flag_spec= + hardcode_libdir_flag_spec_ld= + hardcode_libdir_separator= + hardcode_minus_L=no + hardcode_shlibpath_var=unsupported + inherit_rpath=no + link_all_deplibs=unknown + module_cmds= + module_expsym_cmds= + old_archive_from_new_cmds= + old_archive_from_expsyms_cmds= + thread_safe_flag_spec= + whole_archive_flag_spec= + # include_expsyms should be a list of space-separated symbols to be *always* + # included in the symbol list + include_expsyms= + # exclude_expsyms can be an extended regexp of symbols to exclude + # it will be wrapped by ` (' and `)$', so one must not match beginning or + # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc', + # as well as any symbol that contains `d'. + exclude_expsyms='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' + # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out + # platforms (ab)use it in PIC code, but their linkers get confused if + # the symbol is explicitly referenced. Since portable code cannot + # rely on this symbol name, it's probably fine to never include it in + # preloaded symbol tables. + # Exclude shared library initialization/finalization symbols. + extract_expsyms_cmds= + + case $host_os in + cygwin* | mingw* | pw32* | cegcc*) + # FIXME: the MSVC++ port hasn't been tested in a loooong time + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + if test "$GCC" != yes; then + with_gnu_ld=no + fi + ;; + interix*) + # we just hope/assume this is gcc and not c89 (= MSVC++) + with_gnu_ld=yes + ;; + openbsd*) + with_gnu_ld=no + ;; + esac + + ld_shlibs=yes + + # On some targets, GNU ld is compatible enough with the native linker + # that we're better off using the native interface for both. + lt_use_gnu_ld_interface=no + if test "$with_gnu_ld" = yes; then + case $host_os in + aix*) + # The AIX port of GNU ld has always aspired to compatibility + # with the native linker. However, as the warning in the GNU ld + # block says, versions before 2.19.5* couldn't really create working + # shared libraries, regardless of the interface used. + case `$LD -v 2>&1` in + *\ \(GNU\ Binutils\)\ 2.19.5*) ;; + *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;; + *\ \(GNU\ Binutils\)\ [3-9]*) ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + fi + + if test "$lt_use_gnu_ld_interface" = yes; then + # If archive_cmds runs LD, not CC, wlarc should be empty + wlarc='${wl}' + + # Set some defaults for GNU ld with shared library support. These + # are reset later if shared libraries are not supported. Putting them + # here allows them to be overridden if necessary. + runpath_var=LD_RUN_PATH + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + export_dynamic_flag_spec='${wl}--export-dynamic' + # ancient GNU ld didn't support --whole-archive et. al. + if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then + whole_archive_flag_spec="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive' + else + whole_archive_flag_spec= + fi + supports_anon_versioning=no + case `$LD -v 2>&1` in + *GNU\ gold*) supports_anon_versioning=yes ;; + *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 + *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... + *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... + *\ 2.11.*) ;; # other 2.11 versions + *) supports_anon_versioning=yes ;; + esac + + # See if GNU ld supports shared libraries. + case $host_os in + aix[3-9]*) + # On AIX/PPC, the GNU linker is very broken + if test "$host_cpu" != ia64; then + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: the GNU linker, at least up to release 2.19, is reported +*** to be unable to reliably create shared libraries on AIX. +*** Therefore, libtool is disabling shared libraries support. If you +*** really care for shared libraries, you may want to install binutils +*** 2.20 or above, or modify your PATH so that a non-GNU linker is found. +*** You will then need to restart the configuration process. + +_LT_EOF + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='' + ;; + m68k) + archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + ;; + esac + ;; + + beos*) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + allow_undefined_flag=unsupported + # Joseph Beckenbach says some releases of gcc + # support --undefined. This deserves some investigation. FIXME + archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + else + ld_shlibs=no + fi + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # _LT_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless, + # as there is no search path for DLLs. + hardcode_libdir_flag_spec='-L$libdir' + export_dynamic_flag_spec='${wl}--export-all-symbols' + allow_undefined_flag=unsupported + always_export_symbols=no + enable_shared_with_static_runtimes=yes + export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols' + + if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + # If the export-symbols file already is a .def file (1st line + # is EXPORTS), use it as is; otherwise, prepend... + archive_expsym_cmds='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then + cp $export_symbols $output_objdir/$soname.def; + else + echo EXPORTS > $output_objdir/$soname.def; + cat $export_symbols >> $output_objdir/$soname.def; + fi~ + $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + else + ld_shlibs=no + fi + ;; + + haiku*) + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + link_all_deplibs=yes + ;; + + interix[3-9]*) + hardcode_direct=no + hardcode_shlibpath_var=no + hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + export_dynamic_flag_spec='${wl}-E' + # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. + # Instead, shared libraries are loaded at an image base (0x10000000 by + # default) and relocated if they conflict, which is a slow very memory + # consuming and fragmenting process. To avoid this, we pick a random, + # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link + # time. Moving up from 0x10000000 also allows more sbrk(2) space. + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + archive_expsym_cmds='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + ;; + + gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) + tmp_diet=no + if test "$host_os" = linux-dietlibc; then + case $cc_basename in + diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn) + esac + fi + if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \ + && test "$tmp_diet" = no + then + tmp_addflag= + tmp_sharedflag='-shared' + case $cc_basename,$host_cpu in + pgcc*) # Portland Group C compiler + whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + tmp_addflag=' $pic_flag' + ;; + pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group f77 and f90 compilers + whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + tmp_addflag=' $pic_flag -Mnomain' ;; + ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 + tmp_addflag=' -i_dynamic' ;; + efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 + tmp_addflag=' -i_dynamic -nofor_main' ;; + ifc* | ifort*) # Intel Fortran compiler + tmp_addflag=' -nofor_main' ;; + lf95*) # Lahey Fortran 8.1 + whole_archive_flag_spec= + tmp_sharedflag='--shared' ;; + xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) + tmp_sharedflag='-qmkshrobj' + tmp_addflag= ;; + nvcc*) # Cuda Compiler Driver 2.2 + whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + compiler_needs_object=yes + ;; + esac + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) # Sun C 5.9 + whole_archive_flag_spec='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + compiler_needs_object=yes + tmp_sharedflag='-G' ;; + *Sun\ F*) # Sun Fortran 8.3 + tmp_sharedflag='-G' ;; + esac + archive_cmds='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + + if test "x$supports_anon_versioning" = xyes; then + archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib' + fi + + case $cc_basename in + xlf* | bgf* | bgxlf* | mpixlf*) + # IBM XL Fortran 10.1 on PPC cannot create shared libs itself + whole_archive_flag_spec='--whole-archive$convenience --no-whole-archive' + hardcode_libdir_flag_spec= + hardcode_libdir_flag_spec_ld='-rpath $libdir' + archive_cmds='$LD -shared $libobjs $deplibs $compiler_flags -soname $soname -o $lib' + if test "x$supports_anon_versioning" = xyes; then + archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $LD -shared $libobjs $deplibs $compiler_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' + fi + ;; + esac + else + ld_shlibs=no + fi + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' + wlarc= + else + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + fi + ;; + + solaris*) + if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: The releases 2.8.* of the GNU linker cannot reliably +*** create shared libraries on Solaris systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.9.1 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + + sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) + case `$LD -v 2>&1` in + *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not +*** reliably create shared libraries on SCO systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.16.91.0.3 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + ;; + *) + # For security reasons, it is highly recommended that you always + # use absolute paths for naming shared libraries, and exclude the + # DT_RUNPATH tag from executables and libraries. But doing so + # requires that you compile everything twice, which is a pain. + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + esac + ;; + + sunos4*) + archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' + wlarc= + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + *) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + esac + + if test "$ld_shlibs" = no; then + runpath_var= + hardcode_libdir_flag_spec= + export_dynamic_flag_spec= + whole_archive_flag_spec= + fi + else + # PORTME fill in a description of your system's linker (not GNU ld) + case $host_os in + aix3*) + allow_undefined_flag=unsupported + always_export_symbols=yes + archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' + # Note: this linker hardcodes the directories in LIBPATH if there + # are no directories specified by -L. + hardcode_minus_L=yes + if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then + # Neither direct hardcoding nor static linking is supported with a + # broken collect2. + hardcode_direct=unsupported + fi + ;; + + aix[4-9]*) + if test "$host_cpu" = ia64; then + # On IA64, the linker does run time linking by default, so we don't + # have to do anything special. + aix_use_runtimelinking=no + exp_sym_flag='-Bexport' + no_entry_flag="" + else + # If we're using GNU nm, then we don't want the "-C" option. + # -C means demangle to AIX nm, but means don't demangle with GNU nm + # Also, AIX nm treats weak defined symbols like other global + # defined symbols, whereas GNU nm marks them as "W". + if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then + export_symbols_cmds='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols' + else + export_symbols_cmds='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols' + fi + aix_use_runtimelinking=no + + # Test if we are trying to use run time linking or normal + # AIX style linking. If -brtl is somewhere in LDFLAGS, we + # need to do runtime linking. + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) + for ld_flag in $LDFLAGS; do + if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then + aix_use_runtimelinking=yes + break + fi + done + ;; + esac + + exp_sym_flag='-bexport' + no_entry_flag='-bnoentry' + fi + + # When large executables or shared objects are built, AIX ld can + # have problems creating the table of contents. If linking a library + # or program results in "error TOC overflow" add -mminimal-toc to + # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not + # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. + + archive_cmds='' + hardcode_direct=yes + hardcode_direct_absolute=yes + hardcode_libdir_separator=':' + link_all_deplibs=yes + file_list_spec='${wl}-f,' + + if test "$GCC" = yes; then + case $host_os in aix4.[012]|aix4.[012].*) + # We only want to do this on AIX 4.2 and lower, the check + # below for broken collect2 doesn't work under 4.3+ + collect2name=`${CC} -print-prog-name=collect2` + if test -f "$collect2name" && + strings "$collect2name" | $GREP resolve_lib_name >/dev/null + then + # We have reworked collect2 + : + else + # We have old collect2 + hardcode_direct=unsupported + # It fails to find uninstalled libraries when the uninstalled + # path is not listed in the libpath. Setting hardcode_minus_L + # to unsupported forces relinking + hardcode_minus_L=yes + hardcode_libdir_flag_spec='-L$libdir' + hardcode_libdir_separator= + fi + ;; + esac + shared_flag='-shared' + if test "$aix_use_runtimelinking" = yes; then + shared_flag="$shared_flag "'${wl}-G' + fi + else + # not using gcc + if test "$host_cpu" = ia64; then + # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release + # chokes on -Wl,-G. The following line is correct: + shared_flag='-G' + else + if test "$aix_use_runtimelinking" = yes; then + shared_flag='${wl}-G' + else + shared_flag='${wl}-bM:SRE' + fi + fi + fi + + export_dynamic_flag_spec='${wl}-bexpall' + # It seems that -bexpall does not export symbols beginning with + # underscore (_), so it is better to generate a list of symbols to export. + always_export_symbols=yes + if test "$aix_use_runtimelinking" = yes; then + # Warning - without using the other runtime loading flags (-brtl), + # -berok will link without error, but may produce a broken library. + allow_undefined_flag='-berok' + # Determine the default libpath from the value encoded in an + # empty executable. + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + +lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\(.*\)$/\1/ + p + } + }' +aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +# Check for a 64-bit object if we didn't find anything. +if test -z "$aix_libpath"; then + aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi + + hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath" + archive_expsym_cmds='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then func_echo_all "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag" + else + if test "$host_cpu" = ia64; then + hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib' + allow_undefined_flag="-z nodefs" + archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols" + else + # Determine the default libpath from the value encoded in an + # empty executable. + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + +lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\(.*\)$/\1/ + p + } + }' +aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +# Check for a 64-bit object if we didn't find anything. +if test -z "$aix_libpath"; then + aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi + + hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath" + # Warning - without using the other run time loading flags, + # -berok will link without error, but may produce a broken library. + no_undefined_flag=' ${wl}-bernotok' + allow_undefined_flag=' ${wl}-berok' + if test "$with_gnu_ld" = yes; then + # We only use this code for GNU lds that support --whole-archive. + whole_archive_flag_spec='${wl}--whole-archive$convenience ${wl}--no-whole-archive' + else + # Exported symbols can be pulled into shared objects from archives + whole_archive_flag_spec='$convenience' + fi + archive_cmds_need_lc=yes + # This is similar to how AIX traditionally builds its shared libraries. + archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname' + fi + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='' + ;; + m68k) + archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + ;; + esac + ;; + + bsdi[45]*) + export_dynamic_flag_spec=-rdynamic + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + # hardcode_libdir_flag_spec is actually meaningless, as there is + # no search path for DLLs. + hardcode_libdir_flag_spec=' ' + allow_undefined_flag=unsupported + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=".dll" + # FIXME: Setting linknames here is a bad hack. + archive_cmds='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames=' + # The linker will automatically build a .lib file if we build a DLL. + old_archive_from_new_cmds='true' + # FIXME: Should let the user specify the lib program. + old_archive_cmds='lib -OUT:$oldlib$oldobjs$old_deplibs' + fix_srcfile_path='`cygpath -w "$srcfile"`' + enable_shared_with_static_runtimes=yes + ;; + + darwin* | rhapsody*) + + + archive_cmds_need_lc=no + hardcode_direct=no + hardcode_automatic=yes + hardcode_shlibpath_var=unsupported + if test "$lt_cv_ld_force_load" = "yes"; then + whole_archive_flag_spec='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience ${wl}-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' + else + whole_archive_flag_spec='' + fi + link_all_deplibs=yes + allow_undefined_flag="$_lt_dar_allow_undefined" + case $cc_basename in + ifort*) _lt_dar_can_shared=yes ;; + *) _lt_dar_can_shared=$GCC ;; + esac + if test "$_lt_dar_can_shared" = "yes"; then + output_verbose_link_cmd=func_echo_all + archive_cmds="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod${_lt_dsymutil}" + module_cmds="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}" + archive_expsym_cmds="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring ${_lt_dar_single_mod}${_lt_dar_export_syms}${_lt_dsymutil}" + module_expsym_cmds="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}" + + else + ld_shlibs=no + fi + + ;; + + dgux*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_shlibpath_var=no + ;; + + # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor + # support. Future versions do this automatically, but an explicit c++rt0.o + # does not break anything, and helps significantly (at the cost of a little + # extra space). + freebsd2.2*) + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + # Unfortunately, older versions of FreeBSD 2 do not have this feature. + freebsd2.*) + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes + hardcode_minus_L=yes + hardcode_shlibpath_var=no + ;; + + # FreeBSD 3 and greater uses gcc -shared to do shared libraries. + freebsd* | dragonfly*) + archive_cmds='$CC -shared -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + hpux9*) + if test "$GCC" = yes; then + archive_cmds='$RM $output_objdir/$soname~$CC -shared -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' + else + archive_cmds='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' + fi + hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' + hardcode_libdir_separator=: + hardcode_direct=yes + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + export_dynamic_flag_spec='${wl}-E' + ;; + + hpux10*) + if test "$GCC" = yes && test "$with_gnu_ld" = no; then + archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' + fi + if test "$with_gnu_ld" = no; then + hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' + hardcode_libdir_flag_spec_ld='+b $libdir' + hardcode_libdir_separator=: + hardcode_direct=yes + hardcode_direct_absolute=yes + export_dynamic_flag_spec='${wl}-E' + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + fi + ;; + + hpux11*) + if test "$GCC" = yes && test "$with_gnu_ld" = no; then + case $host_cpu in + hppa*64*) + archive_cmds='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + else + case $host_cpu in + hppa*64*) + archive_cmds='$CC -b ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + + # Older versions of the 11.00 compiler do not understand -b yet + # (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $CC understands -b" >&5 +$as_echo_n "checking if $CC understands -b... " >&6; } +if test "${lt_cv_prog_compiler__b+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler__b=no + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS -b" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler__b=yes + fi + else + lt_cv_prog_compiler__b=yes + fi + fi + $RM -r conftest* + LDFLAGS="$save_LDFLAGS" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler__b" >&5 +$as_echo "$lt_cv_prog_compiler__b" >&6; } + +if test x"$lt_cv_prog_compiler__b" = xyes; then + archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' +else + archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' +fi + + ;; + esac + fi + if test "$with_gnu_ld" = no; then + hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' + hardcode_libdir_separator=: + + case $host_cpu in + hppa*64*|ia64*) + hardcode_direct=no + hardcode_shlibpath_var=no + ;; + *) + hardcode_direct=yes + hardcode_direct_absolute=yes + export_dynamic_flag_spec='${wl}-E' + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + ;; + esac + fi + ;; + + irix5* | irix6* | nonstopux*) + if test "$GCC" = yes; then + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' + # Try to use the -exported_symbol ld option, if it does not + # work, assume that -exports_file does not work either and + # implicitly export all symbols. + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS -shared ${wl}-exported_symbol ${wl}foo ${wl}-update_registry ${wl}/dev/null" + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +int foo(void) {} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations ${wl}-exports_file ${wl}$export_symbols -o $lib' + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS="$save_LDFLAGS" + else + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -exports_file $export_symbols -o $lib' + fi + archive_cmds_need_lc='no' + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + hardcode_libdir_separator=: + inherit_rpath=yes + link_all_deplibs=yes + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out + else + archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF + fi + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + newsos6) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + hardcode_libdir_separator=: + hardcode_shlibpath_var=no + ;; + + *nto* | *qnx*) + ;; + + openbsd*) + if test -f /usr/libexec/ld.so; then + hardcode_direct=yes + hardcode_shlibpath_var=no + hardcode_direct_absolute=yes + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols' + hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + export_dynamic_flag_spec='${wl}-E' + else + case $host_os in + openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec='-R$libdir' + ;; + *) + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + ;; + esac + fi + else + ld_shlibs=no + fi + ;; + + os2*) + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + allow_undefined_flag=unsupported + archive_cmds='$ECHO "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~echo DATA >> $output_objdir/$libname.def~echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def' + old_archive_from_new_cmds='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def' + ;; + + osf3*) + if test "$GCC" = yes; then + allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*' + archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' + else + allow_undefined_flag=' -expect_unresolved \*' + archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib' + fi + archive_cmds_need_lc='no' + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + hardcode_libdir_separator=: + ;; + + osf4* | osf5*) # as osf3* with the addition of -msym flag + if test "$GCC" = yes; then + allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*' + archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + else + allow_undefined_flag=' -expect_unresolved \*' + archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib' + archive_expsym_cmds='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~ + $CC -shared${allow_undefined_flag} ${wl}-input ${wl}$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib~$RM $lib.exp' + + # Both c and cxx compiler support -rpath directly + hardcode_libdir_flag_spec='-rpath $libdir' + fi + archive_cmds_need_lc='no' + hardcode_libdir_separator=: + ;; + + solaris*) + no_undefined_flag=' -z defs' + if test "$GCC" = yes; then + wlarc='${wl}' + archive_cmds='$CC -shared ${wl}-z ${wl}text ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -shared ${wl}-z ${wl}text ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + else + case `$CC -V 2>&1` in + *"Compilers 5.0"*) + wlarc='' + archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp' + ;; + *) + wlarc='${wl}' + archive_cmds='$CC -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + ;; + esac + fi + hardcode_libdir_flag_spec='-R$libdir' + hardcode_shlibpath_var=no + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + # The compiler driver will combine and reorder linker options, + # but understands `-z linker_flag'. GCC discards it without `$wl', + # but is careful enough not to reorder. + # Supported since Solaris 2.6 (maybe 2.5.1?) + if test "$GCC" = yes; then + whole_archive_flag_spec='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract' + else + whole_archive_flag_spec='-z allextract$convenience -z defaultextract' + fi + ;; + esac + link_all_deplibs=yes + ;; + + sunos4*) + if test "x$host_vendor" = xsequent; then + # Use $CC to link under sequent, because it throws in some extra .o + # files that make .init and .fini sections work. + archive_cmds='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' + fi + hardcode_libdir_flag_spec='-L$libdir' + hardcode_direct=yes + hardcode_minus_L=yes + hardcode_shlibpath_var=no + ;; + + sysv4) + case $host_vendor in + sni) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes # is this really true??? + ;; + siemens) + ## LD is ld it makes a PLAMLIB + ## CC just makes a GrossModule. + archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags' + reload_cmds='$CC -r -o $output$reload_objs' + hardcode_direct=no + ;; + motorola) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=no #Motorola manual says yes, but my tests say they lie + ;; + esac + runpath_var='LD_RUN_PATH' + hardcode_shlibpath_var=no + ;; + + sysv4.3*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var=no + export_dynamic_flag_spec='-Bexport' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var=no + runpath_var=LD_RUN_PATH + hardcode_runpath_var=yes + ld_shlibs=yes + fi + ;; + + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) + no_undefined_flag='${wl}-z,text' + archive_cmds_need_lc=no + hardcode_shlibpath_var=no + runpath_var='LD_RUN_PATH' + + if test "$GCC" = yes; then + archive_cmds='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + sysv5* | sco3.2v5* | sco5v6*) + # Note: We can NOT use -z defs as we might desire, because we do not + # link with -lc, and that would cause any symbols used from libc to + # always be unresolved, which means just about no library would + # ever link correctly. If we're not using GNU ld we use -z text + # though, which does catch some bad symbols but isn't as heavy-handed + # as -z defs. + no_undefined_flag='${wl}-z,text' + allow_undefined_flag='${wl}-z,nodefs' + archive_cmds_need_lc=no + hardcode_shlibpath_var=no + hardcode_libdir_flag_spec='${wl}-R,$libdir' + hardcode_libdir_separator=':' + link_all_deplibs=yes + export_dynamic_flag_spec='${wl}-Bexport' + runpath_var='LD_RUN_PATH' + + if test "$GCC" = yes; then + archive_cmds='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + uts4*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_shlibpath_var=no + ;; + + *) + ld_shlibs=no + ;; + esac + + if test x$host_vendor = xsni; then + case $host in + sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) + export_dynamic_flag_spec='${wl}-Blargedynsym' + ;; + esac + fi + fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs" >&5 +$as_echo "$ld_shlibs" >&6; } +test "$ld_shlibs" = no && can_build_shared=no + +with_gnu_ld=$with_gnu_ld + + + + + + + + + + + + + + + +# +# Do we need to explicitly link libc? +# +case "x$archive_cmds_need_lc" in +x|xyes) + # Assume -lc should be added + archive_cmds_need_lc=yes + + if test "$enable_shared" = yes && test "$GCC" = yes; then + case $archive_cmds in + *'~'*) + # FIXME: we may have to deal with multi-command sequences. + ;; + '$CC '*) + # Test whether the compiler implicitly links with -lc since on some + # systems, -lgcc has to come before -lc. If gcc already passes -lc + # to ld, don't add -lc before -lgcc. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 +$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } +if test "${lt_cv_archive_cmds_need_lc+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + $RM conftest* + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } 2>conftest.err; then + soname=conftest + lib=conftest + libobjs=conftest.$ac_objext + deplibs= + wl=$lt_prog_compiler_wl + pic_flag=$lt_prog_compiler_pic + compiler_flags=-v + linker_flags=-v + verstring= + output_objdir=. + libname=conftest + lt_save_allow_undefined_flag=$allow_undefined_flag + allow_undefined_flag= + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 + (eval $archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + then + lt_cv_archive_cmds_need_lc=no + else + lt_cv_archive_cmds_need_lc=yes + fi + allow_undefined_flag=$lt_save_allow_undefined_flag + else + cat conftest.err 1>&5 + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc" >&5 +$as_echo "$lt_cv_archive_cmds_need_lc" >&6; } + archive_cmds_need_lc=$lt_cv_archive_cmds_need_lc + ;; + esac + fi + ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 +$as_echo_n "checking dynamic linker characteristics... " >&6; } + +if test "$GCC" = yes; then + case $host_os in + darwin*) lt_awk_arg="/^libraries:/,/LR/" ;; + *) lt_awk_arg="/^libraries:/" ;; + esac + case $host_os in + mingw* | cegcc*) lt_sed_strip_eq="s,=\([A-Za-z]:\),\1,g" ;; + *) lt_sed_strip_eq="s,=/,/,g" ;; + esac + lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq` + case $lt_search_path_spec in + *\;*) + # if the path contains ";" then we assume it to be the separator + # otherwise default to the standard path separator (i.e. ":") - it is + # assumed that no part of a normal pathname contains ";" but that should + # okay in the real world where ";" in dirpaths is itself problematic. + lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'` + ;; + *) + lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"` + ;; + esac + # Ok, now we have the path, separated by spaces, we can step through it + # and add multilib dir if necessary. + lt_tmp_lt_search_path_spec= + lt_multi_os_dir=`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null` + for lt_sys_path in $lt_search_path_spec; do + if test -d "$lt_sys_path/$lt_multi_os_dir"; then + lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path/$lt_multi_os_dir" + else + test -d "$lt_sys_path" && \ + lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path" + fi + done + lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk ' +BEGIN {RS=" "; FS="/|\n";} { + lt_foo=""; + lt_count=0; + for (lt_i = NF; lt_i > 0; lt_i--) { + if ($lt_i != "" && $lt_i != ".") { + if ($lt_i == "..") { + lt_count++; + } else { + if (lt_count == 0) { + lt_foo="/" $lt_i lt_foo; + } else { + lt_count--; + } + } + } + } + if (lt_foo != "") { lt_freq[lt_foo]++; } + if (lt_freq[lt_foo] == 1) { print lt_foo; } +}'` + # AWK program above erroneously prepends '/' to C:/dos/paths + # for these hosts. + case $host_os in + mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\ + $SED 's,/\([A-Za-z]:\),\1,g'` ;; + esac + sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP` +else + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" +fi +library_names_spec= +libname_spec='lib$name' +soname_spec= +shrext_cmds=".so" +postinstall_cmds= +postuninstall_cmds= +finish_cmds= +finish_eval= +shlibpath_var= +shlibpath_overrides_runpath=unknown +version_type=none +dynamic_linker="$host_os ld.so" +sys_lib_dlsearch_path_spec="/lib /usr/lib" +need_lib_prefix=unknown +hardcode_into_libs=no + +# when you set need_version to no, make sure it does not cause -set_version +# flags to be left without arguments +need_version=unknown + +case $host_os in +aix3*) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a' + shlibpath_var=LIBPATH + + # AIX 3 has no versioning support, so we append a major version to the name. + soname_spec='${libname}${release}${shared_ext}$major' + ;; + +aix[4-9]*) + version_type=linux + need_lib_prefix=no + need_version=no + hardcode_into_libs=yes + if test "$host_cpu" = ia64; then + # AIX 5 supports IA64 + library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + else + # With GCC up to 2.95.x, collect2 would create an import file + # for dependence libraries. The import file would start with + # the line `#! .'. This would cause the generated library to + # depend on `.', always an invalid library. This was fixed in + # development snapshots of GCC prior to 3.0. + case $host_os in + aix4 | aix4.[01] | aix4.[01].*) + if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' + echo ' yes ' + echo '#endif'; } | ${CC} -E - | $GREP yes > /dev/null; then + : + else + can_build_shared=no + fi + ;; + esac + # AIX (on Power*) has no versioning support, so currently we can not hardcode correct + # soname into executable. Probably we can add versioning support to + # collect2, so additional links can be useful in future. + if test "$aix_use_runtimelinking" = yes; then + # If using run time linking (on AIX 4.2 or later) use lib.so + # instead of lib.a to let people know that these are not + # typical AIX shared libraries. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + else + # We preserve .a as extension for shared libraries through AIX4.2 + # and later when we are not doing run time linking. + library_names_spec='${libname}${release}.a $libname.a' + soname_spec='${libname}${release}${shared_ext}$major' + fi + shlibpath_var=LIBPATH + fi + ;; + +amigaos*) + case $host_cpu in + powerpc) + # Since July 2007 AmigaOS4 officially supports .so libraries. + # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + ;; + m68k) + library_names_spec='$libname.ixlibrary $libname.a' + # Create ${libname}_ixlibrary.a entries in /sys/libs. + finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' + ;; + esac + ;; + +beos*) + library_names_spec='${libname}${shared_ext}' + dynamic_linker="$host_os ld.so" + shlibpath_var=LIBRARY_PATH + ;; + +bsdi[45]*) + version_type=linux + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" + sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" + # the default ld.so.conf also contains /usr/contrib/lib and + # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow + # libtool to hard-code these into programs + ;; + +cygwin* | mingw* | pw32* | cegcc*) + version_type=windows + shrext_cmds=".dll" + need_version=no + need_lib_prefix=no + + case $GCC,$host_os in + yes,cygwin* | yes,mingw* | yes,pw32* | yes,cegcc*) + library_names_spec='$libname.dll.a' + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \${file}`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + + case $host_os in + cygwin*) + # Cygwin DLLs use 'cyg' prefix rather than 'lib' + soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' + + sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api" + ;; + mingw* | cegcc*) + # MinGW DLLs use traditional 'lib' prefix + soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' + ;; + pw32*) + # pw32 DLLs use 'pw' prefix rather than 'lib' + library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' + ;; + esac + ;; + + *) + library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib' + ;; + esac + dynamic_linker='Win32 ld.exe' + # FIXME: first we should search . and the directory the executable is in + shlibpath_var=PATH + ;; + +darwin* | rhapsody*) + dynamic_linker="$host_os dyld" + version_type=darwin + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${major}$shared_ext ${libname}$shared_ext' + soname_spec='${libname}${release}${major}$shared_ext' + shlibpath_overrides_runpath=yes + shlibpath_var=DYLD_LIBRARY_PATH + shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' + + sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib" + sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' + ;; + +dgux*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +freebsd* | dragonfly*) + # DragonFly does not have aout. When/if they implement a new + # versioning mechanism, adjust this. + if test -x /usr/bin/objformat; then + objformat=`/usr/bin/objformat` + else + case $host_os in + freebsd[23].*) objformat=aout ;; + *) objformat=elf ;; + esac + fi + version_type=freebsd-$objformat + case $version_type in + freebsd-elf*) + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' + need_version=no + need_lib_prefix=no + ;; + freebsd-*) + library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix' + need_version=yes + ;; + esac + shlibpath_var=LD_LIBRARY_PATH + case $host_os in + freebsd2.*) + shlibpath_overrides_runpath=yes + ;; + freebsd3.[01]* | freebsdelf3.[01]*) + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ + freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + *) # from 4.6 on, and DragonFly + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + esac + ;; + +gnu*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + hardcode_into_libs=yes + ;; + +haiku*) + version_type=linux + need_lib_prefix=no + need_version=no + dynamic_linker="$host_os runtime_loader" + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LIBRARY_PATH + shlibpath_overrides_runpath=yes + sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/beos/system/lib' + hardcode_into_libs=yes + ;; + +hpux9* | hpux10* | hpux11*) + # Give a soname corresponding to the major version so that dld.sl refuses to + # link against other versions. + version_type=sunos + need_lib_prefix=no + need_version=no + case $host_cpu in + ia64*) + shrext_cmds='.so' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.so" + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + if test "X$HPUX_IA64_MODE" = X32; then + sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" + else + sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" + fi + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + hppa*64*) + shrext_cmds='.sl' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.sl" + shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + *) + shrext_cmds='.sl' + dynamic_linker="$host_os dld.sl" + shlibpath_var=SHLIB_PATH + shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + ;; + esac + # HP-UX runs *really* slowly unless shared libraries are mode 555, ... + postinstall_cmds='chmod 555 $lib' + # or fails outright, so override atomically: + install_override_mode=555 + ;; + +interix[3-9]*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +irix5* | irix6* | nonstopux*) + case $host_os in + nonstopux*) version_type=nonstopux ;; + *) + if test "$lt_cv_prog_gnu_ld" = yes; then + version_type=linux + else + version_type=irix + fi ;; + esac + need_lib_prefix=no + need_version=no + soname_spec='${libname}${release}${shared_ext}$major' + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}' + case $host_os in + irix5* | nonstopux*) + libsuff= shlibsuff= + ;; + *) + case $LD in # libtool.m4 will add one of these switches to LD + *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") + libsuff= shlibsuff= libmagic=32-bit;; + *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") + libsuff=32 shlibsuff=N32 libmagic=N32;; + *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") + libsuff=64 shlibsuff=64 libmagic=64-bit;; + *) libsuff= shlibsuff= libmagic=never-match;; + esac + ;; + esac + shlibpath_var=LD_LIBRARY${shlibsuff}_PATH + shlibpath_overrides_runpath=no + sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}" + sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}" + hardcode_into_libs=yes + ;; + +# No shared lib support for Linux oldld, aout, or coff. +linux*oldld* | linux*aout* | linux*coff*) + dynamic_linker=no + ;; + +# This must be Linux ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + + # Some binutils ld are patched to set DT_RUNPATH + if test "${lt_cv_shlibpath_overrides_runpath+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_shlibpath_overrides_runpath=no + save_LDFLAGS=$LDFLAGS + save_libdir=$libdir + eval "libdir=/foo; wl=\"$lt_prog_compiler_wl\"; \ + LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec\"" + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : + lt_cv_shlibpath_overrides_runpath=yes +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + libdir=$save_libdir + +fi + + shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + # Append ld.so.conf contents to the search path + if test -f /etc/ld.so.conf; then + lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` + sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" + fi + + # We used to test for /lib/ld.so.1 and disable shared libraries on + # powerpc, because MkLinux only supported shared libraries with the + # GNU dynamic linker. Since this was broken with cross compilers, + # most powerpc-linux boxes support dynamic linking these days and + # people can always --disable-shared, the test was removed, and we + # assume the GNU/Linux dynamic linker is in use. + dynamic_linker='GNU/Linux ld.so' + ;; + +netbsd*) + version_type=sunos + need_lib_prefix=no + need_version=no + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + dynamic_linker='NetBSD (a.out) ld.so' + else + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + dynamic_linker='NetBSD ld.elf_so' + fi + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + +newsos6) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +*nto* | *qnx*) + version_type=qnx + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + dynamic_linker='ldqnx.so' + ;; + +openbsd*) + version_type=sunos + sys_lib_dlsearch_path_spec="/usr/lib" + need_lib_prefix=no + # Some older versions of OpenBSD (3.3 at least) *do* need versioned libs. + case $host_os in + openbsd3.3 | openbsd3.3.*) need_version=yes ;; + *) need_version=no ;; + esac + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + shlibpath_var=LD_LIBRARY_PATH + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then + case $host_os in + openbsd2.[89] | openbsd2.[89].*) + shlibpath_overrides_runpath=no + ;; + *) + shlibpath_overrides_runpath=yes + ;; + esac + else + shlibpath_overrides_runpath=yes + fi + ;; + +os2*) + libname_spec='$name' + shrext_cmds=".dll" + need_lib_prefix=no + library_names_spec='$libname${shared_ext} $libname.a' + dynamic_linker='OS/2 ld.exe' + shlibpath_var=LIBPATH + ;; + +osf3* | osf4* | osf5*) + version_type=osf + need_lib_prefix=no + need_version=no + soname_spec='${libname}${release}${shared_ext}$major' + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" + sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec" + ;; + +rdos*) + dynamic_linker=no + ;; + +solaris*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + # ldd complains unless libraries are executable + postinstall_cmds='chmod +x $lib' + ;; + +sunos4*) + version_type=sunos + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' + finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + if test "$with_gnu_ld" = yes; then + need_lib_prefix=no + fi + need_version=yes + ;; + +sysv4 | sysv4.3*) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + case $host_vendor in + sni) + shlibpath_overrides_runpath=no + need_lib_prefix=no + runpath_var=LD_RUN_PATH + ;; + siemens) + need_lib_prefix=no + ;; + motorola) + need_lib_prefix=no + need_version=no + shlibpath_overrides_runpath=no + sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' + ;; + esac + ;; + +sysv4*MP*) + if test -d /usr/nec ;then + version_type=linux + library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}' + soname_spec='$libname${shared_ext}.$major' + shlibpath_var=LD_LIBRARY_PATH + fi + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + version_type=freebsd-elf + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + if test "$with_gnu_ld" = yes; then + sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' + else + sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' + case $host_os in + sco3.2v5*) + sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" + ;; + esac + fi + sys_lib_dlsearch_path_spec='/usr/lib' + ;; + +tpf*) + # TPF is a cross-target only. Preferred cross-host = GNU/Linux. + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +uts4*) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +*) + dynamic_linker=no + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 +$as_echo "$dynamic_linker" >&6; } +test "$dynamic_linker" = no && can_build_shared=no + +variables_saved_for_relink="PATH $shlibpath_var $runpath_var" +if test "$GCC" = yes; then + variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" +fi + +if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then + sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec" +fi +if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then + sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec" +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 +$as_echo_n "checking how to hardcode library paths into programs... " >&6; } +hardcode_action= +if test -n "$hardcode_libdir_flag_spec" || + test -n "$runpath_var" || + test "X$hardcode_automatic" = "Xyes" ; then + + # We can hardcode non-existent directories. + if test "$hardcode_direct" != no && + # If the only mechanism to avoid hardcoding is shlibpath_var, we + # have to relink, otherwise we might link with an installed library + # when we should be linking with a yet-to-be-installed one + ## test "$_LT_TAGVAR(hardcode_shlibpath_var, )" != no && + test "$hardcode_minus_L" != no; then + # Linking always hardcodes the temporary library directory. + hardcode_action=relink + else + # We can link without hardcoding, and we can hardcode nonexisting dirs. + hardcode_action=immediate + fi +else + # We cannot hardcode anything, or else we can only hardcode existing + # directories. + hardcode_action=unsupported +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action" >&5 +$as_echo "$hardcode_action" >&6; } + +if test "$hardcode_action" = relink || + test "$inherit_rpath" = yes; then + # Fast installation is not supported + enable_fast_install=no +elif test "$shlibpath_overrides_runpath" = yes || + test "$enable_shared" = no; then + # Fast installation is not necessary + enable_fast_install=needless +fi + + + + + + + if test "x$enable_dlopen" != xyes; then + enable_dlopen=unknown + enable_dlopen_self=unknown + enable_dlopen_self_static=unknown +else + lt_cv_dlopen=no + lt_cv_dlopen_libs= + + case $host_os in + beos*) + lt_cv_dlopen="load_add_on" + lt_cv_dlopen_libs= + lt_cv_dlopen_self=yes + ;; + + mingw* | pw32* | cegcc*) + lt_cv_dlopen="LoadLibrary" + lt_cv_dlopen_libs= + ;; + + cygwin*) + lt_cv_dlopen="dlopen" + lt_cv_dlopen_libs= + ;; + + darwin*) + # if libdl is installed we need to link against it + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if test "${ac_cv_lib_dl_dlopen+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = x""yes; then : + lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl" +else + + lt_cv_dlopen="dyld" + lt_cv_dlopen_libs= + lt_cv_dlopen_self=yes + +fi + + ;; + + *) + ac_fn_c_check_func "$LINENO" "shl_load" "ac_cv_func_shl_load" +if test "x$ac_cv_func_shl_load" = x""yes; then : + lt_cv_dlopen="shl_load" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 +$as_echo_n "checking for shl_load in -ldld... " >&6; } +if test "${ac_cv_lib_dld_shl_load+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char shl_load (); +int +main () +{ +return shl_load (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_shl_load=yes +else + ac_cv_lib_dld_shl_load=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 +$as_echo "$ac_cv_lib_dld_shl_load" >&6; } +if test "x$ac_cv_lib_dld_shl_load" = x""yes; then : + lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-ldld" +else + ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen" +if test "x$ac_cv_func_dlopen" = x""yes; then : + lt_cv_dlopen="dlopen" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if test "${ac_cv_lib_dl_dlopen+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = x""yes; then : + lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -lsvld" >&5 +$as_echo_n "checking for dlopen in -lsvld... " >&6; } +if test "${ac_cv_lib_svld_dlopen+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsvld $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_svld_dlopen=yes +else + ac_cv_lib_svld_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_svld_dlopen" >&5 +$as_echo "$ac_cv_lib_svld_dlopen" >&6; } +if test "x$ac_cv_lib_svld_dlopen" = x""yes; then : + lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-lsvld" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dld_link in -ldld" >&5 +$as_echo_n "checking for dld_link in -ldld... " >&6; } +if test "${ac_cv_lib_dld_dld_link+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dld_link (); +int +main () +{ +return dld_link (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_dld_link=yes +else + ac_cv_lib_dld_dld_link=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_dld_link" >&5 +$as_echo "$ac_cv_lib_dld_dld_link" >&6; } +if test "x$ac_cv_lib_dld_dld_link" = x""yes; then : + lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-ldld" +fi + + +fi + + +fi + + +fi + + +fi + + +fi + + ;; + esac + + if test "x$lt_cv_dlopen" != xno; then + enable_dlopen=yes + else + enable_dlopen=no + fi + + case $lt_cv_dlopen in + dlopen) + save_CPPFLAGS="$CPPFLAGS" + test "x$ac_cv_header_dlfcn_h" = xyes && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H" + + save_LDFLAGS="$LDFLAGS" + wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\" + + save_LIBS="$LIBS" + LIBS="$lt_cv_dlopen_libs $LIBS" + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a program can dlopen itself" >&5 +$as_echo_n "checking whether a program can dlopen itself... " >&6; } +if test "${lt_cv_dlopen_self+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + lt_cv_dlopen_self=cross +else + lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 + lt_status=$lt_dlunknown + cat > conftest.$ac_ext <<_LT_EOF +#line 12115 "configure" +#include "confdefs.h" + +#if HAVE_DLFCN_H +#include +#endif + +#include + +#ifdef RTLD_GLOBAL +# define LT_DLGLOBAL RTLD_GLOBAL +#else +# ifdef DL_GLOBAL +# define LT_DLGLOBAL DL_GLOBAL +# else +# define LT_DLGLOBAL 0 +# endif +#endif + +/* We may have to define LT_DLLAZY_OR_NOW in the command line if we + find out it does not work in some platform. */ +#ifndef LT_DLLAZY_OR_NOW +# ifdef RTLD_LAZY +# define LT_DLLAZY_OR_NOW RTLD_LAZY +# else +# ifdef DL_LAZY +# define LT_DLLAZY_OR_NOW DL_LAZY +# else +# ifdef RTLD_NOW +# define LT_DLLAZY_OR_NOW RTLD_NOW +# else +# ifdef DL_NOW +# define LT_DLLAZY_OR_NOW DL_NOW +# else +# define LT_DLLAZY_OR_NOW 0 +# endif +# endif +# endif +# endif +#endif + +/* When -fvisbility=hidden is used, assume the code has been annotated + correspondingly for the symbols needed. */ +#if defined(__GNUC__) && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) +void fnord () __attribute__((visibility("default"))); +#endif + +void fnord () { int i=42; } +int main () +{ + void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); + int status = $lt_dlunknown; + + if (self) + { + if (dlsym (self,"fnord")) status = $lt_dlno_uscore; + else + { + if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; + else puts (dlerror ()); + } + /* dlclose (self); */ + } + else + puts (dlerror ()); + + return status; +} +_LT_EOF + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s conftest${ac_exeext} 2>/dev/null; then + (./conftest; exit; ) >&5 2>/dev/null + lt_status=$? + case x$lt_status in + x$lt_dlno_uscore) lt_cv_dlopen_self=yes ;; + x$lt_dlneed_uscore) lt_cv_dlopen_self=yes ;; + x$lt_dlunknown|x*) lt_cv_dlopen_self=no ;; + esac + else : + # compilation failed + lt_cv_dlopen_self=no + fi +fi +rm -fr conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self" >&5 +$as_echo "$lt_cv_dlopen_self" >&6; } + + if test "x$lt_cv_dlopen_self" = xyes; then + wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a statically linked program can dlopen itself" >&5 +$as_echo_n "checking whether a statically linked program can dlopen itself... " >&6; } +if test "${lt_cv_dlopen_self_static+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + lt_cv_dlopen_self_static=cross +else + lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 + lt_status=$lt_dlunknown + cat > conftest.$ac_ext <<_LT_EOF +#line 12221 "configure" +#include "confdefs.h" + +#if HAVE_DLFCN_H +#include +#endif + +#include + +#ifdef RTLD_GLOBAL +# define LT_DLGLOBAL RTLD_GLOBAL +#else +# ifdef DL_GLOBAL +# define LT_DLGLOBAL DL_GLOBAL +# else +# define LT_DLGLOBAL 0 +# endif +#endif + +/* We may have to define LT_DLLAZY_OR_NOW in the command line if we + find out it does not work in some platform. */ +#ifndef LT_DLLAZY_OR_NOW +# ifdef RTLD_LAZY +# define LT_DLLAZY_OR_NOW RTLD_LAZY +# else +# ifdef DL_LAZY +# define LT_DLLAZY_OR_NOW DL_LAZY +# else +# ifdef RTLD_NOW +# define LT_DLLAZY_OR_NOW RTLD_NOW +# else +# ifdef DL_NOW +# define LT_DLLAZY_OR_NOW DL_NOW +# else +# define LT_DLLAZY_OR_NOW 0 +# endif +# endif +# endif +# endif +#endif + +/* When -fvisbility=hidden is used, assume the code has been annotated + correspondingly for the symbols needed. */ +#if defined(__GNUC__) && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) +void fnord () __attribute__((visibility("default"))); +#endif + +void fnord () { int i=42; } +int main () +{ + void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); + int status = $lt_dlunknown; + + if (self) + { + if (dlsym (self,"fnord")) status = $lt_dlno_uscore; + else + { + if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; + else puts (dlerror ()); + } + /* dlclose (self); */ + } + else + puts (dlerror ()); + + return status; +} +_LT_EOF + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s conftest${ac_exeext} 2>/dev/null; then + (./conftest; exit; ) >&5 2>/dev/null + lt_status=$? + case x$lt_status in + x$lt_dlno_uscore) lt_cv_dlopen_self_static=yes ;; + x$lt_dlneed_uscore) lt_cv_dlopen_self_static=yes ;; + x$lt_dlunknown|x*) lt_cv_dlopen_self_static=no ;; + esac + else : + # compilation failed + lt_cv_dlopen_self_static=no + fi +fi +rm -fr conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self_static" >&5 +$as_echo "$lt_cv_dlopen_self_static" >&6; } + fi + + CPPFLAGS="$save_CPPFLAGS" + LDFLAGS="$save_LDFLAGS" + LIBS="$save_LIBS" + ;; + esac + + case $lt_cv_dlopen_self in + yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;; + *) enable_dlopen_self=unknown ;; + esac + + case $lt_cv_dlopen_self_static in + yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;; + *) enable_dlopen_self_static=unknown ;; + esac +fi + + + + + + + + + + + + + + + + + +striplib= +old_striplib= +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stripping libraries is possible" >&5 +$as_echo_n "checking whether stripping libraries is possible... " >&6; } +if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then + test -z "$old_striplib" && old_striplib="$STRIP --strip-debug" + test -z "$striplib" && striplib="$STRIP --strip-unneeded" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else +# FIXME - insert some real tests, host_os isn't really good enough + case $host_os in + darwin*) + if test -n "$STRIP" ; then + striplib="$STRIP -x" + old_striplib="$STRIP -S" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + ;; + esac +fi + + + + + + + + + + + + + # Report which library types will actually be built + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5 +$as_echo_n "checking if libtool supports shared libraries... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5 +$as_echo "$can_build_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5 +$as_echo_n "checking whether to build shared libraries... " >&6; } + test "$can_build_shared" = "no" && enable_shared=no + + # On AIX, shared libraries and static libraries use the same namespace, and + # are all built from PIC. + case $host_os in + aix3*) + test "$enable_shared" = yes && enable_static=no + if test -n "$RANLIB"; then + archive_cmds="$archive_cmds~\$RANLIB \$lib" + postinstall_cmds='$RANLIB $lib' + fi + ;; + + aix[4-9]*) + if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then + test "$enable_shared" = yes && enable_static=no + fi + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5 +$as_echo "$enable_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5 +$as_echo_n "checking whether to build static libraries... " >&6; } + # Make sure either enable_shared or enable_static is yes. + test "$enable_shared" = yes || enable_static=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5 +$as_echo "$enable_static" >&6; } + + + + +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +CC="$lt_save_CC" + + + + + + + + + + + + + + ac_config_commands="$ac_config_commands libtool" + + + + +# Only expand once: + + + + + +case $host in + *-cygwin* | *-mingw*) + # 'host' will be top-level target in the case of a target lib, + # we must compare to with_cross_host to decide if this is a native + # or cross-compiler and select where to install dlls appropriately. + if test -n "$with_cross_host" && + test x"$with_cross_host" != x"no"; then + lt_host_flags='-no-undefined -bindir "$(toolexeclibdir)"'; + else + lt_host_flags='-no-undefined -bindir "$(bindir)"'; + fi + ;; + *) + lt_host_flags= + ;; +esac + + + + + +#AC_MSG_NOTICE([====== Finished libtool configuration]) ; sleep 10 + +# We need gfortran to compile parts of the library +#AC_PROG_FC(gfortran) +FC="$GFORTRAN" +ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu +if test -n "$ac_tool_prefix"; then + for ac_prog in gfortran + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_FC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$FC"; then + ac_cv_prog_FC="$FC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_FC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +FC=$ac_cv_prog_FC +if test -n "$FC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FC" >&5 +$as_echo "$FC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$FC" && break + done +fi +if test -z "$FC"; then + ac_ct_FC=$FC + for ac_prog in gfortran +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_prog_ac_ct_FC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_FC"; then + ac_cv_prog_ac_ct_FC="$ac_ct_FC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_ac_ct_FC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_FC=$ac_cv_prog_ac_ct_FC +if test -n "$ac_ct_FC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_FC" >&5 +$as_echo "$ac_ct_FC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_FC" && break +done + + if test "x$ac_ct_FC" = x; then + FC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + FC=$ac_ct_FC + fi +fi + + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + rm -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done +rm -f a.out + +# If we don't use `.F' as extension, the preprocessor is not run on the +# input file. (Note that this only needs to work for GNU compilers.) +ac_save_ext=$ac_ext +ac_ext=F +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU Fortran compiler" >&5 +$as_echo_n "checking whether we are using the GNU Fortran compiler... " >&6; } +if test "${ac_cv_fc_compiler_gnu+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat > conftest.$ac_ext <<_ACEOF + program main +#ifndef __GNUC__ + choke me +#endif + + end +_ACEOF +if ac_fn_fc_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_fc_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_compiler_gnu" >&5 +$as_echo "$ac_cv_fc_compiler_gnu" >&6; } +ac_ext=$ac_save_ext +ac_test_FCFLAGS=${FCFLAGS+set} +ac_save_FCFLAGS=$FCFLAGS +FCFLAGS= +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $FC accepts -g" >&5 +$as_echo_n "checking whether $FC accepts -g... " >&6; } +if test "${ac_cv_prog_fc_g+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + FCFLAGS=-g +cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_fc_try_compile "$LINENO"; then : + ac_cv_prog_fc_g=yes +else + ac_cv_prog_fc_g=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_fc_g" >&5 +$as_echo "$ac_cv_prog_fc_g" >&6; } +if test "$ac_test_FCFLAGS" = set; then + FCFLAGS=$ac_save_FCFLAGS +elif test $ac_cv_prog_fc_g = yes; then + if test "x$ac_cv_fc_compiler_gnu" = xyes; then + FCFLAGS="-g -O2" + else + FCFLAGS="-g" + fi +else + if test "x$ac_cv_fc_compiler_gnu" = xyes; then + FCFLAGS="-O2" + else + FCFLAGS= + fi +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + + +if test -z "$FC" || test "X$FC" = "Xno"; then + _lt_disable_FC=yes +fi + +archive_cmds_need_lc_FC=no +allow_undefined_flag_FC= +always_export_symbols_FC=no +archive_expsym_cmds_FC= +export_dynamic_flag_spec_FC= +hardcode_direct_FC=no +hardcode_direct_absolute_FC=no +hardcode_libdir_flag_spec_FC= +hardcode_libdir_flag_spec_ld_FC= +hardcode_libdir_separator_FC= +hardcode_minus_L_FC=no +hardcode_automatic_FC=no +inherit_rpath_FC=no +module_cmds_FC= +module_expsym_cmds_FC= +link_all_deplibs_FC=unknown +old_archive_cmds_FC=$old_archive_cmds +reload_flag_FC=$reload_flag +reload_cmds_FC=$reload_cmds +no_undefined_flag_FC= +whole_archive_flag_spec_FC= +enable_shared_with_static_runtimes_FC=no + +# Source file extension for fc test sources. +ac_ext=${ac_fc_srcext-f} + +# Object file extension for compiled fc test sources. +objext=o +objext_FC=$objext + +# No sense in running all these tests if we already determined that +# the FC compiler isn't working. Some variables (like enable_shared) +# are currently assumed to apply to all compilers on this platform, +# and will be corrupted by setting them based on a non-working compiler. +if test "$_lt_disable_FC" != yes; then + # Code to be used in simple compile tests + lt_simple_compile_test_code="\ + subroutine t + return + end +" + + # Code to be used in simple link tests + lt_simple_link_test_code="\ + program t + end +" + + # ltmain only uses $CC for tagged configurations so make sure $CC is set. + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + + + # save warnings/boilerplate of simple test code + ac_outfile=conftest.$ac_objext +echo "$lt_simple_compile_test_code" >conftest.$ac_ext +eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_compiler_boilerplate=`cat conftest.err` +$RM conftest* + + ac_outfile=conftest.$ac_objext +echo "$lt_simple_link_test_code" >conftest.$ac_ext +eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_linker_boilerplate=`cat conftest.err` +$RM -r conftest* + + + # Allow CC to be a program name with arguments. + lt_save_CC="$CC" + lt_save_GCC=$GCC + CC=${FC-"f95"} + compiler=$CC + GCC=$ac_cv_fc_compiler_gnu + + compiler_FC=$CC + for cc_temp in $compiler""; do + case $cc_temp in + compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; + distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; + \-*) ;; + *) break;; + esac +done +cc_basename=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"` + + + if test -n "$compiler"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5 +$as_echo_n "checking if libtool supports shared libraries... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5 +$as_echo "$can_build_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5 +$as_echo_n "checking whether to build shared libraries... " >&6; } + test "$can_build_shared" = "no" && enable_shared=no + + # On AIX, shared libraries and static libraries use the same namespace, and + # are all built from PIC. + case $host_os in + aix3*) + test "$enable_shared" = yes && enable_static=no + if test -n "$RANLIB"; then + archive_cmds="$archive_cmds~\$RANLIB \$lib" + postinstall_cmds='$RANLIB $lib' + fi + ;; + aix[4-9]*) + if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then + test "$enable_shared" = yes && enable_static=no + fi + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5 +$as_echo "$enable_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5 +$as_echo_n "checking whether to build static libraries... " >&6; } + # Make sure either enable_shared or enable_static is yes. + test "$enable_shared" = yes || enable_static=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5 +$as_echo "$enable_static" >&6; } + + GCC_FC="$ac_cv_fc_compiler_gnu" + LD_FC="$LD" + + ## CAVEAT EMPTOR: + ## There is no encapsulation within the following macros, do not change + ## the running order or otherwise move them around unless you know exactly + ## what you are doing... + # Dependencies to place before and after the object being linked: +predep_objects_FC= +postdep_objects_FC= +predeps_FC= +postdeps_FC= +compiler_lib_search_path_FC= + +cat > conftest.$ac_ext <<_LT_EOF + subroutine foo + implicit none + integer a + a=0 + return + end +_LT_EOF + +if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + # Parse the compiler output and extract the necessary + # objects, libraries and library flags. + + # Sentinel used to keep track of whether or not we are before + # the conftest object file. + pre_test_object_deps_done=no + + for p in `eval "$output_verbose_link_cmd"`; do + case $p in + + -L* | -R* | -l*) + # Some compilers place space between "-{L,R}" and the path. + # Remove the space. + if test $p = "-L" || + test $p = "-R"; then + prev=$p + continue + else + prev= + fi + + if test "$pre_test_object_deps_done" = no; then + case $p in + -L* | -R*) + # Internal compiler library paths should come after those + # provided the user. The postdeps already come after the + # user supplied libs so there is no need to process them. + if test -z "$compiler_lib_search_path_FC"; then + compiler_lib_search_path_FC="${prev}${p}" + else + compiler_lib_search_path_FC="${compiler_lib_search_path_FC} ${prev}${p}" + fi + ;; + # The "-l" case would never come before the object being + # linked, so don't bother handling this case. + esac + else + if test -z "$postdeps_FC"; then + postdeps_FC="${prev}${p}" + else + postdeps_FC="${postdeps_FC} ${prev}${p}" + fi + fi + ;; + + *.$objext) + # This assumes that the test object file only shows up + # once in the compiler output. + if test "$p" = "conftest.$objext"; then + pre_test_object_deps_done=yes + continue + fi + + if test "$pre_test_object_deps_done" = no; then + if test -z "$predep_objects_FC"; then + predep_objects_FC="$p" + else + predep_objects_FC="$predep_objects_FC $p" + fi + else + if test -z "$postdep_objects_FC"; then + postdep_objects_FC="$p" + else + postdep_objects_FC="$postdep_objects_FC $p" + fi + fi + ;; + + *) ;; # Ignore the rest. + + esac + done + + # Clean up. + rm -f a.out a.exe +else + echo "libtool.m4: error: problem compiling FC test program" +fi + +$RM -f confest.$objext + +# PORTME: override above test on systems where it is broken + + +case " $postdeps_FC " in +*" -lc "*) archive_cmds_need_lc_FC=no ;; +esac + compiler_lib_search_dirs_FC= +if test -n "${compiler_lib_search_path_FC}"; then + compiler_lib_search_dirs_FC=`echo " ${compiler_lib_search_path_FC}" | ${SED} -e 's! -L! !g' -e 's!^ !!'` +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + lt_prog_compiler_wl_FC= +lt_prog_compiler_pic_FC= +lt_prog_compiler_static_FC= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 +$as_echo_n "checking for $compiler option to produce PIC... " >&6; } + + if test "$GCC" = yes; then + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_static_FC='-static' + + case $host_os in + aix*) + # All AIX code is PIC. + if test "$host_cpu" = ia64; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_FC='-Bstatic' + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + lt_prog_compiler_pic_FC='-fPIC' + ;; + m68k) + # FIXME: we need at least 68020 code to build shared libraries, but + # adding the `-m68020' flag to GCC prevents building anything better, + # like `-m68040'. + lt_prog_compiler_pic_FC='-m68020 -resident32 -malways-restore-a4' + ;; + esac + ;; + + beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) + # PIC is the default for these OSes. + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + # Although the cygwin gcc ignores -fPIC, still need this for old-style + # (--disable-auto-import) libraries + lt_prog_compiler_pic_FC='-DDLL_EXPORT' + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic_FC='-fno-common' + ;; + + haiku*) + # PIC is the default for Haiku. + # The "-static" flag exists, but is broken. + lt_prog_compiler_static_FC= + ;; + + hpux*) + # PIC is the default for 64-bit PA HP-UX, but not for 32-bit + # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag + # sets the default TLS model and affects inlining. + case $host_cpu in + hppa*64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic_FC='-fPIC' + ;; + esac + ;; + + interix[3-9]*) + # Interix 3.x gcc -fpic/-fPIC options generate broken code. + # Instead, we relocate shared libraries at runtime. + ;; + + msdosdjgpp*) + # Just because we use GCC doesn't mean we suddenly get shared libraries + # on systems that don't support them. + lt_prog_compiler_can_build_shared_FC=no + enable_shared=no + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_FC='-fPIC -shared' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic_FC=-Kconform_pic + fi + ;; + + *) + lt_prog_compiler_pic_FC='-fPIC' + ;; + esac + + case $cc_basename in + nvcc*) # Cuda Compiler Driver 2.2 + lt_prog_compiler_wl_FC='-Xlinker ' + lt_prog_compiler_pic_FC='-Xcompiler -fPIC' + ;; + esac + else + # PORTME Check for flag to pass linker flags through the system compiler. + case $host_os in + aix*) + lt_prog_compiler_wl_FC='-Wl,' + if test "$host_cpu" = ia64; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static_FC='-Bstatic' + else + lt_prog_compiler_static_FC='-bnso -bI:/lib/syscalls.exp' + fi + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + lt_prog_compiler_pic_FC='-DDLL_EXPORT' + ;; + + hpux9* | hpux10* | hpux11*) + lt_prog_compiler_wl_FC='-Wl,' + # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but + # not for PA HP-UX. + case $host_cpu in + hppa*64*|ia64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic_FC='+Z' + ;; + esac + # Is there a better lt_prog_compiler_static that works with the bundled CC? + lt_prog_compiler_static_FC='${wl}-a ${wl}archive' + ;; + + irix5* | irix6* | nonstopux*) + lt_prog_compiler_wl_FC='-Wl,' + # PIC (with -KPIC) is the default. + lt_prog_compiler_static_FC='-non_shared' + ;; + + linux* | k*bsd*-gnu | kopensolaris*-gnu) + case $cc_basename in + # old Intel for x86_64 which still supported -KPIC. + ecc*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-static' + ;; + # icc used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + icc* | ifort*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-fPIC' + lt_prog_compiler_static_FC='-static' + ;; + # Lahey Fortran 8.1. + lf95*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='--shared' + lt_prog_compiler_static_FC='--static' + ;; + pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group compilers (*not* the Pentium gcc compiler, + # which looks to be a dead project) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-fpic' + lt_prog_compiler_static_FC='-Bstatic' + ;; + ccc*) + lt_prog_compiler_wl_FC='-Wl,' + # All Alpha code is PIC. + lt_prog_compiler_static_FC='-non_shared' + ;; + xl* | bgxl* | bgf* | mpixl*) + # IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-qpic' + lt_prog_compiler_static_FC='-qstaticlink' + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ F* | *Sun*Fortran*) + # Sun Fortran 8.3 passes all unrecognized flags to the linker + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + lt_prog_compiler_wl_FC='' + ;; + *Sun\ C*) + # Sun C 5.9 + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + lt_prog_compiler_wl_FC='-Wl,' + ;; + esac + ;; + esac + ;; + + newsos6) + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic_FC='-fPIC -shared' + ;; + + osf3* | osf4* | osf5*) + lt_prog_compiler_wl_FC='-Wl,' + # All OSF/1 code is PIC. + lt_prog_compiler_static_FC='-non_shared' + ;; + + rdos*) + lt_prog_compiler_static_FC='-non_shared' + ;; + + solaris*) + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + case $cc_basename in + f77* | f90* | f95*) + lt_prog_compiler_wl_FC='-Qoption ld ';; + *) + lt_prog_compiler_wl_FC='-Wl,';; + esac + ;; + + sunos4*) + lt_prog_compiler_wl_FC='-Qoption ld ' + lt_prog_compiler_pic_FC='-PIC' + lt_prog_compiler_static_FC='-Bstatic' + ;; + + sysv4 | sysv4.2uw2* | sysv4.3*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + ;; + + sysv4*MP*) + if test -d /usr/nec ;then + lt_prog_compiler_pic_FC='-Kconform_pic' + lt_prog_compiler_static_FC='-Bstatic' + fi + ;; + + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_pic_FC='-KPIC' + lt_prog_compiler_static_FC='-Bstatic' + ;; + + unicos*) + lt_prog_compiler_wl_FC='-Wl,' + lt_prog_compiler_can_build_shared_FC=no + ;; + + uts4*) + lt_prog_compiler_pic_FC='-pic' + lt_prog_compiler_static_FC='-Bstatic' + ;; + + *) + lt_prog_compiler_can_build_shared_FC=no + ;; + esac + fi + +case $host_os in + # For platforms which do not support PIC, -DPIC is meaningless: + *djgpp*) + lt_prog_compiler_pic_FC= + ;; + *) + lt_prog_compiler_pic_FC="$lt_prog_compiler_pic_FC" + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_prog_compiler_pic_FC" >&5 +$as_echo "$lt_prog_compiler_pic_FC" >&6; } + + + +# +# Check to make sure the PIC flag actually works. +# +if test -n "$lt_prog_compiler_pic_FC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic_FC works" >&5 +$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic_FC works... " >&6; } +if test "${lt_cv_prog_compiler_pic_works_FC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_works_FC=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="$lt_prog_compiler_pic_FC" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_pic_works_FC=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works_FC" >&5 +$as_echo "$lt_cv_prog_compiler_pic_works_FC" >&6; } + +if test x"$lt_cv_prog_compiler_pic_works_FC" = xyes; then + case $lt_prog_compiler_pic_FC in + "" | " "*) ;; + *) lt_prog_compiler_pic_FC=" $lt_prog_compiler_pic_FC" ;; + esac +else + lt_prog_compiler_pic_FC= + lt_prog_compiler_can_build_shared_FC=no +fi + +fi + + + +# +# Check to make sure the static flag actually works. +# +wl=$lt_prog_compiler_wl_FC eval lt_tmp_static_flag=\"$lt_prog_compiler_static_FC\" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 +$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } +if test "${lt_cv_prog_compiler_static_works_FC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_static_works_FC=no + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS $lt_tmp_static_flag" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_static_works_FC=yes + fi + else + lt_cv_prog_compiler_static_works_FC=yes + fi + fi + $RM -r conftest* + LDFLAGS="$save_LDFLAGS" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works_FC" >&5 +$as_echo "$lt_cv_prog_compiler_static_works_FC" >&6; } + +if test x"$lt_cv_prog_compiler_static_works_FC" = xyes; then + : +else + lt_prog_compiler_static_FC= +fi + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if test "${lt_cv_prog_compiler_c_o_FC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_FC=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_FC=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_FC" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_FC" >&6; } + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if test "${lt_cv_prog_compiler_c_o_FC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o_FC=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o_FC=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_FC" >&5 +$as_echo "$lt_cv_prog_compiler_c_o_FC" >&6; } + + + + +hard_links="nottested" +if test "$lt_cv_prog_compiler_c_o_FC" = no && test "$need_locks" != no; then + # do not overwrite the value of need_locks provided by the user + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 +$as_echo_n "checking if we can lock with hard links... " >&6; } + hard_links=yes + $RM conftest* + ln conftest.a conftest.b 2>/dev/null && hard_links=no + touch conftest.a + ln conftest.a conftest.b 2>&5 || hard_links=no + ln conftest.a conftest.b 2>/dev/null && hard_links=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 +$as_echo "$hard_links" >&6; } + if test "$hard_links" = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5 +$as_echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;} + need_locks=warn + fi +else + need_locks=no +fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + + runpath_var= + allow_undefined_flag_FC= + always_export_symbols_FC=no + archive_cmds_FC= + archive_expsym_cmds_FC= + compiler_needs_object_FC=no + enable_shared_with_static_runtimes_FC=no + export_dynamic_flag_spec_FC= + export_symbols_cmds_FC='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + hardcode_automatic_FC=no + hardcode_direct_FC=no + hardcode_direct_absolute_FC=no + hardcode_libdir_flag_spec_FC= + hardcode_libdir_flag_spec_ld_FC= + hardcode_libdir_separator_FC= + hardcode_minus_L_FC=no + hardcode_shlibpath_var_FC=unsupported + inherit_rpath_FC=no + link_all_deplibs_FC=unknown + module_cmds_FC= + module_expsym_cmds_FC= + old_archive_from_new_cmds_FC= + old_archive_from_expsyms_cmds_FC= + thread_safe_flag_spec_FC= + whole_archive_flag_spec_FC= + # include_expsyms should be a list of space-separated symbols to be *always* + # included in the symbol list + include_expsyms_FC= + # exclude_expsyms can be an extended regexp of symbols to exclude + # it will be wrapped by ` (' and `)$', so one must not match beginning or + # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc', + # as well as any symbol that contains `d'. + exclude_expsyms_FC='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' + # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out + # platforms (ab)use it in PIC code, but their linkers get confused if + # the symbol is explicitly referenced. Since portable code cannot + # rely on this symbol name, it's probably fine to never include it in + # preloaded symbol tables. + # Exclude shared library initialization/finalization symbols. + extract_expsyms_cmds= + + case $host_os in + cygwin* | mingw* | pw32* | cegcc*) + # FIXME: the MSVC++ port hasn't been tested in a loooong time + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + if test "$GCC" != yes; then + with_gnu_ld=no + fi + ;; + interix*) + # we just hope/assume this is gcc and not c89 (= MSVC++) + with_gnu_ld=yes + ;; + openbsd*) + with_gnu_ld=no + ;; + esac + + ld_shlibs_FC=yes + + # On some targets, GNU ld is compatible enough with the native linker + # that we're better off using the native interface for both. + lt_use_gnu_ld_interface=no + if test "$with_gnu_ld" = yes; then + case $host_os in + aix*) + # The AIX port of GNU ld has always aspired to compatibility + # with the native linker. However, as the warning in the GNU ld + # block says, versions before 2.19.5* couldn't really create working + # shared libraries, regardless of the interface used. + case `$LD -v 2>&1` in + *\ \(GNU\ Binutils\)\ 2.19.5*) ;; + *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;; + *\ \(GNU\ Binutils\)\ [3-9]*) ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + fi + + if test "$lt_use_gnu_ld_interface" = yes; then + # If archive_cmds runs LD, not CC, wlarc should be empty + wlarc='${wl}' + + # Set some defaults for GNU ld with shared library support. These + # are reset later if shared libraries are not supported. Putting them + # here allows them to be overridden if necessary. + runpath_var=LD_RUN_PATH + hardcode_libdir_flag_spec_FC='${wl}-rpath ${wl}$libdir' + export_dynamic_flag_spec_FC='${wl}--export-dynamic' + # ancient GNU ld didn't support --whole-archive et. al. + if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then + whole_archive_flag_spec_FC="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive' + else + whole_archive_flag_spec_FC= + fi + supports_anon_versioning=no + case `$LD -v 2>&1` in + *GNU\ gold*) supports_anon_versioning=yes ;; + *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 + *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... + *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... + *\ 2.11.*) ;; # other 2.11 versions + *) supports_anon_versioning=yes ;; + esac + + # See if GNU ld supports shared libraries. + case $host_os in + aix[3-9]*) + # On AIX/PPC, the GNU linker is very broken + if test "$host_cpu" != ia64; then + ld_shlibs_FC=no + cat <<_LT_EOF 1>&2 + +*** Warning: the GNU linker, at least up to release 2.19, is reported +*** to be unable to reliably create shared libraries on AIX. +*** Therefore, libtool is disabling shared libraries support. If you +*** really care for shared libraries, you may want to install binutils +*** 2.20 or above, or modify your PATH so that a non-GNU linker is found. +*** You will then need to restart the configuration process. + +_LT_EOF + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='' + ;; + m68k) + archive_cmds_FC='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_minus_L_FC=yes + ;; + esac + ;; + + beos*) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + allow_undefined_flag_FC=unsupported + # Joseph Beckenbach says some releases of gcc + # support --undefined. This deserves some investigation. FIXME + archive_cmds_FC='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + else + ld_shlibs_FC=no + fi + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # _LT_TAGVAR(hardcode_libdir_flag_spec, FC) is actually meaningless, + # as there is no search path for DLLs. + hardcode_libdir_flag_spec_FC='-L$libdir' + export_dynamic_flag_spec_FC='${wl}--export-all-symbols' + allow_undefined_flag_FC=unsupported + always_export_symbols_FC=no + enable_shared_with_static_runtimes_FC=yes + export_symbols_cmds_FC='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols' + + if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + # If the export-symbols file already is a .def file (1st line + # is EXPORTS), use it as is; otherwise, prepend... + archive_expsym_cmds_FC='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then + cp $export_symbols $output_objdir/$soname.def; + else + echo EXPORTS > $output_objdir/$soname.def; + cat $export_symbols >> $output_objdir/$soname.def; + fi~ + $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + else + ld_shlibs_FC=no + fi + ;; + + haiku*) + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + link_all_deplibs_FC=yes + ;; + + interix[3-9]*) + hardcode_direct_FC=no + hardcode_shlibpath_var_FC=no + hardcode_libdir_flag_spec_FC='${wl}-rpath,$libdir' + export_dynamic_flag_spec_FC='${wl}-E' + # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. + # Instead, shared libraries are loaded at an image base (0x10000000 by + # default) and relocated if they conflict, which is a slow very memory + # consuming and fragmenting process. To avoid this, we pick a random, + # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link + # time. Moving up from 0x10000000 also allows more sbrk(2) space. + archive_cmds_FC='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + archive_expsym_cmds_FC='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + ;; + + gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) + tmp_diet=no + if test "$host_os" = linux-dietlibc; then + case $cc_basename in + diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn) + esac + fi + if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \ + && test "$tmp_diet" = no + then + tmp_addflag= + tmp_sharedflag='-shared' + case $cc_basename,$host_cpu in + pgcc*) # Portland Group C compiler + whole_archive_flag_spec_FC='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + tmp_addflag=' $pic_flag' + ;; + pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group f77 and f90 compilers + whole_archive_flag_spec_FC='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + tmp_addflag=' $pic_flag -Mnomain' ;; + ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 + tmp_addflag=' -i_dynamic' ;; + efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 + tmp_addflag=' -i_dynamic -nofor_main' ;; + ifc* | ifort*) # Intel Fortran compiler + tmp_addflag=' -nofor_main' ;; + lf95*) # Lahey Fortran 8.1 + whole_archive_flag_spec_FC= + tmp_sharedflag='--shared' ;; + xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) + tmp_sharedflag='-qmkshrobj' + tmp_addflag= ;; + nvcc*) # Cuda Compiler Driver 2.2 + whole_archive_flag_spec_FC='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + compiler_needs_object_FC=yes + ;; + esac + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) # Sun C 5.9 + whole_archive_flag_spec_FC='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + compiler_needs_object_FC=yes + tmp_sharedflag='-G' ;; + *Sun\ F*) # Sun Fortran 8.3 + tmp_sharedflag='-G' ;; + esac + archive_cmds_FC='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + + if test "x$supports_anon_versioning" = xyes; then + archive_expsym_cmds_FC='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib' + fi + + case $cc_basename in + xlf* | bgf* | bgxlf* | mpixlf*) + # IBM XL Fortran 10.1 on PPC cannot create shared libs itself + whole_archive_flag_spec_FC='--whole-archive$convenience --no-whole-archive' + hardcode_libdir_flag_spec_FC= + hardcode_libdir_flag_spec_ld_FC='-rpath $libdir' + archive_cmds_FC='$LD -shared $libobjs $deplibs $compiler_flags -soname $soname -o $lib' + if test "x$supports_anon_versioning" = xyes; then + archive_expsym_cmds_FC='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $LD -shared $libobjs $deplibs $compiler_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' + fi + ;; + esac + else + ld_shlibs_FC=no + fi + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds_FC='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' + wlarc= + else + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + fi + ;; + + solaris*) + if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then + ld_shlibs_FC=no + cat <<_LT_EOF 1>&2 + +*** Warning: The releases 2.8.* of the GNU linker cannot reliably +*** create shared libraries on Solaris systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.9.1 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_FC=no + fi + ;; + + sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) + case `$LD -v 2>&1` in + *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) + ld_shlibs_FC=no + cat <<_LT_EOF 1>&2 + +*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not +*** reliably create shared libraries on SCO systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.16.91.0.3 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + ;; + *) + # For security reasons, it is highly recommended that you always + # use absolute paths for naming shared libraries, and exclude the + # DT_RUNPATH tag from executables and libraries. But doing so + # requires that you compile everything twice, which is a pain. + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + hardcode_libdir_flag_spec_FC='${wl}-rpath ${wl}$libdir' + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_FC=no + fi + ;; + esac + ;; + + sunos4*) + archive_cmds_FC='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' + wlarc= + hardcode_direct_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + *) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs_FC=no + fi + ;; + esac + + if test "$ld_shlibs_FC" = no; then + runpath_var= + hardcode_libdir_flag_spec_FC= + export_dynamic_flag_spec_FC= + whole_archive_flag_spec_FC= + fi + else + # PORTME fill in a description of your system's linker (not GNU ld) + case $host_os in + aix3*) + allow_undefined_flag_FC=unsupported + always_export_symbols_FC=yes + archive_expsym_cmds_FC='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' + # Note: this linker hardcodes the directories in LIBPATH if there + # are no directories specified by -L. + hardcode_minus_L_FC=yes + if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then + # Neither direct hardcoding nor static linking is supported with a + # broken collect2. + hardcode_direct_FC=unsupported + fi + ;; + + aix[4-9]*) + if test "$host_cpu" = ia64; then + # On IA64, the linker does run time linking by default, so we don't + # have to do anything special. + aix_use_runtimelinking=no + exp_sym_flag='-Bexport' + no_entry_flag="" + else + # If we're using GNU nm, then we don't want the "-C" option. + # -C means demangle to AIX nm, but means don't demangle with GNU nm + # Also, AIX nm treats weak defined symbols like other global + # defined symbols, whereas GNU nm marks them as "W". + if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then + export_symbols_cmds_FC='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols' + else + export_symbols_cmds_FC='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols' + fi + aix_use_runtimelinking=no + + # Test if we are trying to use run time linking or normal + # AIX style linking. If -brtl is somewhere in LDFLAGS, we + # need to do runtime linking. + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) + for ld_flag in $LDFLAGS; do + if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then + aix_use_runtimelinking=yes + break + fi + done + ;; + esac + + exp_sym_flag='-bexport' + no_entry_flag='-bnoentry' + fi + + # When large executables or shared objects are built, AIX ld can + # have problems creating the table of contents. If linking a library + # or program results in "error TOC overflow" add -mminimal-toc to + # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not + # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. + + archive_cmds_FC='' + hardcode_direct_FC=yes + hardcode_direct_absolute_FC=yes + hardcode_libdir_separator_FC=':' + link_all_deplibs_FC=yes + file_list_spec_FC='${wl}-f,' + + if test "$GCC" = yes; then + case $host_os in aix4.[012]|aix4.[012].*) + # We only want to do this on AIX 4.2 and lower, the check + # below for broken collect2 doesn't work under 4.3+ + collect2name=`${CC} -print-prog-name=collect2` + if test -f "$collect2name" && + strings "$collect2name" | $GREP resolve_lib_name >/dev/null + then + # We have reworked collect2 + : + else + # We have old collect2 + hardcode_direct_FC=unsupported + # It fails to find uninstalled libraries when the uninstalled + # path is not listed in the libpath. Setting hardcode_minus_L + # to unsupported forces relinking + hardcode_minus_L_FC=yes + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_libdir_separator_FC= + fi + ;; + esac + shared_flag='-shared' + if test "$aix_use_runtimelinking" = yes; then + shared_flag="$shared_flag "'${wl}-G' + fi + else + # not using gcc + if test "$host_cpu" = ia64; then + # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release + # chokes on -Wl,-G. The following line is correct: + shared_flag='-G' + else + if test "$aix_use_runtimelinking" = yes; then + shared_flag='${wl}-G' + else + shared_flag='${wl}-bM:SRE' + fi + fi + fi + + export_dynamic_flag_spec_FC='${wl}-bexpall' + # It seems that -bexpall does not export symbols beginning with + # underscore (_), so it is better to generate a list of symbols to export. + always_export_symbols_FC=yes + if test "$aix_use_runtimelinking" = yes; then + # Warning - without using the other runtime loading flags (-brtl), + # -berok will link without error, but may produce a broken library. + allow_undefined_flag_FC='-berok' + # Determine the default libpath from the value encoded in an + # empty executable. + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + +lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\(.*\)$/\1/ + p + } + }' +aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +# Check for a 64-bit object if we didn't find anything. +if test -z "$aix_libpath"; then + aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi + + hardcode_libdir_flag_spec_FC='${wl}-blibpath:$libdir:'"$aix_libpath" + archive_expsym_cmds_FC='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then func_echo_all "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag" + else + if test "$host_cpu" = ia64; then + hardcode_libdir_flag_spec_FC='${wl}-R $libdir:/usr/lib:/lib' + allow_undefined_flag_FC="-z nodefs" + archive_expsym_cmds_FC="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols" + else + # Determine the default libpath from the value encoded in an + # empty executable. + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + +lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\(.*\)$/\1/ + p + } + }' +aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +# Check for a 64-bit object if we didn't find anything. +if test -z "$aix_libpath"; then + aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi + + hardcode_libdir_flag_spec_FC='${wl}-blibpath:$libdir:'"$aix_libpath" + # Warning - without using the other run time loading flags, + # -berok will link without error, but may produce a broken library. + no_undefined_flag_FC=' ${wl}-bernotok' + allow_undefined_flag_FC=' ${wl}-berok' + if test "$with_gnu_ld" = yes; then + # We only use this code for GNU lds that support --whole-archive. + whole_archive_flag_spec_FC='${wl}--whole-archive$convenience ${wl}--no-whole-archive' + else + # Exported symbols can be pulled into shared objects from archives + whole_archive_flag_spec_FC='$convenience' + fi + archive_cmds_need_lc_FC=yes + # This is similar to how AIX traditionally builds its shared libraries. + archive_expsym_cmds_FC="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname' + fi + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds_FC='' + ;; + m68k) + archive_cmds_FC='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_minus_L_FC=yes + ;; + esac + ;; + + bsdi[45]*) + export_dynamic_flag_spec_FC=-rdynamic + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + # hardcode_libdir_flag_spec is actually meaningless, as there is + # no search path for DLLs. + hardcode_libdir_flag_spec_FC=' ' + allow_undefined_flag_FC=unsupported + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=".dll" + # FIXME: Setting linknames here is a bad hack. + archive_cmds_FC='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames=' + # The linker will automatically build a .lib file if we build a DLL. + old_archive_from_new_cmds_FC='true' + # FIXME: Should let the user specify the lib program. + old_archive_cmds_FC='lib -OUT:$oldlib$oldobjs$old_deplibs' + fix_srcfile_path_FC='`cygpath -w "$srcfile"`' + enable_shared_with_static_runtimes_FC=yes + ;; + + darwin* | rhapsody*) + + + archive_cmds_need_lc_FC=no + hardcode_direct_FC=no + hardcode_automatic_FC=yes + hardcode_shlibpath_var_FC=unsupported + if test "$lt_cv_ld_force_load" = "yes"; then + whole_archive_flag_spec_FC='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience ${wl}-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' + else + whole_archive_flag_spec_FC='' + fi + link_all_deplibs_FC=yes + allow_undefined_flag_FC="$_lt_dar_allow_undefined" + case $cc_basename in + ifort*) _lt_dar_can_shared=yes ;; + *) _lt_dar_can_shared=$GCC ;; + esac + if test "$_lt_dar_can_shared" = "yes"; then + output_verbose_link_cmd=func_echo_all + archive_cmds_FC="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod${_lt_dsymutil}" + module_cmds_FC="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}" + archive_expsym_cmds_FC="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring ${_lt_dar_single_mod}${_lt_dar_export_syms}${_lt_dsymutil}" + module_expsym_cmds_FC="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}" + + else + ld_shlibs_FC=no + fi + + ;; + + dgux*) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_shlibpath_var_FC=no + ;; + + # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor + # support. Future versions do this automatically, but an explicit c++rt0.o + # does not break anything, and helps significantly (at the cost of a little + # extra space). + freebsd2.2*) + archive_cmds_FC='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' + hardcode_libdir_flag_spec_FC='-R$libdir' + hardcode_direct_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + # Unfortunately, older versions of FreeBSD 2 do not have this feature. + freebsd2.*) + archive_cmds_FC='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_FC=yes + hardcode_minus_L_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + # FreeBSD 3 and greater uses gcc -shared to do shared libraries. + freebsd* | dragonfly*) + archive_cmds_FC='$CC -shared -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec_FC='-R$libdir' + hardcode_direct_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + hpux9*) + if test "$GCC" = yes; then + archive_cmds_FC='$RM $output_objdir/$soname~$CC -shared -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' + else + archive_cmds_FC='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' + fi + hardcode_libdir_flag_spec_FC='${wl}+b ${wl}$libdir' + hardcode_libdir_separator_FC=: + hardcode_direct_FC=yes + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_FC=yes + export_dynamic_flag_spec_FC='${wl}-E' + ;; + + hpux10*) + if test "$GCC" = yes && test "$with_gnu_ld" = no; then + archive_cmds_FC='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_FC='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' + fi + if test "$with_gnu_ld" = no; then + hardcode_libdir_flag_spec_FC='${wl}+b ${wl}$libdir' + hardcode_libdir_flag_spec_ld_FC='+b $libdir' + hardcode_libdir_separator_FC=: + hardcode_direct_FC=yes + hardcode_direct_absolute_FC=yes + export_dynamic_flag_spec_FC='${wl}-E' + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_FC=yes + fi + ;; + + hpux11*) + if test "$GCC" = yes && test "$with_gnu_ld" = no; then + case $host_cpu in + hppa*64*) + archive_cmds_FC='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds_FC='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds_FC='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + else + case $host_cpu in + hppa*64*) + archive_cmds_FC='$CC -b ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds_FC='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds_FC='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + fi + if test "$with_gnu_ld" = no; then + hardcode_libdir_flag_spec_FC='${wl}+b ${wl}$libdir' + hardcode_libdir_separator_FC=: + + case $host_cpu in + hppa*64*|ia64*) + hardcode_direct_FC=no + hardcode_shlibpath_var_FC=no + ;; + *) + hardcode_direct_FC=yes + hardcode_direct_absolute_FC=yes + export_dynamic_flag_spec_FC='${wl}-E' + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L_FC=yes + ;; + esac + fi + ;; + + irix5* | irix6* | nonstopux*) + if test "$GCC" = yes; then + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' + # Try to use the -exported_symbol ld option, if it does not + # work, assume that -exports_file does not work either and + # implicitly export all symbols. + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS -shared ${wl}-exported_symbol ${wl}foo ${wl}-update_registry ${wl}/dev/null" + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat > conftest.$ac_ext <<_ACEOF +int foo(void) {} +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + archive_expsym_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations ${wl}-exports_file ${wl}$export_symbols -o $lib' + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS="$save_LDFLAGS" + else + archive_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib' + archive_expsym_cmds_FC='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -exports_file $export_symbols -o $lib' + fi + archive_cmds_need_lc_FC='no' + hardcode_libdir_flag_spec_FC='${wl}-rpath ${wl}$libdir' + hardcode_libdir_separator_FC=: + inherit_rpath_FC=yes + link_all_deplibs_FC=yes + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds_FC='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out + else + archive_cmds_FC='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF + fi + hardcode_libdir_flag_spec_FC='-R$libdir' + hardcode_direct_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + newsos6) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_FC=yes + hardcode_libdir_flag_spec_FC='${wl}-rpath ${wl}$libdir' + hardcode_libdir_separator_FC=: + hardcode_shlibpath_var_FC=no + ;; + + *nto* | *qnx*) + ;; + + openbsd*) + if test -f /usr/libexec/ld.so; then + hardcode_direct_FC=yes + hardcode_shlibpath_var_FC=no + hardcode_direct_absolute_FC=yes + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then + archive_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols' + hardcode_libdir_flag_spec_FC='${wl}-rpath,$libdir' + export_dynamic_flag_spec_FC='${wl}-E' + else + case $host_os in + openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) + archive_cmds_FC='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec_FC='-R$libdir' + ;; + *) + archive_cmds_FC='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec_FC='${wl}-rpath,$libdir' + ;; + esac + fi + else + ld_shlibs_FC=no + fi + ;; + + os2*) + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_minus_L_FC=yes + allow_undefined_flag_FC=unsupported + archive_cmds_FC='$ECHO "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~echo DATA >> $output_objdir/$libname.def~echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def' + old_archive_from_new_cmds_FC='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def' + ;; + + osf3*) + if test "$GCC" = yes; then + allow_undefined_flag_FC=' ${wl}-expect_unresolved ${wl}\*' + archive_cmds_FC='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' + else + allow_undefined_flag_FC=' -expect_unresolved \*' + archive_cmds_FC='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib' + fi + archive_cmds_need_lc_FC='no' + hardcode_libdir_flag_spec_FC='${wl}-rpath ${wl}$libdir' + hardcode_libdir_separator_FC=: + ;; + + osf4* | osf5*) # as osf3* with the addition of -msym flag + if test "$GCC" = yes; then + allow_undefined_flag_FC=' ${wl}-expect_unresolved ${wl}\*' + archive_cmds_FC='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' + hardcode_libdir_flag_spec_FC='${wl}-rpath ${wl}$libdir' + else + allow_undefined_flag_FC=' -expect_unresolved \*' + archive_cmds_FC='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib' + archive_expsym_cmds_FC='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~ + $CC -shared${allow_undefined_flag} ${wl}-input ${wl}$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib~$RM $lib.exp' + + # Both c and cxx compiler support -rpath directly + hardcode_libdir_flag_spec_FC='-rpath $libdir' + fi + archive_cmds_need_lc_FC='no' + hardcode_libdir_separator_FC=: + ;; + + solaris*) + no_undefined_flag_FC=' -z defs' + if test "$GCC" = yes; then + wlarc='${wl}' + archive_cmds_FC='$CC -shared ${wl}-z ${wl}text ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -shared ${wl}-z ${wl}text ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + else + case `$CC -V 2>&1` in + *"Compilers 5.0"*) + wlarc='' + archive_cmds_FC='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags' + archive_expsym_cmds_FC='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp' + ;; + *) + wlarc='${wl}' + archive_cmds_FC='$CC -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + ;; + esac + fi + hardcode_libdir_flag_spec_FC='-R$libdir' + hardcode_shlibpath_var_FC=no + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + # The compiler driver will combine and reorder linker options, + # but understands `-z linker_flag'. GCC discards it without `$wl', + # but is careful enough not to reorder. + # Supported since Solaris 2.6 (maybe 2.5.1?) + if test "$GCC" = yes; then + whole_archive_flag_spec_FC='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract' + else + whole_archive_flag_spec_FC='-z allextract$convenience -z defaultextract' + fi + ;; + esac + link_all_deplibs_FC=yes + ;; + + sunos4*) + if test "x$host_vendor" = xsequent; then + # Use $CC to link under sequent, because it throws in some extra .o + # files that make .init and .fini sections work. + archive_cmds_FC='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_FC='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' + fi + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_direct_FC=yes + hardcode_minus_L_FC=yes + hardcode_shlibpath_var_FC=no + ;; + + sysv4) + case $host_vendor in + sni) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_FC=yes # is this really true??? + ;; + siemens) + ## LD is ld it makes a PLAMLIB + ## CC just makes a GrossModule. + archive_cmds_FC='$LD -G -o $lib $libobjs $deplibs $linker_flags' + reload_cmds_FC='$CC -r -o $output$reload_objs' + hardcode_direct_FC=no + ;; + motorola) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct_FC=no #Motorola manual says yes, but my tests say they lie + ;; + esac + runpath_var='LD_RUN_PATH' + hardcode_shlibpath_var_FC=no + ;; + + sysv4.3*) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var_FC=no + export_dynamic_flag_spec_FC='-Bexport' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var_FC=no + runpath_var=LD_RUN_PATH + hardcode_runpath_var=yes + ld_shlibs_FC=yes + fi + ;; + + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) + no_undefined_flag_FC='${wl}-z,text' + archive_cmds_need_lc_FC=no + hardcode_shlibpath_var_FC=no + runpath_var='LD_RUN_PATH' + + if test "$GCC" = yes; then + archive_cmds_FC='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_FC='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + sysv5* | sco3.2v5* | sco5v6*) + # Note: We can NOT use -z defs as we might desire, because we do not + # link with -lc, and that would cause any symbols used from libc to + # always be unresolved, which means just about no library would + # ever link correctly. If we're not using GNU ld we use -z text + # though, which does catch some bad symbols but isn't as heavy-handed + # as -z defs. + no_undefined_flag_FC='${wl}-z,text' + allow_undefined_flag_FC='${wl}-z,nodefs' + archive_cmds_need_lc_FC=no + hardcode_shlibpath_var_FC=no + hardcode_libdir_flag_spec_FC='${wl}-R,$libdir' + hardcode_libdir_separator_FC=':' + link_all_deplibs_FC=yes + export_dynamic_flag_spec_FC='${wl}-Bexport' + runpath_var='LD_RUN_PATH' + + if test "$GCC" = yes; then + archive_cmds_FC='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds_FC='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds_FC='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + uts4*) + archive_cmds_FC='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec_FC='-L$libdir' + hardcode_shlibpath_var_FC=no + ;; + + *) + ld_shlibs_FC=no + ;; + esac + + if test x$host_vendor = xsni; then + case $host in + sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) + export_dynamic_flag_spec_FC='${wl}-Blargedynsym' + ;; + esac + fi + fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_FC" >&5 +$as_echo "$ld_shlibs_FC" >&6; } +test "$ld_shlibs_FC" = no && can_build_shared=no + +with_gnu_ld_FC=$with_gnu_ld + + + + + + +# +# Do we need to explicitly link libc? +# +case "x$archive_cmds_need_lc_FC" in +x|xyes) + # Assume -lc should be added + archive_cmds_need_lc_FC=yes + + if test "$enable_shared" = yes && test "$GCC" = yes; then + case $archive_cmds_FC in + *'~'*) + # FIXME: we may have to deal with multi-command sequences. + ;; + '$CC '*) + # Test whether the compiler implicitly links with -lc since on some + # systems, -lgcc has to come before -lc. If gcc already passes -lc + # to ld, don't add -lc before -lgcc. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 +$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } +if test "${lt_cv_archive_cmds_need_lc_FC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + $RM conftest* + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } 2>conftest.err; then + soname=conftest + lib=conftest + libobjs=conftest.$ac_objext + deplibs= + wl=$lt_prog_compiler_wl_FC + pic_flag=$lt_prog_compiler_pic_FC + compiler_flags=-v + linker_flags=-v + verstring= + output_objdir=. + libname=conftest + lt_save_allow_undefined_flag=$allow_undefined_flag_FC + allow_undefined_flag_FC= + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds_FC 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 + (eval $archive_cmds_FC 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + then + lt_cv_archive_cmds_need_lc_FC=no + else + lt_cv_archive_cmds_need_lc_FC=yes + fi + allow_undefined_flag_FC=$lt_save_allow_undefined_flag + else + cat conftest.err 1>&5 + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc_FC" >&5 +$as_echo "$lt_cv_archive_cmds_need_lc_FC" >&6; } + archive_cmds_need_lc_FC=$lt_cv_archive_cmds_need_lc_FC + ;; + esac + fi + ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 +$as_echo_n "checking dynamic linker characteristics... " >&6; } + +library_names_spec= +libname_spec='lib$name' +soname_spec= +shrext_cmds=".so" +postinstall_cmds= +postuninstall_cmds= +finish_cmds= +finish_eval= +shlibpath_var= +shlibpath_overrides_runpath=unknown +version_type=none +dynamic_linker="$host_os ld.so" +sys_lib_dlsearch_path_spec="/lib /usr/lib" +need_lib_prefix=unknown +hardcode_into_libs=no + +# when you set need_version to no, make sure it does not cause -set_version +# flags to be left without arguments +need_version=unknown + +case $host_os in +aix3*) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a' + shlibpath_var=LIBPATH + + # AIX 3 has no versioning support, so we append a major version to the name. + soname_spec='${libname}${release}${shared_ext}$major' + ;; + +aix[4-9]*) + version_type=linux + need_lib_prefix=no + need_version=no + hardcode_into_libs=yes + if test "$host_cpu" = ia64; then + # AIX 5 supports IA64 + library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + else + # With GCC up to 2.95.x, collect2 would create an import file + # for dependence libraries. The import file would start with + # the line `#! .'. This would cause the generated library to + # depend on `.', always an invalid library. This was fixed in + # development snapshots of GCC prior to 3.0. + case $host_os in + aix4 | aix4.[01] | aix4.[01].*) + if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' + echo ' yes ' + echo '#endif'; } | ${CC} -E - | $GREP yes > /dev/null; then + : + else + can_build_shared=no + fi + ;; + esac + # AIX (on Power*) has no versioning support, so currently we can not hardcode correct + # soname into executable. Probably we can add versioning support to + # collect2, so additional links can be useful in future. + if test "$aix_use_runtimelinking" = yes; then + # If using run time linking (on AIX 4.2 or later) use lib.so + # instead of lib.a to let people know that these are not + # typical AIX shared libraries. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + else + # We preserve .a as extension for shared libraries through AIX4.2 + # and later when we are not doing run time linking. + library_names_spec='${libname}${release}.a $libname.a' + soname_spec='${libname}${release}${shared_ext}$major' + fi + shlibpath_var=LIBPATH + fi + ;; + +amigaos*) + case $host_cpu in + powerpc) + # Since July 2007 AmigaOS4 officially supports .so libraries. + # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + ;; + m68k) + library_names_spec='$libname.ixlibrary $libname.a' + # Create ${libname}_ixlibrary.a entries in /sys/libs. + finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' + ;; + esac + ;; + +beos*) + library_names_spec='${libname}${shared_ext}' + dynamic_linker="$host_os ld.so" + shlibpath_var=LIBRARY_PATH + ;; + +bsdi[45]*) + version_type=linux + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" + sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" + # the default ld.so.conf also contains /usr/contrib/lib and + # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow + # libtool to hard-code these into programs + ;; + +cygwin* | mingw* | pw32* | cegcc*) + version_type=windows + shrext_cmds=".dll" + need_version=no + need_lib_prefix=no + + case $GCC,$host_os in + yes,cygwin* | yes,mingw* | yes,pw32* | yes,cegcc*) + library_names_spec='$libname.dll.a' + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \${file}`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + + case $host_os in + cygwin*) + # Cygwin DLLs use 'cyg' prefix rather than 'lib' + soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' + + ;; + mingw* | cegcc*) + # MinGW DLLs use traditional 'lib' prefix + soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' + ;; + pw32*) + # pw32 DLLs use 'pw' prefix rather than 'lib' + library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' + ;; + esac + ;; + + *) + library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib' + ;; + esac + dynamic_linker='Win32 ld.exe' + # FIXME: first we should search . and the directory the executable is in + shlibpath_var=PATH + ;; + +darwin* | rhapsody*) + dynamic_linker="$host_os dyld" + version_type=darwin + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${major}$shared_ext ${libname}$shared_ext' + soname_spec='${libname}${release}${major}$shared_ext' + shlibpath_overrides_runpath=yes + shlibpath_var=DYLD_LIBRARY_PATH + shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' + + sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' + ;; + +dgux*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +freebsd* | dragonfly*) + # DragonFly does not have aout. When/if they implement a new + # versioning mechanism, adjust this. + if test -x /usr/bin/objformat; then + objformat=`/usr/bin/objformat` + else + case $host_os in + freebsd[23].*) objformat=aout ;; + *) objformat=elf ;; + esac + fi + version_type=freebsd-$objformat + case $version_type in + freebsd-elf*) + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' + need_version=no + need_lib_prefix=no + ;; + freebsd-*) + library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix' + need_version=yes + ;; + esac + shlibpath_var=LD_LIBRARY_PATH + case $host_os in + freebsd2.*) + shlibpath_overrides_runpath=yes + ;; + freebsd3.[01]* | freebsdelf3.[01]*) + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ + freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + *) # from 4.6 on, and DragonFly + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + esac + ;; + +gnu*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + hardcode_into_libs=yes + ;; + +haiku*) + version_type=linux + need_lib_prefix=no + need_version=no + dynamic_linker="$host_os runtime_loader" + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LIBRARY_PATH + shlibpath_overrides_runpath=yes + sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/beos/system/lib' + hardcode_into_libs=yes + ;; + +hpux9* | hpux10* | hpux11*) + # Give a soname corresponding to the major version so that dld.sl refuses to + # link against other versions. + version_type=sunos + need_lib_prefix=no + need_version=no + case $host_cpu in + ia64*) + shrext_cmds='.so' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.so" + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + if test "X$HPUX_IA64_MODE" = X32; then + sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" + else + sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" + fi + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + hppa*64*) + shrext_cmds='.sl' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.sl" + shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + *) + shrext_cmds='.sl' + dynamic_linker="$host_os dld.sl" + shlibpath_var=SHLIB_PATH + shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + ;; + esac + # HP-UX runs *really* slowly unless shared libraries are mode 555, ... + postinstall_cmds='chmod 555 $lib' + # or fails outright, so override atomically: + install_override_mode=555 + ;; + +interix[3-9]*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +irix5* | irix6* | nonstopux*) + case $host_os in + nonstopux*) version_type=nonstopux ;; + *) + if test "$lt_cv_prog_gnu_ld" = yes; then + version_type=linux + else + version_type=irix + fi ;; + esac + need_lib_prefix=no + need_version=no + soname_spec='${libname}${release}${shared_ext}$major' + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}' + case $host_os in + irix5* | nonstopux*) + libsuff= shlibsuff= + ;; + *) + case $LD in # libtool.m4 will add one of these switches to LD + *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") + libsuff= shlibsuff= libmagic=32-bit;; + *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") + libsuff=32 shlibsuff=N32 libmagic=N32;; + *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") + libsuff=64 shlibsuff=64 libmagic=64-bit;; + *) libsuff= shlibsuff= libmagic=never-match;; + esac + ;; + esac + shlibpath_var=LD_LIBRARY${shlibsuff}_PATH + shlibpath_overrides_runpath=no + sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}" + sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}" + hardcode_into_libs=yes + ;; + +# No shared lib support for Linux oldld, aout, or coff. +linux*oldld* | linux*aout* | linux*coff*) + dynamic_linker=no + ;; + +# This must be Linux ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + + # Some binutils ld are patched to set DT_RUNPATH + if test "${lt_cv_shlibpath_overrides_runpath+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_shlibpath_overrides_runpath=no + save_LDFLAGS=$LDFLAGS + save_libdir=$libdir + eval "libdir=/foo; wl=\"$lt_prog_compiler_wl_FC\"; \ + LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec_FC\"" + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat > conftest.$ac_ext <<_ACEOF + program main + + end +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : + lt_cv_shlibpath_overrides_runpath=yes +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + libdir=$save_libdir + +fi + + shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + # Append ld.so.conf contents to the search path + if test -f /etc/ld.so.conf; then + lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` + sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" + fi + + # We used to test for /lib/ld.so.1 and disable shared libraries on + # powerpc, because MkLinux only supported shared libraries with the + # GNU dynamic linker. Since this was broken with cross compilers, + # most powerpc-linux boxes support dynamic linking these days and + # people can always --disable-shared, the test was removed, and we + # assume the GNU/Linux dynamic linker is in use. + dynamic_linker='GNU/Linux ld.so' + ;; + +netbsd*) + version_type=sunos + need_lib_prefix=no + need_version=no + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + dynamic_linker='NetBSD (a.out) ld.so' + else + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + dynamic_linker='NetBSD ld.elf_so' + fi + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + +newsos6) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +*nto* | *qnx*) + version_type=qnx + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + dynamic_linker='ldqnx.so' + ;; + +openbsd*) + version_type=sunos + sys_lib_dlsearch_path_spec="/usr/lib" + need_lib_prefix=no + # Some older versions of OpenBSD (3.3 at least) *do* need versioned libs. + case $host_os in + openbsd3.3 | openbsd3.3.*) need_version=yes ;; + *) need_version=no ;; + esac + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + shlibpath_var=LD_LIBRARY_PATH + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then + case $host_os in + openbsd2.[89] | openbsd2.[89].*) + shlibpath_overrides_runpath=no + ;; + *) + shlibpath_overrides_runpath=yes + ;; + esac + else + shlibpath_overrides_runpath=yes + fi + ;; + +os2*) + libname_spec='$name' + shrext_cmds=".dll" + need_lib_prefix=no + library_names_spec='$libname${shared_ext} $libname.a' + dynamic_linker='OS/2 ld.exe' + shlibpath_var=LIBPATH + ;; + +osf3* | osf4* | osf5*) + version_type=osf + need_lib_prefix=no + need_version=no + soname_spec='${libname}${release}${shared_ext}$major' + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" + sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec" + ;; + +rdos*) + dynamic_linker=no + ;; + +solaris*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + # ldd complains unless libraries are executable + postinstall_cmds='chmod +x $lib' + ;; + +sunos4*) + version_type=sunos + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' + finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + if test "$with_gnu_ld" = yes; then + need_lib_prefix=no + fi + need_version=yes + ;; + +sysv4 | sysv4.3*) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + case $host_vendor in + sni) + shlibpath_overrides_runpath=no + need_lib_prefix=no + runpath_var=LD_RUN_PATH + ;; + siemens) + need_lib_prefix=no + ;; + motorola) + need_lib_prefix=no + need_version=no + shlibpath_overrides_runpath=no + sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' + ;; + esac + ;; + +sysv4*MP*) + if test -d /usr/nec ;then + version_type=linux + library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}' + soname_spec='$libname${shared_ext}.$major' + shlibpath_var=LD_LIBRARY_PATH + fi + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + version_type=freebsd-elf + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + if test "$with_gnu_ld" = yes; then + sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' + else + sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' + case $host_os in + sco3.2v5*) + sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" + ;; + esac + fi + sys_lib_dlsearch_path_spec='/usr/lib' + ;; + +tpf*) + # TPF is a cross-target only. Preferred cross-host = GNU/Linux. + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +uts4*) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +*) + dynamic_linker=no + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 +$as_echo "$dynamic_linker" >&6; } +test "$dynamic_linker" = no && can_build_shared=no + +variables_saved_for_relink="PATH $shlibpath_var $runpath_var" +if test "$GCC" = yes; then + variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" +fi + +if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then + sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec" +fi +if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then + sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec" +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 +$as_echo_n "checking how to hardcode library paths into programs... " >&6; } +hardcode_action_FC= +if test -n "$hardcode_libdir_flag_spec_FC" || + test -n "$runpath_var_FC" || + test "X$hardcode_automatic_FC" = "Xyes" ; then + + # We can hardcode non-existent directories. + if test "$hardcode_direct_FC" != no && + # If the only mechanism to avoid hardcoding is shlibpath_var, we + # have to relink, otherwise we might link with an installed library + # when we should be linking with a yet-to-be-installed one + ## test "$_LT_TAGVAR(hardcode_shlibpath_var, FC)" != no && + test "$hardcode_minus_L_FC" != no; then + # Linking always hardcodes the temporary library directory. + hardcode_action_FC=relink + else + # We can link without hardcoding, and we can hardcode nonexisting dirs. + hardcode_action_FC=immediate + fi +else + # We cannot hardcode anything, or else we can only hardcode existing + # directories. + hardcode_action_FC=unsupported +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action_FC" >&5 +$as_echo "$hardcode_action_FC" >&6; } + +if test "$hardcode_action_FC" = relink || + test "$inherit_rpath_FC" = yes; then + # Fast installation is not supported + enable_fast_install=no +elif test "$shlibpath_overrides_runpath" = yes || + test "$enable_shared" = no; then + # Fast installation is not necessary + enable_fast_install=needless +fi + + + + + + + + fi # test -n "$compiler" + + GCC=$lt_save_GCC + CC="$lt_save_CC" +fi # test "$_lt_disable_FC" != yes + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +# extra LD Flags which are required for targets +case "${host}" in + *-darwin*) + # Darwin needs -single_module when linking libgfortran + extra_ldflags_libgfortran=-Wl,-single_module + ;; +esac + + +# We need a working compiler at that point, otherwise give a clear +# error message and bail out. + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the GNU Fortran compiler is working" >&5 +$as_echo_n "checking whether the GNU Fortran compiler is working... " >&6; } +ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + +cat > conftest.$ac_ext <<_ACEOF + + program foo + real, parameter :: bar = sin (12.34 / 2.5) + end program foo +_ACEOF +if ac_fn_fc_try_compile "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + as_fn_error "GNU Fortran is not working; please report a bug in http://gcc.gnu.org/bugzilla, attaching $PWD/config.log" "$LINENO" 5 + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +# Check whether --enable-largefile was given. +if test "${enable_largefile+set}" = set; then : + enableval=$enable_largefile; +fi + +if test "$enable_largefile" != no; then + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5 +$as_echo_n "checking for special C compiler options needed for large files... " >&6; } +if test "${ac_cv_sys_largefile_CC+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_sys_largefile_CC=no + if test "$GCC" != yes; then + ac_save_CC=$CC + while :; do + # IRIX 6.2 and later do not support large files by default, + # so use the C compiler's -n32 option if that helps. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF + if ac_fn_c_try_compile "$LINENO"; then : + break +fi +rm -f core conftest.err conftest.$ac_objext + CC="$CC -n32" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_largefile_CC=' -n32'; break +fi +rm -f core conftest.err conftest.$ac_objext + break + done + CC=$ac_save_CC + rm -f conftest.$ac_ext + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_CC" >&5 +$as_echo "$ac_cv_sys_largefile_CC" >&6; } + if test "$ac_cv_sys_largefile_CC" != no; then + CC=$CC$ac_cv_sys_largefile_CC + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5 +$as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; } +if test "${ac_cv_sys_file_offset_bits+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_file_offset_bits=no; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _FILE_OFFSET_BITS 64 +#include + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_file_offset_bits=64; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cv_sys_file_offset_bits=unknown + break +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_file_offset_bits" >&5 +$as_echo "$ac_cv_sys_file_offset_bits" >&6; } +case $ac_cv_sys_file_offset_bits in #( + no | unknown) ;; + *) +cat >>confdefs.h <<_ACEOF +#define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits +_ACEOF +;; +esac +rm -rf conftest* + if test $ac_cv_sys_file_offset_bits = unknown; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5 +$as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; } +if test "${ac_cv_sys_large_files+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_large_files=no; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _LARGE_FILES 1 +#include + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_large_files=1; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cv_sys_large_files=unknown + break +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_large_files" >&5 +$as_echo "$ac_cv_sys_large_files" >&6; } +case $ac_cv_sys_large_files in #( + no | unknown) ;; + *) +cat >>confdefs.h <<_ACEOF +#define _LARGE_FILES $ac_cv_sys_large_files +_ACEOF +;; +esac +rm -rf conftest* + fi +fi + +ac_fn_c_check_type "$LINENO" "off_t" "ac_cv_type_off_t" "$ac_includes_default" +if test "x$ac_cv_type_off_t" = x""yes; then : + +else + +cat >>confdefs.h <<_ACEOF +#define off_t long int +_ACEOF + +fi + + +# check header files +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if test "${ac_cv_header_stdc+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5 +$as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; } +if test "${ac_cv_header_time+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include + +int +main () +{ +if ((struct tm *) 0) +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_time=yes +else + ac_cv_header_time=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_time" >&5 +$as_echo "$ac_cv_header_time" >&6; } +if test $ac_cv_header_time = yes; then + +$as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h + +fi + +for ac_header in stdio.h stdlib.h string.h unistd.h signal.h stdarg.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +eval as_val=\$$as_ac_Header + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + +for ac_header in time.h sys/time.h sys/times.h sys/resource.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +eval as_val=\$$as_ac_Header + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + +for ac_header in sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +eval as_val=\$$as_ac_Header + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + +for ac_header in fenv.h fptrap.h float.h execinfo.h pwd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +eval as_val=\$$as_ac_Header + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + +ac_fn_c_check_header_mongrel "$LINENO" "complex.h" "ac_cv_header_complex_h" "$ac_includes_default" +if test "x$ac_cv_header_complex_h" = x""yes; then : + +$as_echo "#define HAVE_COMPLEX_H 1" >>confdefs.h + +fi + + + + +inttype_headers=`echo inttypes.h sys/inttypes.h | sed -e 's/,/ /g'` + +acx_cv_header_stdint=stddef.h +acx_cv_header_stdint_kind="(already complete)" +for i in stdint.h $inttype_headers; do + unset ac_cv_type_uintptr_t + unset ac_cv_type_uintmax_t + unset ac_cv_type_int_least32_t + unset ac_cv_type_int_fast32_t + unset ac_cv_type_uint64_t + $as_echo_n "looking for a compliant stdint.h in $i, " >&6 + ac_fn_c_check_type "$LINENO" "uintmax_t" "ac_cv_type_uintmax_t" "#include +#include <$i> +" +if test "x$ac_cv_type_uintmax_t" = x""yes; then : + acx_cv_header_stdint=$i +else + continue +fi + + ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "#include +#include <$i> +" +if test "x$ac_cv_type_uintptr_t" = x""yes; then : + +else + acx_cv_header_stdint_kind="(mostly complete)" +fi + + ac_fn_c_check_type "$LINENO" "int_least32_t" "ac_cv_type_int_least32_t" "#include +#include <$i> +" +if test "x$ac_cv_type_int_least32_t" = x""yes; then : + +else + acx_cv_header_stdint_kind="(mostly complete)" +fi + + ac_fn_c_check_type "$LINENO" "int_fast32_t" "ac_cv_type_int_fast32_t" "#include +#include <$i> +" +if test "x$ac_cv_type_int_fast32_t" = x""yes; then : + +else + acx_cv_header_stdint_kind="(mostly complete)" +fi + + ac_fn_c_check_type "$LINENO" "uint64_t" "ac_cv_type_uint64_t" "#include +#include <$i> +" +if test "x$ac_cv_type_uint64_t" = x""yes; then : + +else + acx_cv_header_stdint_kind="(lacks uint64_t)" +fi + + break +done +if test "$acx_cv_header_stdint" = stddef.h; then + acx_cv_header_stdint_kind="(lacks uintmax_t)" + for i in stdint.h $inttype_headers; do + unset ac_cv_type_uintptr_t + unset ac_cv_type_uint32_t + unset ac_cv_type_uint64_t + $as_echo_n "looking for an incomplete stdint.h in $i, " >&6 + ac_fn_c_check_type "$LINENO" "uint32_t" "ac_cv_type_uint32_t" "#include +#include <$i> +" +if test "x$ac_cv_type_uint32_t" = x""yes; then : + acx_cv_header_stdint=$i +else + continue +fi + + ac_fn_c_check_type "$LINENO" "uint64_t" "ac_cv_type_uint64_t" "#include +#include <$i> +" +if test "x$ac_cv_type_uint64_t" = x""yes; then : + +fi + + ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "#include +#include <$i> +" +if test "x$ac_cv_type_uintptr_t" = x""yes; then : + +fi + + break + done +fi +if test "$acx_cv_header_stdint" = stddef.h; then + acx_cv_header_stdint_kind="(u_intXX_t style)" + for i in sys/types.h $inttype_headers; do + unset ac_cv_type_u_int32_t + unset ac_cv_type_u_int64_t + $as_echo_n "looking for u_intXX_t types in $i, " >&6 + ac_fn_c_check_type "$LINENO" "u_int32_t" "ac_cv_type_u_int32_t" "#include +#include <$i> +" +if test "x$ac_cv_type_u_int32_t" = x""yes; then : + acx_cv_header_stdint=$i +else + continue +fi + + ac_fn_c_check_type "$LINENO" "u_int64_t" "ac_cv_type_u_int64_t" "#include +#include <$i> +" +if test "x$ac_cv_type_u_int64_t" = x""yes; then : + +fi + + break + done +fi +if test "$acx_cv_header_stdint" = stddef.h; then + acx_cv_header_stdint_kind="(using manual detection)" +fi + +test -z "$ac_cv_type_uintptr_t" && ac_cv_type_uintptr_t=no +test -z "$ac_cv_type_uint64_t" && ac_cv_type_uint64_t=no +test -z "$ac_cv_type_u_int64_t" && ac_cv_type_u_int64_t=no +test -z "$ac_cv_type_int_least32_t" && ac_cv_type_int_least32_t=no +test -z "$ac_cv_type_int_fast32_t" && ac_cv_type_int_fast32_t=no + +# ----------------- Summarize what we found so far + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking what to include in gstdint.h" >&5 +$as_echo_n "checking what to include in gstdint.h... " >&6; } + +case `$as_basename -- gstdint.h || +$as_expr X/gstdint.h : '.*/\([^/][^/]*\)/*$' \| \ + Xgstdint.h : 'X\(//\)$' \| \ + Xgstdint.h : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/gstdint.h | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` in + stdint.h) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: are you sure you want it there?" >&5 +$as_echo "$as_me: WARNING: are you sure you want it there?" >&2;} ;; + inttypes.h) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: are you sure you want it there?" >&5 +$as_echo "$as_me: WARNING: are you sure you want it there?" >&2;} ;; + *) ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $acx_cv_header_stdint $acx_cv_header_stdint_kind" >&5 +$as_echo "$acx_cv_header_stdint $acx_cv_header_stdint_kind" >&6; } + +# ----------------- done included file, check C basic types -------- + +# Lacking an uintptr_t? Test size of void * +case "$acx_cv_header_stdint:$ac_cv_type_uintptr_t" in + stddef.h:* | *:no) # The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of void *" >&5 +$as_echo_n "checking size of void *... " >&6; } +if test "${ac_cv_sizeof_void_p+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (void *))" "ac_cv_sizeof_void_p" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_void_p" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ as_fn_set_status 77 +as_fn_error "cannot compute sizeof (void *) +See \`config.log' for more details." "$LINENO" 5; }; } + else + ac_cv_sizeof_void_p=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_void_p" >&5 +$as_echo "$ac_cv_sizeof_void_p" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_VOID_P $ac_cv_sizeof_void_p +_ACEOF + + ;; +esac + +# Lacking an uint64_t? Test size of long +case "$acx_cv_header_stdint:$ac_cv_type_uint64_t:$ac_cv_type_u_int64_t" in + stddef.h:*:* | *:no:no) # The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of long" >&5 +$as_echo_n "checking size of long... " >&6; } +if test "${ac_cv_sizeof_long+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (long))" "ac_cv_sizeof_long" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_long" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ as_fn_set_status 77 +as_fn_error "cannot compute sizeof (long) +See \`config.log' for more details." "$LINENO" 5; }; } + else + ac_cv_sizeof_long=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_long" >&5 +$as_echo "$ac_cv_sizeof_long" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_LONG $ac_cv_sizeof_long +_ACEOF + + ;; +esac + +if test $acx_cv_header_stdint = stddef.h; then + # Lacking a good header? Test size of everything and deduce all types. + # The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of int" >&5 +$as_echo_n "checking size of int... " >&6; } +if test "${ac_cv_sizeof_int+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (int))" "ac_cv_sizeof_int" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_int" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ as_fn_set_status 77 +as_fn_error "cannot compute sizeof (int) +See \`config.log' for more details." "$LINENO" 5; }; } + else + ac_cv_sizeof_int=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_int" >&5 +$as_echo "$ac_cv_sizeof_int" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_INT $ac_cv_sizeof_int +_ACEOF + + + # The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of short" >&5 +$as_echo_n "checking size of short... " >&6; } +if test "${ac_cv_sizeof_short+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (short))" "ac_cv_sizeof_short" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_short" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ as_fn_set_status 77 +as_fn_error "cannot compute sizeof (short) +See \`config.log' for more details." "$LINENO" 5; }; } + else + ac_cv_sizeof_short=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_short" >&5 +$as_echo "$ac_cv_sizeof_short" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_SHORT $ac_cv_sizeof_short +_ACEOF + + + # The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of char" >&5 +$as_echo_n "checking size of char... " >&6; } +if test "${ac_cv_sizeof_char+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (char))" "ac_cv_sizeof_char" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_char" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ as_fn_set_status 77 +as_fn_error "cannot compute sizeof (char) +See \`config.log' for more details." "$LINENO" 5; }; } + else + ac_cv_sizeof_char=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_char" >&5 +$as_echo "$ac_cv_sizeof_char" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_CHAR $ac_cv_sizeof_char +_ACEOF + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for type equivalent to int8_t" >&5 +$as_echo_n "checking for type equivalent to int8_t... " >&6; } + case "$ac_cv_sizeof_char" in + 1) acx_cv_type_int8_t=char ;; + *) as_fn_error "no 8-bit type, please report a bug" "$LINENO" 5 + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $acx_cv_type_int8_t" >&5 +$as_echo "$acx_cv_type_int8_t" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for type equivalent to int16_t" >&5 +$as_echo_n "checking for type equivalent to int16_t... " >&6; } + case "$ac_cv_sizeof_int:$ac_cv_sizeof_short" in + 2:*) acx_cv_type_int16_t=int ;; + *:2) acx_cv_type_int16_t=short ;; + *) as_fn_error "no 16-bit type, please report a bug" "$LINENO" 5 + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $acx_cv_type_int16_t" >&5 +$as_echo "$acx_cv_type_int16_t" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for type equivalent to int32_t" >&5 +$as_echo_n "checking for type equivalent to int32_t... " >&6; } + case "$ac_cv_sizeof_int:$ac_cv_sizeof_long" in + 4:*) acx_cv_type_int32_t=int ;; + *:4) acx_cv_type_int32_t=long ;; + *) as_fn_error "no 32-bit type, please report a bug" "$LINENO" 5 + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $acx_cv_type_int32_t" >&5 +$as_echo "$acx_cv_type_int32_t" >&6; } +fi + +# These tests are here to make the output prettier + +if test "$ac_cv_type_uint64_t" != yes && test "$ac_cv_type_u_int64_t" != yes; then + case "$ac_cv_sizeof_long" in + 8) acx_cv_type_int64_t=long ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for type equivalent to int64_t" >&5 +$as_echo_n "checking for type equivalent to int64_t... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${acx_cv_type_int64_t-'using preprocessor symbols'}" >&5 +$as_echo "${acx_cv_type_int64_t-'using preprocessor symbols'}" >&6; } +fi + +# Now we can use the above types + +if test "$ac_cv_type_uintptr_t" != yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for type equivalent to intptr_t" >&5 +$as_echo_n "checking for type equivalent to intptr_t... " >&6; } + case $ac_cv_sizeof_void_p in + 2) acx_cv_type_intptr_t=int16_t ;; + 4) acx_cv_type_intptr_t=int32_t ;; + 8) acx_cv_type_intptr_t=int64_t ;; + *) as_fn_error "no equivalent for intptr_t, please report a bug" "$LINENO" 5 + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $acx_cv_type_intptr_t" >&5 +$as_echo "$acx_cv_type_intptr_t" >&6; } +fi + +# ----------------- done all checks, emit header ------------- +ac_config_commands="$ac_config_commands gstdint.h" + + + + +ac_fn_c_check_member "$LINENO" "struct stat" "st_blksize" "ac_cv_member_struct_stat_st_blksize" "$ac_includes_default" +if test "x$ac_cv_member_struct_stat_st_blksize" = x""yes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_BLKSIZE 1 +_ACEOF + + +fi + +ac_fn_c_check_member "$LINENO" "struct stat" "st_blocks" "ac_cv_member_struct_stat_st_blocks" "$ac_includes_default" +if test "x$ac_cv_member_struct_stat_st_blocks" = x""yes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_BLOCKS 1 +_ACEOF + + +fi + +ac_fn_c_check_member "$LINENO" "struct stat" "st_rdev" "ac_cv_member_struct_stat_st_rdev" "$ac_includes_default" +if test "x$ac_cv_member_struct_stat_st_rdev" = x""yes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_STAT_ST_RDEV 1 +_ACEOF + + +fi + + +# Check for library functions. +for ac_func in getrusage times mkstemp strtof strtold snprintf ftruncate chsize +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +eval as_val=\$$as_ac_var + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in chdir strerror getlogin gethostname kill link symlink perror +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +eval as_val=\$$as_ac_var + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in sleep time ttyname signal alarm clock access fork execl +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +eval as_val=\$$as_ac_var + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in wait setmode execvp pipe dup2 close fdopen strcasestr getrlimit +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +eval as_val=\$$as_ac_var + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in gettimeofday stat fstat lstat getpwuid vsnprintf dup getcwd +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +eval as_val=\$$as_ac_var + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in localtime_r gmtime_r strerror_r getpwuid_r ttyname_r +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +eval as_val=\$$as_ac_var + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + +for ac_func in clock_gettime strftime +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +eval as_val=\$$as_ac_var + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + +# Check for glibc backtrace functions +for ac_func in backtrace backtrace_symbols +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +eval as_val=\$$as_ac_var + if test "x$as_val" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + +# Check for types +ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default" +if test "x$ac_cv_type_intptr_t" = x""yes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_INTPTR_T 1 +_ACEOF + + +fi + +ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default" +if test "x$ac_cv_type_uintptr_t" = x""yes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_UINTPTR_T 1 +_ACEOF + + +fi + + +# Check libc for getgid, getpid, getuid +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgid in -lc" >&5 +$as_echo_n "checking for getgid in -lc... " >&6; } +if test "${ac_cv_lib_c_getgid+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char getgid (); +int +main () +{ +return getgid (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_getgid=yes +else + ac_cv_lib_c_getgid=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_getgid" >&5 +$as_echo "$ac_cv_lib_c_getgid" >&6; } +if test "x$ac_cv_lib_c_getgid" = x""yes; then : + +$as_echo "#define HAVE_GETGID 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpid in -lc" >&5 +$as_echo_n "checking for getpid in -lc... " >&6; } +if test "${ac_cv_lib_c_getpid+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char getpid (); +int +main () +{ +return getpid (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_getpid=yes +else + ac_cv_lib_c_getpid=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_getpid" >&5 +$as_echo "$ac_cv_lib_c_getpid" >&6; } +if test "x$ac_cv_lib_c_getpid" = x""yes; then : + +$as_echo "#define HAVE_GETPID 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getppid in -lc" >&5 +$as_echo_n "checking for getppid in -lc... " >&6; } +if test "${ac_cv_lib_c_getppid+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char getppid (); +int +main () +{ +return getppid (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_getppid=yes +else + ac_cv_lib_c_getppid=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_getppid" >&5 +$as_echo "$ac_cv_lib_c_getppid" >&6; } +if test "x$ac_cv_lib_c_getppid" = x""yes; then : + +$as_echo "#define HAVE_GETPPID 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for getuid in -lc" >&5 +$as_echo_n "checking for getuid in -lc... " >&6; } +if test "${ac_cv_lib_c_getuid+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char getuid (); +int +main () +{ +return getuid (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_getuid=yes +else + ac_cv_lib_c_getuid=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_getuid" >&5 +$as_echo "$ac_cv_lib_c_getuid" >&6; } +if test "x$ac_cv_lib_c_getuid" = x""yes; then : + +$as_echo "#define HAVE_GETUID 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for geteuid in -lc" >&5 +$as_echo_n "checking for geteuid in -lc... " >&6; } +if test "${ac_cv_lib_c_geteuid+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char geteuid (); +int +main () +{ +return geteuid (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_geteuid=yes +else + ac_cv_lib_c_geteuid=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_geteuid" >&5 +$as_echo "$ac_cv_lib_c_geteuid" >&6; } +if test "x$ac_cv_lib_c_geteuid" = x""yes; then : + +$as_echo "#define HAVE_GETEUID 1" >>confdefs.h + +fi + + +# Check for C99 (and other IEEE) math functions +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for acosf in -lm" >&5 +$as_echo_n "checking for acosf in -lm... " >&6; } +if test "${ac_cv_lib_m_acosf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char acosf (); +int +main () +{ +return acosf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_acosf=yes +else + ac_cv_lib_m_acosf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_acosf" >&5 +$as_echo "$ac_cv_lib_m_acosf" >&6; } +if test "x$ac_cv_lib_m_acosf" = x""yes; then : + +$as_echo "#define HAVE_ACOSF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for acos in -lm" >&5 +$as_echo_n "checking for acos in -lm... " >&6; } +if test "${ac_cv_lib_m_acos+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char acos (); +int +main () +{ +return acos (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_acos=yes +else + ac_cv_lib_m_acos=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_acos" >&5 +$as_echo "$ac_cv_lib_m_acos" >&6; } +if test "x$ac_cv_lib_m_acos" = x""yes; then : + +$as_echo "#define HAVE_ACOS 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for acosl in -lm" >&5 +$as_echo_n "checking for acosl in -lm... " >&6; } +if test "${ac_cv_lib_m_acosl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char acosl (); +int +main () +{ +return acosl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_acosl=yes +else + ac_cv_lib_m_acosl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_acosl" >&5 +$as_echo "$ac_cv_lib_m_acosl" >&6; } +if test "x$ac_cv_lib_m_acosl" = x""yes; then : + +$as_echo "#define HAVE_ACOSL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for acoshf in -lm" >&5 +$as_echo_n "checking for acoshf in -lm... " >&6; } +if test "${ac_cv_lib_m_acoshf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char acoshf (); +int +main () +{ +return acoshf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_acoshf=yes +else + ac_cv_lib_m_acoshf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_acoshf" >&5 +$as_echo "$ac_cv_lib_m_acoshf" >&6; } +if test "x$ac_cv_lib_m_acoshf" = x""yes; then : + +$as_echo "#define HAVE_ACOSHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for acosh in -lm" >&5 +$as_echo_n "checking for acosh in -lm... " >&6; } +if test "${ac_cv_lib_m_acosh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char acosh (); +int +main () +{ +return acosh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_acosh=yes +else + ac_cv_lib_m_acosh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_acosh" >&5 +$as_echo "$ac_cv_lib_m_acosh" >&6; } +if test "x$ac_cv_lib_m_acosh" = x""yes; then : + +$as_echo "#define HAVE_ACOSH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for acoshl in -lm" >&5 +$as_echo_n "checking for acoshl in -lm... " >&6; } +if test "${ac_cv_lib_m_acoshl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char acoshl (); +int +main () +{ +return acoshl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_acoshl=yes +else + ac_cv_lib_m_acoshl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_acoshl" >&5 +$as_echo "$ac_cv_lib_m_acoshl" >&6; } +if test "x$ac_cv_lib_m_acoshl" = x""yes; then : + +$as_echo "#define HAVE_ACOSHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for asinf in -lm" >&5 +$as_echo_n "checking for asinf in -lm... " >&6; } +if test "${ac_cv_lib_m_asinf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char asinf (); +int +main () +{ +return asinf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_asinf=yes +else + ac_cv_lib_m_asinf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_asinf" >&5 +$as_echo "$ac_cv_lib_m_asinf" >&6; } +if test "x$ac_cv_lib_m_asinf" = x""yes; then : + +$as_echo "#define HAVE_ASINF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for asin in -lm" >&5 +$as_echo_n "checking for asin in -lm... " >&6; } +if test "${ac_cv_lib_m_asin+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char asin (); +int +main () +{ +return asin (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_asin=yes +else + ac_cv_lib_m_asin=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_asin" >&5 +$as_echo "$ac_cv_lib_m_asin" >&6; } +if test "x$ac_cv_lib_m_asin" = x""yes; then : + +$as_echo "#define HAVE_ASIN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for asinl in -lm" >&5 +$as_echo_n "checking for asinl in -lm... " >&6; } +if test "${ac_cv_lib_m_asinl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char asinl (); +int +main () +{ +return asinl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_asinl=yes +else + ac_cv_lib_m_asinl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_asinl" >&5 +$as_echo "$ac_cv_lib_m_asinl" >&6; } +if test "x$ac_cv_lib_m_asinl" = x""yes; then : + +$as_echo "#define HAVE_ASINL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for asinhf in -lm" >&5 +$as_echo_n "checking for asinhf in -lm... " >&6; } +if test "${ac_cv_lib_m_asinhf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char asinhf (); +int +main () +{ +return asinhf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_asinhf=yes +else + ac_cv_lib_m_asinhf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_asinhf" >&5 +$as_echo "$ac_cv_lib_m_asinhf" >&6; } +if test "x$ac_cv_lib_m_asinhf" = x""yes; then : + +$as_echo "#define HAVE_ASINHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for asinh in -lm" >&5 +$as_echo_n "checking for asinh in -lm... " >&6; } +if test "${ac_cv_lib_m_asinh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char asinh (); +int +main () +{ +return asinh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_asinh=yes +else + ac_cv_lib_m_asinh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_asinh" >&5 +$as_echo "$ac_cv_lib_m_asinh" >&6; } +if test "x$ac_cv_lib_m_asinh" = x""yes; then : + +$as_echo "#define HAVE_ASINH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for asinhl in -lm" >&5 +$as_echo_n "checking for asinhl in -lm... " >&6; } +if test "${ac_cv_lib_m_asinhl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char asinhl (); +int +main () +{ +return asinhl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_asinhl=yes +else + ac_cv_lib_m_asinhl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_asinhl" >&5 +$as_echo "$ac_cv_lib_m_asinhl" >&6; } +if test "x$ac_cv_lib_m_asinhl" = x""yes; then : + +$as_echo "#define HAVE_ASINHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for atan2f in -lm" >&5 +$as_echo_n "checking for atan2f in -lm... " >&6; } +if test "${ac_cv_lib_m_atan2f+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char atan2f (); +int +main () +{ +return atan2f (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_atan2f=yes +else + ac_cv_lib_m_atan2f=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_atan2f" >&5 +$as_echo "$ac_cv_lib_m_atan2f" >&6; } +if test "x$ac_cv_lib_m_atan2f" = x""yes; then : + +$as_echo "#define HAVE_ATAN2F 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for atan2 in -lm" >&5 +$as_echo_n "checking for atan2 in -lm... " >&6; } +if test "${ac_cv_lib_m_atan2+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char atan2 (); +int +main () +{ +return atan2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_atan2=yes +else + ac_cv_lib_m_atan2=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_atan2" >&5 +$as_echo "$ac_cv_lib_m_atan2" >&6; } +if test "x$ac_cv_lib_m_atan2" = x""yes; then : + +$as_echo "#define HAVE_ATAN2 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for atan2l in -lm" >&5 +$as_echo_n "checking for atan2l in -lm... " >&6; } +if test "${ac_cv_lib_m_atan2l+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char atan2l (); +int +main () +{ +return atan2l (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_atan2l=yes +else + ac_cv_lib_m_atan2l=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_atan2l" >&5 +$as_echo "$ac_cv_lib_m_atan2l" >&6; } +if test "x$ac_cv_lib_m_atan2l" = x""yes; then : + +$as_echo "#define HAVE_ATAN2L 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for atanf in -lm" >&5 +$as_echo_n "checking for atanf in -lm... " >&6; } +if test "${ac_cv_lib_m_atanf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char atanf (); +int +main () +{ +return atanf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_atanf=yes +else + ac_cv_lib_m_atanf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_atanf" >&5 +$as_echo "$ac_cv_lib_m_atanf" >&6; } +if test "x$ac_cv_lib_m_atanf" = x""yes; then : + +$as_echo "#define HAVE_ATANF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for atan in -lm" >&5 +$as_echo_n "checking for atan in -lm... " >&6; } +if test "${ac_cv_lib_m_atan+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char atan (); +int +main () +{ +return atan (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_atan=yes +else + ac_cv_lib_m_atan=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_atan" >&5 +$as_echo "$ac_cv_lib_m_atan" >&6; } +if test "x$ac_cv_lib_m_atan" = x""yes; then : + +$as_echo "#define HAVE_ATAN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for atanl in -lm" >&5 +$as_echo_n "checking for atanl in -lm... " >&6; } +if test "${ac_cv_lib_m_atanl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char atanl (); +int +main () +{ +return atanl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_atanl=yes +else + ac_cv_lib_m_atanl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_atanl" >&5 +$as_echo "$ac_cv_lib_m_atanl" >&6; } +if test "x$ac_cv_lib_m_atanl" = x""yes; then : + +$as_echo "#define HAVE_ATANL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for atanhf in -lm" >&5 +$as_echo_n "checking for atanhf in -lm... " >&6; } +if test "${ac_cv_lib_m_atanhf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char atanhf (); +int +main () +{ +return atanhf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_atanhf=yes +else + ac_cv_lib_m_atanhf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_atanhf" >&5 +$as_echo "$ac_cv_lib_m_atanhf" >&6; } +if test "x$ac_cv_lib_m_atanhf" = x""yes; then : + +$as_echo "#define HAVE_ATANHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for atanh in -lm" >&5 +$as_echo_n "checking for atanh in -lm... " >&6; } +if test "${ac_cv_lib_m_atanh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char atanh (); +int +main () +{ +return atanh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_atanh=yes +else + ac_cv_lib_m_atanh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_atanh" >&5 +$as_echo "$ac_cv_lib_m_atanh" >&6; } +if test "x$ac_cv_lib_m_atanh" = x""yes; then : + +$as_echo "#define HAVE_ATANH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for atanhl in -lm" >&5 +$as_echo_n "checking for atanhl in -lm... " >&6; } +if test "${ac_cv_lib_m_atanhl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char atanhl (); +int +main () +{ +return atanhl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_atanhl=yes +else + ac_cv_lib_m_atanhl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_atanhl" >&5 +$as_echo "$ac_cv_lib_m_atanhl" >&6; } +if test "x$ac_cv_lib_m_atanhl" = x""yes; then : + +$as_echo "#define HAVE_ATANHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cargf in -lm" >&5 +$as_echo_n "checking for cargf in -lm... " >&6; } +if test "${ac_cv_lib_m_cargf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cargf (); +int +main () +{ +return cargf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cargf=yes +else + ac_cv_lib_m_cargf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cargf" >&5 +$as_echo "$ac_cv_lib_m_cargf" >&6; } +if test "x$ac_cv_lib_m_cargf" = x""yes; then : + +$as_echo "#define HAVE_CARGF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for carg in -lm" >&5 +$as_echo_n "checking for carg in -lm... " >&6; } +if test "${ac_cv_lib_m_carg+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char carg (); +int +main () +{ +return carg (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_carg=yes +else + ac_cv_lib_m_carg=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_carg" >&5 +$as_echo "$ac_cv_lib_m_carg" >&6; } +if test "x$ac_cv_lib_m_carg" = x""yes; then : + +$as_echo "#define HAVE_CARG 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cargl in -lm" >&5 +$as_echo_n "checking for cargl in -lm... " >&6; } +if test "${ac_cv_lib_m_cargl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cargl (); +int +main () +{ +return cargl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cargl=yes +else + ac_cv_lib_m_cargl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cargl" >&5 +$as_echo "$ac_cv_lib_m_cargl" >&6; } +if test "x$ac_cv_lib_m_cargl" = x""yes; then : + +$as_echo "#define HAVE_CARGL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ceilf in -lm" >&5 +$as_echo_n "checking for ceilf in -lm... " >&6; } +if test "${ac_cv_lib_m_ceilf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ceilf (); +int +main () +{ +return ceilf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ceilf=yes +else + ac_cv_lib_m_ceilf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ceilf" >&5 +$as_echo "$ac_cv_lib_m_ceilf" >&6; } +if test "x$ac_cv_lib_m_ceilf" = x""yes; then : + +$as_echo "#define HAVE_CEILF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ceil in -lm" >&5 +$as_echo_n "checking for ceil in -lm... " >&6; } +if test "${ac_cv_lib_m_ceil+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ceil (); +int +main () +{ +return ceil (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ceil=yes +else + ac_cv_lib_m_ceil=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ceil" >&5 +$as_echo "$ac_cv_lib_m_ceil" >&6; } +if test "x$ac_cv_lib_m_ceil" = x""yes; then : + +$as_echo "#define HAVE_CEIL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ceill in -lm" >&5 +$as_echo_n "checking for ceill in -lm... " >&6; } +if test "${ac_cv_lib_m_ceill+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ceill (); +int +main () +{ +return ceill (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ceill=yes +else + ac_cv_lib_m_ceill=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ceill" >&5 +$as_echo "$ac_cv_lib_m_ceill" >&6; } +if test "x$ac_cv_lib_m_ceill" = x""yes; then : + +$as_echo "#define HAVE_CEILL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for copysignf in -lm" >&5 +$as_echo_n "checking for copysignf in -lm... " >&6; } +if test "${ac_cv_lib_m_copysignf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char copysignf (); +int +main () +{ +return copysignf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_copysignf=yes +else + ac_cv_lib_m_copysignf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_copysignf" >&5 +$as_echo "$ac_cv_lib_m_copysignf" >&6; } +if test "x$ac_cv_lib_m_copysignf" = x""yes; then : + +$as_echo "#define HAVE_COPYSIGNF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for copysign in -lm" >&5 +$as_echo_n "checking for copysign in -lm... " >&6; } +if test "${ac_cv_lib_m_copysign+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char copysign (); +int +main () +{ +return copysign (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_copysign=yes +else + ac_cv_lib_m_copysign=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_copysign" >&5 +$as_echo "$ac_cv_lib_m_copysign" >&6; } +if test "x$ac_cv_lib_m_copysign" = x""yes; then : + +$as_echo "#define HAVE_COPYSIGN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for copysignl in -lm" >&5 +$as_echo_n "checking for copysignl in -lm... " >&6; } +if test "${ac_cv_lib_m_copysignl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char copysignl (); +int +main () +{ +return copysignl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_copysignl=yes +else + ac_cv_lib_m_copysignl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_copysignl" >&5 +$as_echo "$ac_cv_lib_m_copysignl" >&6; } +if test "x$ac_cv_lib_m_copysignl" = x""yes; then : + +$as_echo "#define HAVE_COPYSIGNL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cosf in -lm" >&5 +$as_echo_n "checking for cosf in -lm... " >&6; } +if test "${ac_cv_lib_m_cosf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cosf (); +int +main () +{ +return cosf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cosf=yes +else + ac_cv_lib_m_cosf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cosf" >&5 +$as_echo "$ac_cv_lib_m_cosf" >&6; } +if test "x$ac_cv_lib_m_cosf" = x""yes; then : + +$as_echo "#define HAVE_COSF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cos in -lm" >&5 +$as_echo_n "checking for cos in -lm... " >&6; } +if test "${ac_cv_lib_m_cos+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cos (); +int +main () +{ +return cos (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cos=yes +else + ac_cv_lib_m_cos=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cos" >&5 +$as_echo "$ac_cv_lib_m_cos" >&6; } +if test "x$ac_cv_lib_m_cos" = x""yes; then : + +$as_echo "#define HAVE_COS 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cosl in -lm" >&5 +$as_echo_n "checking for cosl in -lm... " >&6; } +if test "${ac_cv_lib_m_cosl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cosl (); +int +main () +{ +return cosl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cosl=yes +else + ac_cv_lib_m_cosl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cosl" >&5 +$as_echo "$ac_cv_lib_m_cosl" >&6; } +if test "x$ac_cv_lib_m_cosl" = x""yes; then : + +$as_echo "#define HAVE_COSL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ccosf in -lm" >&5 +$as_echo_n "checking for ccosf in -lm... " >&6; } +if test "${ac_cv_lib_m_ccosf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ccosf (); +int +main () +{ +return ccosf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ccosf=yes +else + ac_cv_lib_m_ccosf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ccosf" >&5 +$as_echo "$ac_cv_lib_m_ccosf" >&6; } +if test "x$ac_cv_lib_m_ccosf" = x""yes; then : + +$as_echo "#define HAVE_CCOSF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ccos in -lm" >&5 +$as_echo_n "checking for ccos in -lm... " >&6; } +if test "${ac_cv_lib_m_ccos+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ccos (); +int +main () +{ +return ccos (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ccos=yes +else + ac_cv_lib_m_ccos=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ccos" >&5 +$as_echo "$ac_cv_lib_m_ccos" >&6; } +if test "x$ac_cv_lib_m_ccos" = x""yes; then : + +$as_echo "#define HAVE_CCOS 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ccosl in -lm" >&5 +$as_echo_n "checking for ccosl in -lm... " >&6; } +if test "${ac_cv_lib_m_ccosl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ccosl (); +int +main () +{ +return ccosl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ccosl=yes +else + ac_cv_lib_m_ccosl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ccosl" >&5 +$as_echo "$ac_cv_lib_m_ccosl" >&6; } +if test "x$ac_cv_lib_m_ccosl" = x""yes; then : + +$as_echo "#define HAVE_CCOSL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for coshf in -lm" >&5 +$as_echo_n "checking for coshf in -lm... " >&6; } +if test "${ac_cv_lib_m_coshf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char coshf (); +int +main () +{ +return coshf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_coshf=yes +else + ac_cv_lib_m_coshf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_coshf" >&5 +$as_echo "$ac_cv_lib_m_coshf" >&6; } +if test "x$ac_cv_lib_m_coshf" = x""yes; then : + +$as_echo "#define HAVE_COSHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cosh in -lm" >&5 +$as_echo_n "checking for cosh in -lm... " >&6; } +if test "${ac_cv_lib_m_cosh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cosh (); +int +main () +{ +return cosh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cosh=yes +else + ac_cv_lib_m_cosh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cosh" >&5 +$as_echo "$ac_cv_lib_m_cosh" >&6; } +if test "x$ac_cv_lib_m_cosh" = x""yes; then : + +$as_echo "#define HAVE_COSH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for coshl in -lm" >&5 +$as_echo_n "checking for coshl in -lm... " >&6; } +if test "${ac_cv_lib_m_coshl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char coshl (); +int +main () +{ +return coshl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_coshl=yes +else + ac_cv_lib_m_coshl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_coshl" >&5 +$as_echo "$ac_cv_lib_m_coshl" >&6; } +if test "x$ac_cv_lib_m_coshl" = x""yes; then : + +$as_echo "#define HAVE_COSHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ccoshf in -lm" >&5 +$as_echo_n "checking for ccoshf in -lm... " >&6; } +if test "${ac_cv_lib_m_ccoshf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ccoshf (); +int +main () +{ +return ccoshf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ccoshf=yes +else + ac_cv_lib_m_ccoshf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ccoshf" >&5 +$as_echo "$ac_cv_lib_m_ccoshf" >&6; } +if test "x$ac_cv_lib_m_ccoshf" = x""yes; then : + +$as_echo "#define HAVE_CCOSHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ccosh in -lm" >&5 +$as_echo_n "checking for ccosh in -lm... " >&6; } +if test "${ac_cv_lib_m_ccosh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ccosh (); +int +main () +{ +return ccosh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ccosh=yes +else + ac_cv_lib_m_ccosh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ccosh" >&5 +$as_echo "$ac_cv_lib_m_ccosh" >&6; } +if test "x$ac_cv_lib_m_ccosh" = x""yes; then : + +$as_echo "#define HAVE_CCOSH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ccoshl in -lm" >&5 +$as_echo_n "checking for ccoshl in -lm... " >&6; } +if test "${ac_cv_lib_m_ccoshl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ccoshl (); +int +main () +{ +return ccoshl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ccoshl=yes +else + ac_cv_lib_m_ccoshl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ccoshl" >&5 +$as_echo "$ac_cv_lib_m_ccoshl" >&6; } +if test "x$ac_cv_lib_m_ccoshl" = x""yes; then : + +$as_echo "#define HAVE_CCOSHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for expf in -lm" >&5 +$as_echo_n "checking for expf in -lm... " >&6; } +if test "${ac_cv_lib_m_expf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char expf (); +int +main () +{ +return expf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_expf=yes +else + ac_cv_lib_m_expf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_expf" >&5 +$as_echo "$ac_cv_lib_m_expf" >&6; } +if test "x$ac_cv_lib_m_expf" = x""yes; then : + +$as_echo "#define HAVE_EXPF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for exp in -lm" >&5 +$as_echo_n "checking for exp in -lm... " >&6; } +if test "${ac_cv_lib_m_exp+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char exp (); +int +main () +{ +return exp (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_exp=yes +else + ac_cv_lib_m_exp=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_exp" >&5 +$as_echo "$ac_cv_lib_m_exp" >&6; } +if test "x$ac_cv_lib_m_exp" = x""yes; then : + +$as_echo "#define HAVE_EXP 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for expl in -lm" >&5 +$as_echo_n "checking for expl in -lm... " >&6; } +if test "${ac_cv_lib_m_expl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char expl (); +int +main () +{ +return expl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_expl=yes +else + ac_cv_lib_m_expl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_expl" >&5 +$as_echo "$ac_cv_lib_m_expl" >&6; } +if test "x$ac_cv_lib_m_expl" = x""yes; then : + +$as_echo "#define HAVE_EXPL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cexpf in -lm" >&5 +$as_echo_n "checking for cexpf in -lm... " >&6; } +if test "${ac_cv_lib_m_cexpf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cexpf (); +int +main () +{ +return cexpf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cexpf=yes +else + ac_cv_lib_m_cexpf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cexpf" >&5 +$as_echo "$ac_cv_lib_m_cexpf" >&6; } +if test "x$ac_cv_lib_m_cexpf" = x""yes; then : + +$as_echo "#define HAVE_CEXPF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cexp in -lm" >&5 +$as_echo_n "checking for cexp in -lm... " >&6; } +if test "${ac_cv_lib_m_cexp+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cexp (); +int +main () +{ +return cexp (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cexp=yes +else + ac_cv_lib_m_cexp=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cexp" >&5 +$as_echo "$ac_cv_lib_m_cexp" >&6; } +if test "x$ac_cv_lib_m_cexp" = x""yes; then : + +$as_echo "#define HAVE_CEXP 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cexpl in -lm" >&5 +$as_echo_n "checking for cexpl in -lm... " >&6; } +if test "${ac_cv_lib_m_cexpl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cexpl (); +int +main () +{ +return cexpl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cexpl=yes +else + ac_cv_lib_m_cexpl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cexpl" >&5 +$as_echo "$ac_cv_lib_m_cexpl" >&6; } +if test "x$ac_cv_lib_m_cexpl" = x""yes; then : + +$as_echo "#define HAVE_CEXPL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fabsf in -lm" >&5 +$as_echo_n "checking for fabsf in -lm... " >&6; } +if test "${ac_cv_lib_m_fabsf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char fabsf (); +int +main () +{ +return fabsf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_fabsf=yes +else + ac_cv_lib_m_fabsf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_fabsf" >&5 +$as_echo "$ac_cv_lib_m_fabsf" >&6; } +if test "x$ac_cv_lib_m_fabsf" = x""yes; then : + +$as_echo "#define HAVE_FABSF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fabs in -lm" >&5 +$as_echo_n "checking for fabs in -lm... " >&6; } +if test "${ac_cv_lib_m_fabs+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char fabs (); +int +main () +{ +return fabs (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_fabs=yes +else + ac_cv_lib_m_fabs=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_fabs" >&5 +$as_echo "$ac_cv_lib_m_fabs" >&6; } +if test "x$ac_cv_lib_m_fabs" = x""yes; then : + +$as_echo "#define HAVE_FABS 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fabsl in -lm" >&5 +$as_echo_n "checking for fabsl in -lm... " >&6; } +if test "${ac_cv_lib_m_fabsl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char fabsl (); +int +main () +{ +return fabsl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_fabsl=yes +else + ac_cv_lib_m_fabsl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_fabsl" >&5 +$as_echo "$ac_cv_lib_m_fabsl" >&6; } +if test "x$ac_cv_lib_m_fabsl" = x""yes; then : + +$as_echo "#define HAVE_FABSL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cabsf in -lm" >&5 +$as_echo_n "checking for cabsf in -lm... " >&6; } +if test "${ac_cv_lib_m_cabsf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cabsf (); +int +main () +{ +return cabsf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cabsf=yes +else + ac_cv_lib_m_cabsf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cabsf" >&5 +$as_echo "$ac_cv_lib_m_cabsf" >&6; } +if test "x$ac_cv_lib_m_cabsf" = x""yes; then : + +$as_echo "#define HAVE_CABSF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cabs in -lm" >&5 +$as_echo_n "checking for cabs in -lm... " >&6; } +if test "${ac_cv_lib_m_cabs+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cabs (); +int +main () +{ +return cabs (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cabs=yes +else + ac_cv_lib_m_cabs=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cabs" >&5 +$as_echo "$ac_cv_lib_m_cabs" >&6; } +if test "x$ac_cv_lib_m_cabs" = x""yes; then : + +$as_echo "#define HAVE_CABS 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cabsl in -lm" >&5 +$as_echo_n "checking for cabsl in -lm... " >&6; } +if test "${ac_cv_lib_m_cabsl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cabsl (); +int +main () +{ +return cabsl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cabsl=yes +else + ac_cv_lib_m_cabsl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cabsl" >&5 +$as_echo "$ac_cv_lib_m_cabsl" >&6; } +if test "x$ac_cv_lib_m_cabsl" = x""yes; then : + +$as_echo "#define HAVE_CABSL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for floorf in -lm" >&5 +$as_echo_n "checking for floorf in -lm... " >&6; } +if test "${ac_cv_lib_m_floorf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char floorf (); +int +main () +{ +return floorf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_floorf=yes +else + ac_cv_lib_m_floorf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_floorf" >&5 +$as_echo "$ac_cv_lib_m_floorf" >&6; } +if test "x$ac_cv_lib_m_floorf" = x""yes; then : + +$as_echo "#define HAVE_FLOORF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for floor in -lm" >&5 +$as_echo_n "checking for floor in -lm... " >&6; } +if test "${ac_cv_lib_m_floor+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char floor (); +int +main () +{ +return floor (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_floor=yes +else + ac_cv_lib_m_floor=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_floor" >&5 +$as_echo "$ac_cv_lib_m_floor" >&6; } +if test "x$ac_cv_lib_m_floor" = x""yes; then : + +$as_echo "#define HAVE_FLOOR 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for floorl in -lm" >&5 +$as_echo_n "checking for floorl in -lm... " >&6; } +if test "${ac_cv_lib_m_floorl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char floorl (); +int +main () +{ +return floorl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_floorl=yes +else + ac_cv_lib_m_floorl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_floorl" >&5 +$as_echo "$ac_cv_lib_m_floorl" >&6; } +if test "x$ac_cv_lib_m_floorl" = x""yes; then : + +$as_echo "#define HAVE_FLOORL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fmodf in -lm" >&5 +$as_echo_n "checking for fmodf in -lm... " >&6; } +if test "${ac_cv_lib_m_fmodf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char fmodf (); +int +main () +{ +return fmodf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_fmodf=yes +else + ac_cv_lib_m_fmodf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_fmodf" >&5 +$as_echo "$ac_cv_lib_m_fmodf" >&6; } +if test "x$ac_cv_lib_m_fmodf" = x""yes; then : + +$as_echo "#define HAVE_FMODF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fmod in -lm" >&5 +$as_echo_n "checking for fmod in -lm... " >&6; } +if test "${ac_cv_lib_m_fmod+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char fmod (); +int +main () +{ +return fmod (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_fmod=yes +else + ac_cv_lib_m_fmod=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_fmod" >&5 +$as_echo "$ac_cv_lib_m_fmod" >&6; } +if test "x$ac_cv_lib_m_fmod" = x""yes; then : + +$as_echo "#define HAVE_FMOD 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fmodl in -lm" >&5 +$as_echo_n "checking for fmodl in -lm... " >&6; } +if test "${ac_cv_lib_m_fmodl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char fmodl (); +int +main () +{ +return fmodl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_fmodl=yes +else + ac_cv_lib_m_fmodl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_fmodl" >&5 +$as_echo "$ac_cv_lib_m_fmodl" >&6; } +if test "x$ac_cv_lib_m_fmodl" = x""yes; then : + +$as_echo "#define HAVE_FMODL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for frexpf in -lm" >&5 +$as_echo_n "checking for frexpf in -lm... " >&6; } +if test "${ac_cv_lib_m_frexpf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char frexpf (); +int +main () +{ +return frexpf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_frexpf=yes +else + ac_cv_lib_m_frexpf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_frexpf" >&5 +$as_echo "$ac_cv_lib_m_frexpf" >&6; } +if test "x$ac_cv_lib_m_frexpf" = x""yes; then : + +$as_echo "#define HAVE_FREXPF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for frexp in -lm" >&5 +$as_echo_n "checking for frexp in -lm... " >&6; } +if test "${ac_cv_lib_m_frexp+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char frexp (); +int +main () +{ +return frexp (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_frexp=yes +else + ac_cv_lib_m_frexp=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_frexp" >&5 +$as_echo "$ac_cv_lib_m_frexp" >&6; } +if test "x$ac_cv_lib_m_frexp" = x""yes; then : + +$as_echo "#define HAVE_FREXP 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for frexpl in -lm" >&5 +$as_echo_n "checking for frexpl in -lm... " >&6; } +if test "${ac_cv_lib_m_frexpl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char frexpl (); +int +main () +{ +return frexpl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_frexpl=yes +else + ac_cv_lib_m_frexpl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_frexpl" >&5 +$as_echo "$ac_cv_lib_m_frexpl" >&6; } +if test "x$ac_cv_lib_m_frexpl" = x""yes; then : + +$as_echo "#define HAVE_FREXPL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for hypotf in -lm" >&5 +$as_echo_n "checking for hypotf in -lm... " >&6; } +if test "${ac_cv_lib_m_hypotf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char hypotf (); +int +main () +{ +return hypotf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_hypotf=yes +else + ac_cv_lib_m_hypotf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_hypotf" >&5 +$as_echo "$ac_cv_lib_m_hypotf" >&6; } +if test "x$ac_cv_lib_m_hypotf" = x""yes; then : + +$as_echo "#define HAVE_HYPOTF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for hypot in -lm" >&5 +$as_echo_n "checking for hypot in -lm... " >&6; } +if test "${ac_cv_lib_m_hypot+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char hypot (); +int +main () +{ +return hypot (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_hypot=yes +else + ac_cv_lib_m_hypot=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_hypot" >&5 +$as_echo "$ac_cv_lib_m_hypot" >&6; } +if test "x$ac_cv_lib_m_hypot" = x""yes; then : + +$as_echo "#define HAVE_HYPOT 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for hypotl in -lm" >&5 +$as_echo_n "checking for hypotl in -lm... " >&6; } +if test "${ac_cv_lib_m_hypotl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char hypotl (); +int +main () +{ +return hypotl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_hypotl=yes +else + ac_cv_lib_m_hypotl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_hypotl" >&5 +$as_echo "$ac_cv_lib_m_hypotl" >&6; } +if test "x$ac_cv_lib_m_hypotl" = x""yes; then : + +$as_echo "#define HAVE_HYPOTL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ldexpf in -lm" >&5 +$as_echo_n "checking for ldexpf in -lm... " >&6; } +if test "${ac_cv_lib_m_ldexpf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ldexpf (); +int +main () +{ +return ldexpf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ldexpf=yes +else + ac_cv_lib_m_ldexpf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ldexpf" >&5 +$as_echo "$ac_cv_lib_m_ldexpf" >&6; } +if test "x$ac_cv_lib_m_ldexpf" = x""yes; then : + +$as_echo "#define HAVE_LDEXPF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ldexp in -lm" >&5 +$as_echo_n "checking for ldexp in -lm... " >&6; } +if test "${ac_cv_lib_m_ldexp+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ldexp (); +int +main () +{ +return ldexp (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ldexp=yes +else + ac_cv_lib_m_ldexp=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ldexp" >&5 +$as_echo "$ac_cv_lib_m_ldexp" >&6; } +if test "x$ac_cv_lib_m_ldexp" = x""yes; then : + +$as_echo "#define HAVE_LDEXP 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ldexpl in -lm" >&5 +$as_echo_n "checking for ldexpl in -lm... " >&6; } +if test "${ac_cv_lib_m_ldexpl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ldexpl (); +int +main () +{ +return ldexpl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ldexpl=yes +else + ac_cv_lib_m_ldexpl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ldexpl" >&5 +$as_echo "$ac_cv_lib_m_ldexpl" >&6; } +if test "x$ac_cv_lib_m_ldexpl" = x""yes; then : + +$as_echo "#define HAVE_LDEXPL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for logf in -lm" >&5 +$as_echo_n "checking for logf in -lm... " >&6; } +if test "${ac_cv_lib_m_logf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char logf (); +int +main () +{ +return logf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_logf=yes +else + ac_cv_lib_m_logf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_logf" >&5 +$as_echo "$ac_cv_lib_m_logf" >&6; } +if test "x$ac_cv_lib_m_logf" = x""yes; then : + +$as_echo "#define HAVE_LOGF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for log in -lm" >&5 +$as_echo_n "checking for log in -lm... " >&6; } +if test "${ac_cv_lib_m_log+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char log (); +int +main () +{ +return log (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_log=yes +else + ac_cv_lib_m_log=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_log" >&5 +$as_echo "$ac_cv_lib_m_log" >&6; } +if test "x$ac_cv_lib_m_log" = x""yes; then : + +$as_echo "#define HAVE_LOG 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for logl in -lm" >&5 +$as_echo_n "checking for logl in -lm... " >&6; } +if test "${ac_cv_lib_m_logl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char logl (); +int +main () +{ +return logl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_logl=yes +else + ac_cv_lib_m_logl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_logl" >&5 +$as_echo "$ac_cv_lib_m_logl" >&6; } +if test "x$ac_cv_lib_m_logl" = x""yes; then : + +$as_echo "#define HAVE_LOGL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clogf in -lm" >&5 +$as_echo_n "checking for clogf in -lm... " >&6; } +if test "${ac_cv_lib_m_clogf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char clogf (); +int +main () +{ +return clogf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_clogf=yes +else + ac_cv_lib_m_clogf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_clogf" >&5 +$as_echo "$ac_cv_lib_m_clogf" >&6; } +if test "x$ac_cv_lib_m_clogf" = x""yes; then : + +$as_echo "#define HAVE_CLOGF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clog in -lm" >&5 +$as_echo_n "checking for clog in -lm... " >&6; } +if test "${ac_cv_lib_m_clog+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char clog (); +int +main () +{ +return clog (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_clog=yes +else + ac_cv_lib_m_clog=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_clog" >&5 +$as_echo "$ac_cv_lib_m_clog" >&6; } +if test "x$ac_cv_lib_m_clog" = x""yes; then : + +$as_echo "#define HAVE_CLOG 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clogl in -lm" >&5 +$as_echo_n "checking for clogl in -lm... " >&6; } +if test "${ac_cv_lib_m_clogl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char clogl (); +int +main () +{ +return clogl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_clogl=yes +else + ac_cv_lib_m_clogl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_clogl" >&5 +$as_echo "$ac_cv_lib_m_clogl" >&6; } +if test "x$ac_cv_lib_m_clogl" = x""yes; then : + +$as_echo "#define HAVE_CLOGL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for log10f in -lm" >&5 +$as_echo_n "checking for log10f in -lm... " >&6; } +if test "${ac_cv_lib_m_log10f+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char log10f (); +int +main () +{ +return log10f (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_log10f=yes +else + ac_cv_lib_m_log10f=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_log10f" >&5 +$as_echo "$ac_cv_lib_m_log10f" >&6; } +if test "x$ac_cv_lib_m_log10f" = x""yes; then : + +$as_echo "#define HAVE_LOG10F 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for log10 in -lm" >&5 +$as_echo_n "checking for log10 in -lm... " >&6; } +if test "${ac_cv_lib_m_log10+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char log10 (); +int +main () +{ +return log10 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_log10=yes +else + ac_cv_lib_m_log10=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_log10" >&5 +$as_echo "$ac_cv_lib_m_log10" >&6; } +if test "x$ac_cv_lib_m_log10" = x""yes; then : + +$as_echo "#define HAVE_LOG10 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for log10l in -lm" >&5 +$as_echo_n "checking for log10l in -lm... " >&6; } +if test "${ac_cv_lib_m_log10l+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char log10l (); +int +main () +{ +return log10l (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_log10l=yes +else + ac_cv_lib_m_log10l=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_log10l" >&5 +$as_echo "$ac_cv_lib_m_log10l" >&6; } +if test "x$ac_cv_lib_m_log10l" = x""yes; then : + +$as_echo "#define HAVE_LOG10L 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clog10f in -lm" >&5 +$as_echo_n "checking for clog10f in -lm... " >&6; } +if test "${ac_cv_lib_m_clog10f+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char clog10f (); +int +main () +{ +return clog10f (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_clog10f=yes +else + ac_cv_lib_m_clog10f=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_clog10f" >&5 +$as_echo "$ac_cv_lib_m_clog10f" >&6; } +if test "x$ac_cv_lib_m_clog10f" = x""yes; then : + +$as_echo "#define HAVE_CLOG10F 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clog10 in -lm" >&5 +$as_echo_n "checking for clog10 in -lm... " >&6; } +if test "${ac_cv_lib_m_clog10+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char clog10 (); +int +main () +{ +return clog10 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_clog10=yes +else + ac_cv_lib_m_clog10=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_clog10" >&5 +$as_echo "$ac_cv_lib_m_clog10" >&6; } +if test "x$ac_cv_lib_m_clog10" = x""yes; then : + +$as_echo "#define HAVE_CLOG10 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clog10l in -lm" >&5 +$as_echo_n "checking for clog10l in -lm... " >&6; } +if test "${ac_cv_lib_m_clog10l+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char clog10l (); +int +main () +{ +return clog10l (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_clog10l=yes +else + ac_cv_lib_m_clog10l=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_clog10l" >&5 +$as_echo "$ac_cv_lib_m_clog10l" >&6; } +if test "x$ac_cv_lib_m_clog10l" = x""yes; then : + +$as_echo "#define HAVE_CLOG10L 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for nextafterf in -lm" >&5 +$as_echo_n "checking for nextafterf in -lm... " >&6; } +if test "${ac_cv_lib_m_nextafterf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char nextafterf (); +int +main () +{ +return nextafterf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_nextafterf=yes +else + ac_cv_lib_m_nextafterf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_nextafterf" >&5 +$as_echo "$ac_cv_lib_m_nextafterf" >&6; } +if test "x$ac_cv_lib_m_nextafterf" = x""yes; then : + +$as_echo "#define HAVE_NEXTAFTERF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for nextafter in -lm" >&5 +$as_echo_n "checking for nextafter in -lm... " >&6; } +if test "${ac_cv_lib_m_nextafter+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char nextafter (); +int +main () +{ +return nextafter (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_nextafter=yes +else + ac_cv_lib_m_nextafter=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_nextafter" >&5 +$as_echo "$ac_cv_lib_m_nextafter" >&6; } +if test "x$ac_cv_lib_m_nextafter" = x""yes; then : + +$as_echo "#define HAVE_NEXTAFTER 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for nextafterl in -lm" >&5 +$as_echo_n "checking for nextafterl in -lm... " >&6; } +if test "${ac_cv_lib_m_nextafterl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char nextafterl (); +int +main () +{ +return nextafterl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_nextafterl=yes +else + ac_cv_lib_m_nextafterl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_nextafterl" >&5 +$as_echo "$ac_cv_lib_m_nextafterl" >&6; } +if test "x$ac_cv_lib_m_nextafterl" = x""yes; then : + +$as_echo "#define HAVE_NEXTAFTERL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for powf in -lm" >&5 +$as_echo_n "checking for powf in -lm... " >&6; } +if test "${ac_cv_lib_m_powf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char powf (); +int +main () +{ +return powf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_powf=yes +else + ac_cv_lib_m_powf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_powf" >&5 +$as_echo "$ac_cv_lib_m_powf" >&6; } +if test "x$ac_cv_lib_m_powf" = x""yes; then : + +$as_echo "#define HAVE_POWF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for pow in -lm" >&5 +$as_echo_n "checking for pow in -lm... " >&6; } +if test "${ac_cv_lib_m_pow+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pow (); +int +main () +{ +return pow (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_pow=yes +else + ac_cv_lib_m_pow=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_pow" >&5 +$as_echo "$ac_cv_lib_m_pow" >&6; } +if test "x$ac_cv_lib_m_pow" = x""yes; then : + +$as_echo "#define HAVE_POW 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for powl in -lm" >&5 +$as_echo_n "checking for powl in -lm... " >&6; } +if test "${ac_cv_lib_m_powl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char powl (); +int +main () +{ +return powl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_powl=yes +else + ac_cv_lib_m_powl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_powl" >&5 +$as_echo "$ac_cv_lib_m_powl" >&6; } +if test "x$ac_cv_lib_m_powl" = x""yes; then : + +$as_echo "#define HAVE_POWL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cpowf in -lm" >&5 +$as_echo_n "checking for cpowf in -lm... " >&6; } +if test "${ac_cv_lib_m_cpowf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cpowf (); +int +main () +{ +return cpowf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cpowf=yes +else + ac_cv_lib_m_cpowf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cpowf" >&5 +$as_echo "$ac_cv_lib_m_cpowf" >&6; } +if test "x$ac_cv_lib_m_cpowf" = x""yes; then : + +$as_echo "#define HAVE_CPOWF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cpow in -lm" >&5 +$as_echo_n "checking for cpow in -lm... " >&6; } +if test "${ac_cv_lib_m_cpow+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cpow (); +int +main () +{ +return cpow (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cpow=yes +else + ac_cv_lib_m_cpow=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cpow" >&5 +$as_echo "$ac_cv_lib_m_cpow" >&6; } +if test "x$ac_cv_lib_m_cpow" = x""yes; then : + +$as_echo "#define HAVE_CPOW 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cpowl in -lm" >&5 +$as_echo_n "checking for cpowl in -lm... " >&6; } +if test "${ac_cv_lib_m_cpowl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cpowl (); +int +main () +{ +return cpowl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cpowl=yes +else + ac_cv_lib_m_cpowl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cpowl" >&5 +$as_echo "$ac_cv_lib_m_cpowl" >&6; } +if test "x$ac_cv_lib_m_cpowl" = x""yes; then : + +$as_echo "#define HAVE_CPOWL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for roundf in -lm" >&5 +$as_echo_n "checking for roundf in -lm... " >&6; } +if test "${ac_cv_lib_m_roundf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char roundf (); +int +main () +{ +return roundf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_roundf=yes +else + ac_cv_lib_m_roundf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_roundf" >&5 +$as_echo "$ac_cv_lib_m_roundf" >&6; } +if test "x$ac_cv_lib_m_roundf" = x""yes; then : + +$as_echo "#define HAVE_ROUNDF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for round in -lm" >&5 +$as_echo_n "checking for round in -lm... " >&6; } +if test "${ac_cv_lib_m_round+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char round (); +int +main () +{ +return round (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_round=yes +else + ac_cv_lib_m_round=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_round" >&5 +$as_echo "$ac_cv_lib_m_round" >&6; } +if test "x$ac_cv_lib_m_round" = x""yes; then : + +$as_echo "#define HAVE_ROUND 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for roundl in -lm" >&5 +$as_echo_n "checking for roundl in -lm... " >&6; } +if test "${ac_cv_lib_m_roundl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char roundl (); +int +main () +{ +return roundl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_roundl=yes +else + ac_cv_lib_m_roundl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_roundl" >&5 +$as_echo "$ac_cv_lib_m_roundl" >&6; } +if test "x$ac_cv_lib_m_roundl" = x""yes; then : + +$as_echo "#define HAVE_ROUNDL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for lroundf in -lm" >&5 +$as_echo_n "checking for lroundf in -lm... " >&6; } +if test "${ac_cv_lib_m_lroundf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char lroundf (); +int +main () +{ +return lroundf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_lroundf=yes +else + ac_cv_lib_m_lroundf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_lroundf" >&5 +$as_echo "$ac_cv_lib_m_lroundf" >&6; } +if test "x$ac_cv_lib_m_lroundf" = x""yes; then : + +$as_echo "#define HAVE_LROUNDF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for lround in -lm" >&5 +$as_echo_n "checking for lround in -lm... " >&6; } +if test "${ac_cv_lib_m_lround+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char lround (); +int +main () +{ +return lround (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_lround=yes +else + ac_cv_lib_m_lround=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_lround" >&5 +$as_echo "$ac_cv_lib_m_lround" >&6; } +if test "x$ac_cv_lib_m_lround" = x""yes; then : + +$as_echo "#define HAVE_LROUND 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for lroundl in -lm" >&5 +$as_echo_n "checking for lroundl in -lm... " >&6; } +if test "${ac_cv_lib_m_lroundl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char lroundl (); +int +main () +{ +return lroundl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_lroundl=yes +else + ac_cv_lib_m_lroundl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_lroundl" >&5 +$as_echo "$ac_cv_lib_m_lroundl" >&6; } +if test "x$ac_cv_lib_m_lroundl" = x""yes; then : + +$as_echo "#define HAVE_LROUNDL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for llroundf in -lm" >&5 +$as_echo_n "checking for llroundf in -lm... " >&6; } +if test "${ac_cv_lib_m_llroundf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char llroundf (); +int +main () +{ +return llroundf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_llroundf=yes +else + ac_cv_lib_m_llroundf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_llroundf" >&5 +$as_echo "$ac_cv_lib_m_llroundf" >&6; } +if test "x$ac_cv_lib_m_llroundf" = x""yes; then : + +$as_echo "#define HAVE_LLROUNDF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for llround in -lm" >&5 +$as_echo_n "checking for llround in -lm... " >&6; } +if test "${ac_cv_lib_m_llround+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char llround (); +int +main () +{ +return llround (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_llround=yes +else + ac_cv_lib_m_llround=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_llround" >&5 +$as_echo "$ac_cv_lib_m_llround" >&6; } +if test "x$ac_cv_lib_m_llround" = x""yes; then : + +$as_echo "#define HAVE_LLROUND 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for llroundl in -lm" >&5 +$as_echo_n "checking for llroundl in -lm... " >&6; } +if test "${ac_cv_lib_m_llroundl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char llroundl (); +int +main () +{ +return llroundl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_llroundl=yes +else + ac_cv_lib_m_llroundl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_llroundl" >&5 +$as_echo "$ac_cv_lib_m_llroundl" >&6; } +if test "x$ac_cv_lib_m_llroundl" = x""yes; then : + +$as_echo "#define HAVE_LLROUNDL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for scalbnf in -lm" >&5 +$as_echo_n "checking for scalbnf in -lm... " >&6; } +if test "${ac_cv_lib_m_scalbnf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char scalbnf (); +int +main () +{ +return scalbnf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_scalbnf=yes +else + ac_cv_lib_m_scalbnf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_scalbnf" >&5 +$as_echo "$ac_cv_lib_m_scalbnf" >&6; } +if test "x$ac_cv_lib_m_scalbnf" = x""yes; then : + +$as_echo "#define HAVE_SCALBNF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for scalbn in -lm" >&5 +$as_echo_n "checking for scalbn in -lm... " >&6; } +if test "${ac_cv_lib_m_scalbn+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char scalbn (); +int +main () +{ +return scalbn (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_scalbn=yes +else + ac_cv_lib_m_scalbn=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_scalbn" >&5 +$as_echo "$ac_cv_lib_m_scalbn" >&6; } +if test "x$ac_cv_lib_m_scalbn" = x""yes; then : + +$as_echo "#define HAVE_SCALBN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for scalbnl in -lm" >&5 +$as_echo_n "checking for scalbnl in -lm... " >&6; } +if test "${ac_cv_lib_m_scalbnl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char scalbnl (); +int +main () +{ +return scalbnl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_scalbnl=yes +else + ac_cv_lib_m_scalbnl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_scalbnl" >&5 +$as_echo "$ac_cv_lib_m_scalbnl" >&6; } +if test "x$ac_cv_lib_m_scalbnl" = x""yes; then : + +$as_echo "#define HAVE_SCALBNL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sinf in -lm" >&5 +$as_echo_n "checking for sinf in -lm... " >&6; } +if test "${ac_cv_lib_m_sinf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char sinf (); +int +main () +{ +return sinf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_sinf=yes +else + ac_cv_lib_m_sinf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sinf" >&5 +$as_echo "$ac_cv_lib_m_sinf" >&6; } +if test "x$ac_cv_lib_m_sinf" = x""yes; then : + +$as_echo "#define HAVE_SINF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sin in -lm" >&5 +$as_echo_n "checking for sin in -lm... " >&6; } +if test "${ac_cv_lib_m_sin+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char sin (); +int +main () +{ +return sin (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_sin=yes +else + ac_cv_lib_m_sin=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sin" >&5 +$as_echo "$ac_cv_lib_m_sin" >&6; } +if test "x$ac_cv_lib_m_sin" = x""yes; then : + +$as_echo "#define HAVE_SIN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sinl in -lm" >&5 +$as_echo_n "checking for sinl in -lm... " >&6; } +if test "${ac_cv_lib_m_sinl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char sinl (); +int +main () +{ +return sinl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_sinl=yes +else + ac_cv_lib_m_sinl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sinl" >&5 +$as_echo "$ac_cv_lib_m_sinl" >&6; } +if test "x$ac_cv_lib_m_sinl" = x""yes; then : + +$as_echo "#define HAVE_SINL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for csinf in -lm" >&5 +$as_echo_n "checking for csinf in -lm... " >&6; } +if test "${ac_cv_lib_m_csinf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char csinf (); +int +main () +{ +return csinf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_csinf=yes +else + ac_cv_lib_m_csinf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_csinf" >&5 +$as_echo "$ac_cv_lib_m_csinf" >&6; } +if test "x$ac_cv_lib_m_csinf" = x""yes; then : + +$as_echo "#define HAVE_CSINF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for csin in -lm" >&5 +$as_echo_n "checking for csin in -lm... " >&6; } +if test "${ac_cv_lib_m_csin+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char csin (); +int +main () +{ +return csin (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_csin=yes +else + ac_cv_lib_m_csin=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_csin" >&5 +$as_echo "$ac_cv_lib_m_csin" >&6; } +if test "x$ac_cv_lib_m_csin" = x""yes; then : + +$as_echo "#define HAVE_CSIN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for csinl in -lm" >&5 +$as_echo_n "checking for csinl in -lm... " >&6; } +if test "${ac_cv_lib_m_csinl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char csinl (); +int +main () +{ +return csinl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_csinl=yes +else + ac_cv_lib_m_csinl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_csinl" >&5 +$as_echo "$ac_cv_lib_m_csinl" >&6; } +if test "x$ac_cv_lib_m_csinl" = x""yes; then : + +$as_echo "#define HAVE_CSINL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sinhf in -lm" >&5 +$as_echo_n "checking for sinhf in -lm... " >&6; } +if test "${ac_cv_lib_m_sinhf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char sinhf (); +int +main () +{ +return sinhf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_sinhf=yes +else + ac_cv_lib_m_sinhf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sinhf" >&5 +$as_echo "$ac_cv_lib_m_sinhf" >&6; } +if test "x$ac_cv_lib_m_sinhf" = x""yes; then : + +$as_echo "#define HAVE_SINHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sinh in -lm" >&5 +$as_echo_n "checking for sinh in -lm... " >&6; } +if test "${ac_cv_lib_m_sinh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char sinh (); +int +main () +{ +return sinh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_sinh=yes +else + ac_cv_lib_m_sinh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sinh" >&5 +$as_echo "$ac_cv_lib_m_sinh" >&6; } +if test "x$ac_cv_lib_m_sinh" = x""yes; then : + +$as_echo "#define HAVE_SINH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sinhl in -lm" >&5 +$as_echo_n "checking for sinhl in -lm... " >&6; } +if test "${ac_cv_lib_m_sinhl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char sinhl (); +int +main () +{ +return sinhl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_sinhl=yes +else + ac_cv_lib_m_sinhl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sinhl" >&5 +$as_echo "$ac_cv_lib_m_sinhl" >&6; } +if test "x$ac_cv_lib_m_sinhl" = x""yes; then : + +$as_echo "#define HAVE_SINHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for csinhf in -lm" >&5 +$as_echo_n "checking for csinhf in -lm... " >&6; } +if test "${ac_cv_lib_m_csinhf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char csinhf (); +int +main () +{ +return csinhf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_csinhf=yes +else + ac_cv_lib_m_csinhf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_csinhf" >&5 +$as_echo "$ac_cv_lib_m_csinhf" >&6; } +if test "x$ac_cv_lib_m_csinhf" = x""yes; then : + +$as_echo "#define HAVE_CSINHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for csinh in -lm" >&5 +$as_echo_n "checking for csinh in -lm... " >&6; } +if test "${ac_cv_lib_m_csinh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char csinh (); +int +main () +{ +return csinh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_csinh=yes +else + ac_cv_lib_m_csinh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_csinh" >&5 +$as_echo "$ac_cv_lib_m_csinh" >&6; } +if test "x$ac_cv_lib_m_csinh" = x""yes; then : + +$as_echo "#define HAVE_CSINH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for csinhl in -lm" >&5 +$as_echo_n "checking for csinhl in -lm... " >&6; } +if test "${ac_cv_lib_m_csinhl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char csinhl (); +int +main () +{ +return csinhl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_csinhl=yes +else + ac_cv_lib_m_csinhl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_csinhl" >&5 +$as_echo "$ac_cv_lib_m_csinhl" >&6; } +if test "x$ac_cv_lib_m_csinhl" = x""yes; then : + +$as_echo "#define HAVE_CSINHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrtf in -lm" >&5 +$as_echo_n "checking for sqrtf in -lm... " >&6; } +if test "${ac_cv_lib_m_sqrtf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char sqrtf (); +int +main () +{ +return sqrtf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_sqrtf=yes +else + ac_cv_lib_m_sqrtf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sqrtf" >&5 +$as_echo "$ac_cv_lib_m_sqrtf" >&6; } +if test "x$ac_cv_lib_m_sqrtf" = x""yes; then : + +$as_echo "#define HAVE_SQRTF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrt in -lm" >&5 +$as_echo_n "checking for sqrt in -lm... " >&6; } +if test "${ac_cv_lib_m_sqrt+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char sqrt (); +int +main () +{ +return sqrt (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_sqrt=yes +else + ac_cv_lib_m_sqrt=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sqrt" >&5 +$as_echo "$ac_cv_lib_m_sqrt" >&6; } +if test "x$ac_cv_lib_m_sqrt" = x""yes; then : + +$as_echo "#define HAVE_SQRT 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrtl in -lm" >&5 +$as_echo_n "checking for sqrtl in -lm... " >&6; } +if test "${ac_cv_lib_m_sqrtl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char sqrtl (); +int +main () +{ +return sqrtl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_sqrtl=yes +else + ac_cv_lib_m_sqrtl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sqrtl" >&5 +$as_echo "$ac_cv_lib_m_sqrtl" >&6; } +if test "x$ac_cv_lib_m_sqrtl" = x""yes; then : + +$as_echo "#define HAVE_SQRTL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for csqrtf in -lm" >&5 +$as_echo_n "checking for csqrtf in -lm... " >&6; } +if test "${ac_cv_lib_m_csqrtf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char csqrtf (); +int +main () +{ +return csqrtf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_csqrtf=yes +else + ac_cv_lib_m_csqrtf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_csqrtf" >&5 +$as_echo "$ac_cv_lib_m_csqrtf" >&6; } +if test "x$ac_cv_lib_m_csqrtf" = x""yes; then : + +$as_echo "#define HAVE_CSQRTF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for csqrt in -lm" >&5 +$as_echo_n "checking for csqrt in -lm... " >&6; } +if test "${ac_cv_lib_m_csqrt+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char csqrt (); +int +main () +{ +return csqrt (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_csqrt=yes +else + ac_cv_lib_m_csqrt=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_csqrt" >&5 +$as_echo "$ac_cv_lib_m_csqrt" >&6; } +if test "x$ac_cv_lib_m_csqrt" = x""yes; then : + +$as_echo "#define HAVE_CSQRT 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for csqrtl in -lm" >&5 +$as_echo_n "checking for csqrtl in -lm... " >&6; } +if test "${ac_cv_lib_m_csqrtl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char csqrtl (); +int +main () +{ +return csqrtl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_csqrtl=yes +else + ac_cv_lib_m_csqrtl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_csqrtl" >&5 +$as_echo "$ac_cv_lib_m_csqrtl" >&6; } +if test "x$ac_cv_lib_m_csqrtl" = x""yes; then : + +$as_echo "#define HAVE_CSQRTL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tanf in -lm" >&5 +$as_echo_n "checking for tanf in -lm... " >&6; } +if test "${ac_cv_lib_m_tanf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tanf (); +int +main () +{ +return tanf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_tanf=yes +else + ac_cv_lib_m_tanf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_tanf" >&5 +$as_echo "$ac_cv_lib_m_tanf" >&6; } +if test "x$ac_cv_lib_m_tanf" = x""yes; then : + +$as_echo "#define HAVE_TANF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tan in -lm" >&5 +$as_echo_n "checking for tan in -lm... " >&6; } +if test "${ac_cv_lib_m_tan+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tan (); +int +main () +{ +return tan (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_tan=yes +else + ac_cv_lib_m_tan=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_tan" >&5 +$as_echo "$ac_cv_lib_m_tan" >&6; } +if test "x$ac_cv_lib_m_tan" = x""yes; then : + +$as_echo "#define HAVE_TAN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tanl in -lm" >&5 +$as_echo_n "checking for tanl in -lm... " >&6; } +if test "${ac_cv_lib_m_tanl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tanl (); +int +main () +{ +return tanl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_tanl=yes +else + ac_cv_lib_m_tanl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_tanl" >&5 +$as_echo "$ac_cv_lib_m_tanl" >&6; } +if test "x$ac_cv_lib_m_tanl" = x""yes; then : + +$as_echo "#define HAVE_TANL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ctanf in -lm" >&5 +$as_echo_n "checking for ctanf in -lm... " >&6; } +if test "${ac_cv_lib_m_ctanf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ctanf (); +int +main () +{ +return ctanf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ctanf=yes +else + ac_cv_lib_m_ctanf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ctanf" >&5 +$as_echo "$ac_cv_lib_m_ctanf" >&6; } +if test "x$ac_cv_lib_m_ctanf" = x""yes; then : + +$as_echo "#define HAVE_CTANF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ctan in -lm" >&5 +$as_echo_n "checking for ctan in -lm... " >&6; } +if test "${ac_cv_lib_m_ctan+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ctan (); +int +main () +{ +return ctan (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ctan=yes +else + ac_cv_lib_m_ctan=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ctan" >&5 +$as_echo "$ac_cv_lib_m_ctan" >&6; } +if test "x$ac_cv_lib_m_ctan" = x""yes; then : + +$as_echo "#define HAVE_CTAN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ctanl in -lm" >&5 +$as_echo_n "checking for ctanl in -lm... " >&6; } +if test "${ac_cv_lib_m_ctanl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ctanl (); +int +main () +{ +return ctanl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ctanl=yes +else + ac_cv_lib_m_ctanl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ctanl" >&5 +$as_echo "$ac_cv_lib_m_ctanl" >&6; } +if test "x$ac_cv_lib_m_ctanl" = x""yes; then : + +$as_echo "#define HAVE_CTANL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tanhf in -lm" >&5 +$as_echo_n "checking for tanhf in -lm... " >&6; } +if test "${ac_cv_lib_m_tanhf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tanhf (); +int +main () +{ +return tanhf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_tanhf=yes +else + ac_cv_lib_m_tanhf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_tanhf" >&5 +$as_echo "$ac_cv_lib_m_tanhf" >&6; } +if test "x$ac_cv_lib_m_tanhf" = x""yes; then : + +$as_echo "#define HAVE_TANHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tanh in -lm" >&5 +$as_echo_n "checking for tanh in -lm... " >&6; } +if test "${ac_cv_lib_m_tanh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tanh (); +int +main () +{ +return tanh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_tanh=yes +else + ac_cv_lib_m_tanh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_tanh" >&5 +$as_echo "$ac_cv_lib_m_tanh" >&6; } +if test "x$ac_cv_lib_m_tanh" = x""yes; then : + +$as_echo "#define HAVE_TANH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tanhl in -lm" >&5 +$as_echo_n "checking for tanhl in -lm... " >&6; } +if test "${ac_cv_lib_m_tanhl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tanhl (); +int +main () +{ +return tanhl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_tanhl=yes +else + ac_cv_lib_m_tanhl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_tanhl" >&5 +$as_echo "$ac_cv_lib_m_tanhl" >&6; } +if test "x$ac_cv_lib_m_tanhl" = x""yes; then : + +$as_echo "#define HAVE_TANHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ctanhf in -lm" >&5 +$as_echo_n "checking for ctanhf in -lm... " >&6; } +if test "${ac_cv_lib_m_ctanhf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ctanhf (); +int +main () +{ +return ctanhf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ctanhf=yes +else + ac_cv_lib_m_ctanhf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ctanhf" >&5 +$as_echo "$ac_cv_lib_m_ctanhf" >&6; } +if test "x$ac_cv_lib_m_ctanhf" = x""yes; then : + +$as_echo "#define HAVE_CTANHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ctanh in -lm" >&5 +$as_echo_n "checking for ctanh in -lm... " >&6; } +if test "${ac_cv_lib_m_ctanh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ctanh (); +int +main () +{ +return ctanh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ctanh=yes +else + ac_cv_lib_m_ctanh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ctanh" >&5 +$as_echo "$ac_cv_lib_m_ctanh" >&6; } +if test "x$ac_cv_lib_m_ctanh" = x""yes; then : + +$as_echo "#define HAVE_CTANH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ctanhl in -lm" >&5 +$as_echo_n "checking for ctanhl in -lm... " >&6; } +if test "${ac_cv_lib_m_ctanhl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ctanhl (); +int +main () +{ +return ctanhl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ctanhl=yes +else + ac_cv_lib_m_ctanhl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ctanhl" >&5 +$as_echo "$ac_cv_lib_m_ctanhl" >&6; } +if test "x$ac_cv_lib_m_ctanhl" = x""yes; then : + +$as_echo "#define HAVE_CTANHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for truncf in -lm" >&5 +$as_echo_n "checking for truncf in -lm... " >&6; } +if test "${ac_cv_lib_m_truncf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char truncf (); +int +main () +{ +return truncf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_truncf=yes +else + ac_cv_lib_m_truncf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_truncf" >&5 +$as_echo "$ac_cv_lib_m_truncf" >&6; } +if test "x$ac_cv_lib_m_truncf" = x""yes; then : + +$as_echo "#define HAVE_TRUNCF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for trunc in -lm" >&5 +$as_echo_n "checking for trunc in -lm... " >&6; } +if test "${ac_cv_lib_m_trunc+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char trunc (); +int +main () +{ +return trunc (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_trunc=yes +else + ac_cv_lib_m_trunc=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_trunc" >&5 +$as_echo "$ac_cv_lib_m_trunc" >&6; } +if test "x$ac_cv_lib_m_trunc" = x""yes; then : + +$as_echo "#define HAVE_TRUNC 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for truncl in -lm" >&5 +$as_echo_n "checking for truncl in -lm... " >&6; } +if test "${ac_cv_lib_m_truncl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char truncl (); +int +main () +{ +return truncl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_truncl=yes +else + ac_cv_lib_m_truncl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_truncl" >&5 +$as_echo "$ac_cv_lib_m_truncl" >&6; } +if test "x$ac_cv_lib_m_truncl" = x""yes; then : + +$as_echo "#define HAVE_TRUNCL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for erff in -lm" >&5 +$as_echo_n "checking for erff in -lm... " >&6; } +if test "${ac_cv_lib_m_erff+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char erff (); +int +main () +{ +return erff (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_erff=yes +else + ac_cv_lib_m_erff=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_erff" >&5 +$as_echo "$ac_cv_lib_m_erff" >&6; } +if test "x$ac_cv_lib_m_erff" = x""yes; then : + +$as_echo "#define HAVE_ERFF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for erf in -lm" >&5 +$as_echo_n "checking for erf in -lm... " >&6; } +if test "${ac_cv_lib_m_erf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char erf (); +int +main () +{ +return erf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_erf=yes +else + ac_cv_lib_m_erf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_erf" >&5 +$as_echo "$ac_cv_lib_m_erf" >&6; } +if test "x$ac_cv_lib_m_erf" = x""yes; then : + +$as_echo "#define HAVE_ERF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for erfl in -lm" >&5 +$as_echo_n "checking for erfl in -lm... " >&6; } +if test "${ac_cv_lib_m_erfl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char erfl (); +int +main () +{ +return erfl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_erfl=yes +else + ac_cv_lib_m_erfl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_erfl" >&5 +$as_echo "$ac_cv_lib_m_erfl" >&6; } +if test "x$ac_cv_lib_m_erfl" = x""yes; then : + +$as_echo "#define HAVE_ERFL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for erfcf in -lm" >&5 +$as_echo_n "checking for erfcf in -lm... " >&6; } +if test "${ac_cv_lib_m_erfcf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char erfcf (); +int +main () +{ +return erfcf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_erfcf=yes +else + ac_cv_lib_m_erfcf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_erfcf" >&5 +$as_echo "$ac_cv_lib_m_erfcf" >&6; } +if test "x$ac_cv_lib_m_erfcf" = x""yes; then : + +$as_echo "#define HAVE_ERFCF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for erfc in -lm" >&5 +$as_echo_n "checking for erfc in -lm... " >&6; } +if test "${ac_cv_lib_m_erfc+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char erfc (); +int +main () +{ +return erfc (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_erfc=yes +else + ac_cv_lib_m_erfc=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_erfc" >&5 +$as_echo "$ac_cv_lib_m_erfc" >&6; } +if test "x$ac_cv_lib_m_erfc" = x""yes; then : + +$as_echo "#define HAVE_ERFC 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for erfcl in -lm" >&5 +$as_echo_n "checking for erfcl in -lm... " >&6; } +if test "${ac_cv_lib_m_erfcl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char erfcl (); +int +main () +{ +return erfcl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_erfcl=yes +else + ac_cv_lib_m_erfcl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_erfcl" >&5 +$as_echo "$ac_cv_lib_m_erfcl" >&6; } +if test "x$ac_cv_lib_m_erfcl" = x""yes; then : + +$as_echo "#define HAVE_ERFCL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for j0f in -lm" >&5 +$as_echo_n "checking for j0f in -lm... " >&6; } +if test "${ac_cv_lib_m_j0f+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char j0f (); +int +main () +{ +return j0f (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_j0f=yes +else + ac_cv_lib_m_j0f=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_j0f" >&5 +$as_echo "$ac_cv_lib_m_j0f" >&6; } +if test "x$ac_cv_lib_m_j0f" = x""yes; then : + +$as_echo "#define HAVE_J0F 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for j0 in -lm" >&5 +$as_echo_n "checking for j0 in -lm... " >&6; } +if test "${ac_cv_lib_m_j0+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char j0 (); +int +main () +{ +return j0 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_j0=yes +else + ac_cv_lib_m_j0=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_j0" >&5 +$as_echo "$ac_cv_lib_m_j0" >&6; } +if test "x$ac_cv_lib_m_j0" = x""yes; then : + +$as_echo "#define HAVE_J0 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for j0l in -lm" >&5 +$as_echo_n "checking for j0l in -lm... " >&6; } +if test "${ac_cv_lib_m_j0l+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char j0l (); +int +main () +{ +return j0l (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_j0l=yes +else + ac_cv_lib_m_j0l=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_j0l" >&5 +$as_echo "$ac_cv_lib_m_j0l" >&6; } +if test "x$ac_cv_lib_m_j0l" = x""yes; then : + +$as_echo "#define HAVE_J0L 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for j1f in -lm" >&5 +$as_echo_n "checking for j1f in -lm... " >&6; } +if test "${ac_cv_lib_m_j1f+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char j1f (); +int +main () +{ +return j1f (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_j1f=yes +else + ac_cv_lib_m_j1f=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_j1f" >&5 +$as_echo "$ac_cv_lib_m_j1f" >&6; } +if test "x$ac_cv_lib_m_j1f" = x""yes; then : + +$as_echo "#define HAVE_J1F 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for j1 in -lm" >&5 +$as_echo_n "checking for j1 in -lm... " >&6; } +if test "${ac_cv_lib_m_j1+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char j1 (); +int +main () +{ +return j1 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_j1=yes +else + ac_cv_lib_m_j1=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_j1" >&5 +$as_echo "$ac_cv_lib_m_j1" >&6; } +if test "x$ac_cv_lib_m_j1" = x""yes; then : + +$as_echo "#define HAVE_J1 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for j1l in -lm" >&5 +$as_echo_n "checking for j1l in -lm... " >&6; } +if test "${ac_cv_lib_m_j1l+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char j1l (); +int +main () +{ +return j1l (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_j1l=yes +else + ac_cv_lib_m_j1l=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_j1l" >&5 +$as_echo "$ac_cv_lib_m_j1l" >&6; } +if test "x$ac_cv_lib_m_j1l" = x""yes; then : + +$as_echo "#define HAVE_J1L 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for jnf in -lm" >&5 +$as_echo_n "checking for jnf in -lm... " >&6; } +if test "${ac_cv_lib_m_jnf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char jnf (); +int +main () +{ +return jnf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_jnf=yes +else + ac_cv_lib_m_jnf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_jnf" >&5 +$as_echo "$ac_cv_lib_m_jnf" >&6; } +if test "x$ac_cv_lib_m_jnf" = x""yes; then : + +$as_echo "#define HAVE_JNF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for jn in -lm" >&5 +$as_echo_n "checking for jn in -lm... " >&6; } +if test "${ac_cv_lib_m_jn+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char jn (); +int +main () +{ +return jn (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_jn=yes +else + ac_cv_lib_m_jn=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_jn" >&5 +$as_echo "$ac_cv_lib_m_jn" >&6; } +if test "x$ac_cv_lib_m_jn" = x""yes; then : + +$as_echo "#define HAVE_JN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for jnl in -lm" >&5 +$as_echo_n "checking for jnl in -lm... " >&6; } +if test "${ac_cv_lib_m_jnl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char jnl (); +int +main () +{ +return jnl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_jnl=yes +else + ac_cv_lib_m_jnl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_jnl" >&5 +$as_echo "$ac_cv_lib_m_jnl" >&6; } +if test "x$ac_cv_lib_m_jnl" = x""yes; then : + +$as_echo "#define HAVE_JNL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for y0f in -lm" >&5 +$as_echo_n "checking for y0f in -lm... " >&6; } +if test "${ac_cv_lib_m_y0f+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char y0f (); +int +main () +{ +return y0f (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_y0f=yes +else + ac_cv_lib_m_y0f=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_y0f" >&5 +$as_echo "$ac_cv_lib_m_y0f" >&6; } +if test "x$ac_cv_lib_m_y0f" = x""yes; then : + +$as_echo "#define HAVE_Y0F 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for y0 in -lm" >&5 +$as_echo_n "checking for y0 in -lm... " >&6; } +if test "${ac_cv_lib_m_y0+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char y0 (); +int +main () +{ +return y0 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_y0=yes +else + ac_cv_lib_m_y0=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_y0" >&5 +$as_echo "$ac_cv_lib_m_y0" >&6; } +if test "x$ac_cv_lib_m_y0" = x""yes; then : + +$as_echo "#define HAVE_Y0 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for y0l in -lm" >&5 +$as_echo_n "checking for y0l in -lm... " >&6; } +if test "${ac_cv_lib_m_y0l+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char y0l (); +int +main () +{ +return y0l (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_y0l=yes +else + ac_cv_lib_m_y0l=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_y0l" >&5 +$as_echo "$ac_cv_lib_m_y0l" >&6; } +if test "x$ac_cv_lib_m_y0l" = x""yes; then : + +$as_echo "#define HAVE_Y0L 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for y1f in -lm" >&5 +$as_echo_n "checking for y1f in -lm... " >&6; } +if test "${ac_cv_lib_m_y1f+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char y1f (); +int +main () +{ +return y1f (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_y1f=yes +else + ac_cv_lib_m_y1f=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_y1f" >&5 +$as_echo "$ac_cv_lib_m_y1f" >&6; } +if test "x$ac_cv_lib_m_y1f" = x""yes; then : + +$as_echo "#define HAVE_Y1F 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for y1 in -lm" >&5 +$as_echo_n "checking for y1 in -lm... " >&6; } +if test "${ac_cv_lib_m_y1+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char y1 (); +int +main () +{ +return y1 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_y1=yes +else + ac_cv_lib_m_y1=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_y1" >&5 +$as_echo "$ac_cv_lib_m_y1" >&6; } +if test "x$ac_cv_lib_m_y1" = x""yes; then : + +$as_echo "#define HAVE_Y1 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for y1l in -lm" >&5 +$as_echo_n "checking for y1l in -lm... " >&6; } +if test "${ac_cv_lib_m_y1l+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char y1l (); +int +main () +{ +return y1l (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_y1l=yes +else + ac_cv_lib_m_y1l=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_y1l" >&5 +$as_echo "$ac_cv_lib_m_y1l" >&6; } +if test "x$ac_cv_lib_m_y1l" = x""yes; then : + +$as_echo "#define HAVE_Y1L 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ynf in -lm" >&5 +$as_echo_n "checking for ynf in -lm... " >&6; } +if test "${ac_cv_lib_m_ynf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ynf (); +int +main () +{ +return ynf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ynf=yes +else + ac_cv_lib_m_ynf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ynf" >&5 +$as_echo "$ac_cv_lib_m_ynf" >&6; } +if test "x$ac_cv_lib_m_ynf" = x""yes; then : + +$as_echo "#define HAVE_YNF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for yn in -lm" >&5 +$as_echo_n "checking for yn in -lm... " >&6; } +if test "${ac_cv_lib_m_yn+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char yn (); +int +main () +{ +return yn (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_yn=yes +else + ac_cv_lib_m_yn=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_yn" >&5 +$as_echo "$ac_cv_lib_m_yn" >&6; } +if test "x$ac_cv_lib_m_yn" = x""yes; then : + +$as_echo "#define HAVE_YN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ynl in -lm" >&5 +$as_echo_n "checking for ynl in -lm... " >&6; } +if test "${ac_cv_lib_m_ynl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char ynl (); +int +main () +{ +return ynl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_ynl=yes +else + ac_cv_lib_m_ynl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_ynl" >&5 +$as_echo "$ac_cv_lib_m_ynl" >&6; } +if test "x$ac_cv_lib_m_ynl" = x""yes; then : + +$as_echo "#define HAVE_YNL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tgamma in -lm" >&5 +$as_echo_n "checking for tgamma in -lm... " >&6; } +if test "${ac_cv_lib_m_tgamma+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tgamma (); +int +main () +{ +return tgamma (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_tgamma=yes +else + ac_cv_lib_m_tgamma=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_tgamma" >&5 +$as_echo "$ac_cv_lib_m_tgamma" >&6; } +if test "x$ac_cv_lib_m_tgamma" = x""yes; then : + +$as_echo "#define HAVE_TGAMMA 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tgammaf in -lm" >&5 +$as_echo_n "checking for tgammaf in -lm... " >&6; } +if test "${ac_cv_lib_m_tgammaf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tgammaf (); +int +main () +{ +return tgammaf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_tgammaf=yes +else + ac_cv_lib_m_tgammaf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_tgammaf" >&5 +$as_echo "$ac_cv_lib_m_tgammaf" >&6; } +if test "x$ac_cv_lib_m_tgammaf" = x""yes; then : + +$as_echo "#define HAVE_TGAMMAF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for tgammal in -lm" >&5 +$as_echo_n "checking for tgammal in -lm... " >&6; } +if test "${ac_cv_lib_m_tgammal+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char tgammal (); +int +main () +{ +return tgammal (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_tgammal=yes +else + ac_cv_lib_m_tgammal=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_tgammal" >&5 +$as_echo "$ac_cv_lib_m_tgammal" >&6; } +if test "x$ac_cv_lib_m_tgammal" = x""yes; then : + +$as_echo "#define HAVE_TGAMMAL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for lgamma in -lm" >&5 +$as_echo_n "checking for lgamma in -lm... " >&6; } +if test "${ac_cv_lib_m_lgamma+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char lgamma (); +int +main () +{ +return lgamma (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_lgamma=yes +else + ac_cv_lib_m_lgamma=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_lgamma" >&5 +$as_echo "$ac_cv_lib_m_lgamma" >&6; } +if test "x$ac_cv_lib_m_lgamma" = x""yes; then : + +$as_echo "#define HAVE_LGAMMA 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for lgammaf in -lm" >&5 +$as_echo_n "checking for lgammaf in -lm... " >&6; } +if test "${ac_cv_lib_m_lgammaf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char lgammaf (); +int +main () +{ +return lgammaf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_lgammaf=yes +else + ac_cv_lib_m_lgammaf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_lgammaf" >&5 +$as_echo "$ac_cv_lib_m_lgammaf" >&6; } +if test "x$ac_cv_lib_m_lgammaf" = x""yes; then : + +$as_echo "#define HAVE_LGAMMAF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for lgammal in -lm" >&5 +$as_echo_n "checking for lgammal in -lm... " >&6; } +if test "${ac_cv_lib_m_lgammal+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char lgammal (); +int +main () +{ +return lgammal (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_lgammal=yes +else + ac_cv_lib_m_lgammal=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_lgammal" >&5 +$as_echo "$ac_cv_lib_m_lgammal" >&6; } +if test "x$ac_cv_lib_m_lgammal" = x""yes; then : + +$as_echo "#define HAVE_LGAMMAL 1" >>confdefs.h + +fi + + +# Check for GFORTRAN_C99_1.1 funcs +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cacos in -lm" >&5 +$as_echo_n "checking for cacos in -lm... " >&6; } +if test "${ac_cv_lib_m_cacos+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cacos (); +int +main () +{ +return cacos (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cacos=yes +else + ac_cv_lib_m_cacos=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cacos" >&5 +$as_echo "$ac_cv_lib_m_cacos" >&6; } +if test "x$ac_cv_lib_m_cacos" = x""yes; then : + +$as_echo "#define HAVE_CACOS 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cacosf in -lm" >&5 +$as_echo_n "checking for cacosf in -lm... " >&6; } +if test "${ac_cv_lib_m_cacosf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cacosf (); +int +main () +{ +return cacosf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cacosf=yes +else + ac_cv_lib_m_cacosf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cacosf" >&5 +$as_echo "$ac_cv_lib_m_cacosf" >&6; } +if test "x$ac_cv_lib_m_cacosf" = x""yes; then : + +$as_echo "#define HAVE_CACOSF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cacosh in -lm" >&5 +$as_echo_n "checking for cacosh in -lm... " >&6; } +if test "${ac_cv_lib_m_cacosh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cacosh (); +int +main () +{ +return cacosh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cacosh=yes +else + ac_cv_lib_m_cacosh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cacosh" >&5 +$as_echo "$ac_cv_lib_m_cacosh" >&6; } +if test "x$ac_cv_lib_m_cacosh" = x""yes; then : + +$as_echo "#define HAVE_CACOSH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cacoshf in -lm" >&5 +$as_echo_n "checking for cacoshf in -lm... " >&6; } +if test "${ac_cv_lib_m_cacoshf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cacoshf (); +int +main () +{ +return cacoshf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cacoshf=yes +else + ac_cv_lib_m_cacoshf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cacoshf" >&5 +$as_echo "$ac_cv_lib_m_cacoshf" >&6; } +if test "x$ac_cv_lib_m_cacoshf" = x""yes; then : + +$as_echo "#define HAVE_CACOSHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cacoshl in -lm" >&5 +$as_echo_n "checking for cacoshl in -lm... " >&6; } +if test "${ac_cv_lib_m_cacoshl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cacoshl (); +int +main () +{ +return cacoshl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cacoshl=yes +else + ac_cv_lib_m_cacoshl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cacoshl" >&5 +$as_echo "$ac_cv_lib_m_cacoshl" >&6; } +if test "x$ac_cv_lib_m_cacoshl" = x""yes; then : + +$as_echo "#define HAVE_CACOSHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cacosl in -lm" >&5 +$as_echo_n "checking for cacosl in -lm... " >&6; } +if test "${ac_cv_lib_m_cacosl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cacosl (); +int +main () +{ +return cacosl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_cacosl=yes +else + ac_cv_lib_m_cacosl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_cacosl" >&5 +$as_echo "$ac_cv_lib_m_cacosl" >&6; } +if test "x$ac_cv_lib_m_cacosl" = x""yes; then : + +$as_echo "#define HAVE_CACOSL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for casin in -lm" >&5 +$as_echo_n "checking for casin in -lm... " >&6; } +if test "${ac_cv_lib_m_casin+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char casin (); +int +main () +{ +return casin (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_casin=yes +else + ac_cv_lib_m_casin=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_casin" >&5 +$as_echo "$ac_cv_lib_m_casin" >&6; } +if test "x$ac_cv_lib_m_casin" = x""yes; then : + +$as_echo "#define HAVE_CASIN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for casinf in -lm" >&5 +$as_echo_n "checking for casinf in -lm... " >&6; } +if test "${ac_cv_lib_m_casinf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char casinf (); +int +main () +{ +return casinf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_casinf=yes +else + ac_cv_lib_m_casinf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_casinf" >&5 +$as_echo "$ac_cv_lib_m_casinf" >&6; } +if test "x$ac_cv_lib_m_casinf" = x""yes; then : + +$as_echo "#define HAVE_CASINF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for casinh in -lm" >&5 +$as_echo_n "checking for casinh in -lm... " >&6; } +if test "${ac_cv_lib_m_casinh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char casinh (); +int +main () +{ +return casinh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_casinh=yes +else + ac_cv_lib_m_casinh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_casinh" >&5 +$as_echo "$ac_cv_lib_m_casinh" >&6; } +if test "x$ac_cv_lib_m_casinh" = x""yes; then : + +$as_echo "#define HAVE_CASINH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for casinhf in -lm" >&5 +$as_echo_n "checking for casinhf in -lm... " >&6; } +if test "${ac_cv_lib_m_casinhf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char casinhf (); +int +main () +{ +return casinhf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_casinhf=yes +else + ac_cv_lib_m_casinhf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_casinhf" >&5 +$as_echo "$ac_cv_lib_m_casinhf" >&6; } +if test "x$ac_cv_lib_m_casinhf" = x""yes; then : + +$as_echo "#define HAVE_CASINHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for casinhl in -lm" >&5 +$as_echo_n "checking for casinhl in -lm... " >&6; } +if test "${ac_cv_lib_m_casinhl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char casinhl (); +int +main () +{ +return casinhl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_casinhl=yes +else + ac_cv_lib_m_casinhl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_casinhl" >&5 +$as_echo "$ac_cv_lib_m_casinhl" >&6; } +if test "x$ac_cv_lib_m_casinhl" = x""yes; then : + +$as_echo "#define HAVE_CASINHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for casinl in -lm" >&5 +$as_echo_n "checking for casinl in -lm... " >&6; } +if test "${ac_cv_lib_m_casinl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char casinl (); +int +main () +{ +return casinl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_casinl=yes +else + ac_cv_lib_m_casinl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_casinl" >&5 +$as_echo "$ac_cv_lib_m_casinl" >&6; } +if test "x$ac_cv_lib_m_casinl" = x""yes; then : + +$as_echo "#define HAVE_CASINL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for catan in -lm" >&5 +$as_echo_n "checking for catan in -lm... " >&6; } +if test "${ac_cv_lib_m_catan+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char catan (); +int +main () +{ +return catan (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_catan=yes +else + ac_cv_lib_m_catan=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_catan" >&5 +$as_echo "$ac_cv_lib_m_catan" >&6; } +if test "x$ac_cv_lib_m_catan" = x""yes; then : + +$as_echo "#define HAVE_CATAN 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for catanf in -lm" >&5 +$as_echo_n "checking for catanf in -lm... " >&6; } +if test "${ac_cv_lib_m_catanf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char catanf (); +int +main () +{ +return catanf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_catanf=yes +else + ac_cv_lib_m_catanf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_catanf" >&5 +$as_echo "$ac_cv_lib_m_catanf" >&6; } +if test "x$ac_cv_lib_m_catanf" = x""yes; then : + +$as_echo "#define HAVE_CATANF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for catanh in -lm" >&5 +$as_echo_n "checking for catanh in -lm... " >&6; } +if test "${ac_cv_lib_m_catanh+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char catanh (); +int +main () +{ +return catanh (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_catanh=yes +else + ac_cv_lib_m_catanh=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_catanh" >&5 +$as_echo "$ac_cv_lib_m_catanh" >&6; } +if test "x$ac_cv_lib_m_catanh" = x""yes; then : + +$as_echo "#define HAVE_CATANH 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for catanhf in -lm" >&5 +$as_echo_n "checking for catanhf in -lm... " >&6; } +if test "${ac_cv_lib_m_catanhf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char catanhf (); +int +main () +{ +return catanhf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_catanhf=yes +else + ac_cv_lib_m_catanhf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_catanhf" >&5 +$as_echo "$ac_cv_lib_m_catanhf" >&6; } +if test "x$ac_cv_lib_m_catanhf" = x""yes; then : + +$as_echo "#define HAVE_CATANHF 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for catanhl in -lm" >&5 +$as_echo_n "checking for catanhl in -lm... " >&6; } +if test "${ac_cv_lib_m_catanhl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char catanhl (); +int +main () +{ +return catanhl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_catanhl=yes +else + ac_cv_lib_m_catanhl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_catanhl" >&5 +$as_echo "$ac_cv_lib_m_catanhl" >&6; } +if test "x$ac_cv_lib_m_catanhl" = x""yes; then : + +$as_echo "#define HAVE_CATANHL 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for catanl in -lm" >&5 +$as_echo_n "checking for catanl in -lm... " >&6; } +if test "${ac_cv_lib_m_catanl+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char catanl (); +int +main () +{ +return catanl (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_catanl=yes +else + ac_cv_lib_m_catanl=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_catanl" >&5 +$as_echo "$ac_cv_lib_m_catanl" >&6; } +if test "x$ac_cv_lib_m_catanl" = x""yes; then : + +$as_echo "#define HAVE_CATANL 1" >>confdefs.h + +fi + + +# On AIX, clog is present in libm as __clog +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __clog in -lm" >&5 +$as_echo_n "checking for __clog in -lm... " >&6; } +if test "${ac_cv_lib_m___clog+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char __clog (); +int +main () +{ +return __clog (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m___clog=yes +else + ac_cv_lib_m___clog=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m___clog" >&5 +$as_echo "$ac_cv_lib_m___clog" >&6; } +if test "x$ac_cv_lib_m___clog" = x""yes; then : + +$as_echo "#define HAVE_CLOG 1" >>confdefs.h + +fi + + +# Check whether the system has a working stat() + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the target stat is reliable" >&5 +$as_echo_n "checking whether the target stat is reliable... " >&6; } +if test "${libgfor_cv_have_working_stat+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test "$cross_compiling" = yes; then : + +case "${target}" in + *mingw*) libgfor_cv_have_working_stat=no ;; + *) libgfor_cv_have_working_stat=yes;; +esac +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include +#include +#include +#include + +int main () +{ + FILE *f, *g; + struct stat st1, st2; + + f = fopen ("foo", "w"); + g = fopen ("bar", "w"); + if (stat ("foo", &st1) != 0 || stat ("bar", &st2)) + return 1; + if (st1.st_dev == st2.st_dev && st1.st_ino == st2.st_ino) + return 1; + fclose(f); + fclose(g); + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + libgfor_cv_have_working_stat=yes +else + libgfor_cv_have_working_stat=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_working_stat" >&5 +$as_echo "$libgfor_cv_have_working_stat" >&6; } +if test x"$libgfor_cv_have_working_stat" = xyes; then + +$as_echo "#define HAVE_WORKING_STAT 1" >>confdefs.h + +fi + +# Check whether __mingw_snprintf() is present + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether __mingw_snprintf is present" >&5 +$as_echo_n "checking whether __mingw_snprintf is present... " >&6; } +if test "${libgfor_cv_have_mingw_snprintf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include +extern int __mingw_snprintf (char *, size_t, const char *, ...); + +int +main () +{ + +__mingw_snprintf (NULL, 0, "%d\n", 1); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "libgfor_cv_have_mingw_snprintf=yes" +else + eval "libgfor_cv_have_mingw_snprintf=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_mingw_snprintf" >&5 +$as_echo "$libgfor_cv_have_mingw_snprintf" >&6; } + if test x"$libgfor_cv_have_mingw_snprintf" = xyes; then + +$as_echo "#define HAVE_MINGW_SNPRINTF 1" >>confdefs.h + + fi + + +# Check for a broken powf implementation + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether powf is broken" >&5 +$as_echo_n "checking whether powf is broken... " >&6; } +if test "${libgfor_cv_have_broken_powf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + +case "${target}" in + hppa*64*-*-hpux*) libgfor_cv_have_broken_powf=yes ;; + *) libgfor_cv_have_broken_powf=no;; +esac +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_broken_powf" >&5 +$as_echo "$libgfor_cv_have_broken_powf" >&6; } + if test x"$libgfor_cv_have_broken_powf" = xyes; then + +$as_echo "#define HAVE_BROKEN_POWF 1" >>confdefs.h + + fi + + +# Check whether libquadmath should be used +# Check whether --enable-libquadmath-support was given. +if test "${enable_libquadmath_support+set}" = set; then : + enableval=$enable_libquadmath_support; ENABLE_LIBQUADMATH_SUPPORT=$enableval +else + ENABLE_LIBQUADMATH_SUPPORT=yes +fi + +enable_libquadmath_support= +if test "${ENABLE_LIBQUADMATH_SUPPORT}" = "no" ; then + enable_libquadmath_support=no +fi + +# Check whether we have a __float128 type, depends on enable_libquadmath_support + + LIBQUADSPEC= + + if test "x$enable_libquadmath_support" != xno; then + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we have a usable __float128 type" >&5 +$as_echo_n "checking whether we have a usable __float128 type... " >&6; } +if test "${libgfor_cv_have_float128+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test x$gcc_no_link = xyes; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + typedef _Complex float __attribute__((mode(TC))) __complex128; + + __float128 foo (__float128 x) + { + + __complex128 z1, z2; + + z1 = x; + z2 = x / 7.Q; + z2 /= z1; + + return (__float128) z2; + } + + __float128 bar (__float128 x) + { + return x * __builtin_huge_valq (); + } + +int +main () +{ + + foo (1.2Q); + bar (1.2Q); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + + libgfor_cv_have_float128=yes + +else + + libgfor_cv_have_float128=no + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + typedef _Complex float __attribute__((mode(TC))) __complex128; + + __float128 foo (__float128 x) + { + + __complex128 z1, z2; + + z1 = x; + z2 = x / 7.Q; + z2 /= z1; + + return (__float128) z2; + } + + __float128 bar (__float128 x) + { + return x * __builtin_huge_valq (); + } + +int +main () +{ + + foo (1.2Q); + bar (1.2Q); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + + libgfor_cv_have_float128=yes + +else + + libgfor_cv_have_float128=no + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_float128" >&5 +$as_echo "$libgfor_cv_have_float128" >&6; } + + if test "x$libgfor_cv_have_float128" = xyes; then + +$as_echo "#define HAVE_FLOAT128 1" >>confdefs.h + + + ac_xsave_c_werror_flag=$ac_c_werror_flag + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether --as-needed works" >&5 +$as_echo_n "checking whether --as-needed works... " >&6; } +if test "${libgfor_cv_have_as_needed+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS -Wl,--as-needed -lm -Wl,--no-as-needed" + libgfor_cv_have_as_needed=no + +ac_c_werror_flag=yes + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + libgfor_cv_have_as_needed=yes +else + libgfor_cv_have_as_needed=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS="$save_LDFLAGS" + ac_c_werror_flag=$ac_xsave_c_werror_flag + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_as_needed" >&5 +$as_echo "$libgfor_cv_have_as_needed" >&6; } + + if test "x$libgfor_cv_have_as_needed" = xyes; then + LIBQUADSPEC="%{static-libgfortran:--as-needed} -lquadmath %{static-libgfortran:--no-as-needed}" + else + LIBQUADSPEC="-lquadmath" + fi + if test -f ../libquadmath/libquadmath.la; then + LIBQUADLIB=../libquadmath/libquadmath.la + LIBQUADLIB_DEP=../libquadmath/libquadmath.la + LIBQUADINCLUDE='-I$(srcdir)/../libquadmath' + else + LIBQUADLIB="-lquadmath" + LIBQUADLIB_DEP= + LIBQUADINCLUDE= + fi + fi + else + # for --disable-quadmath + LIBQUADLIB= + LIBQUADLIB_DEP= + LIBQUADINCLUDE= + fi + + + + + + + if test "x$libgfor_cv_have_float128" = xyes; then + LIBGFOR_BUILD_QUAD_TRUE= + LIBGFOR_BUILD_QUAD_FALSE='#' +else + LIBGFOR_BUILD_QUAD_TRUE='#' + LIBGFOR_BUILD_QUAD_FALSE= +fi + + + +# Check for GNU libc feenableexcept +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for feenableexcept in -lm" >&5 +$as_echo_n "checking for feenableexcept in -lm... " >&6; } +if test "${ac_cv_lib_m_feenableexcept+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char feenableexcept (); +int +main () +{ +return feenableexcept (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_feenableexcept=yes +else + ac_cv_lib_m_feenableexcept=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_feenableexcept" >&5 +$as_echo "$ac_cv_lib_m_feenableexcept" >&6; } +if test "x$ac_cv_lib_m_feenableexcept" = x""yes; then : + have_feenableexcept=yes +$as_echo "#define HAVE_FEENABLEEXCEPT 1" >>confdefs.h + +fi + + +# At least for glibc and Tru64, clock_gettime is in librt. But don't +# pull that in if it still doesn't give us the function we want. This +# test is copied from libgomp, and modified to not link in -lrt as +# libgfortran calls clock_gettime via a weak reference if it's found +# in librt. +if test $ac_cv_func_clock_gettime = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clock_gettime in -lrt" >&5 +$as_echo_n "checking for clock_gettime in -lrt... " >&6; } +if test "${ac_cv_lib_rt_clock_gettime+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lrt $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char clock_gettime (); +int +main () +{ +return clock_gettime (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_rt_clock_gettime=yes +else + ac_cv_lib_rt_clock_gettime=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_rt_clock_gettime" >&5 +$as_echo "$ac_cv_lib_rt_clock_gettime" >&6; } +if test "x$ac_cv_lib_rt_clock_gettime" = x""yes; then : + +$as_echo "#define HAVE_CLOCK_GETTIME_LIBRT 1" >>confdefs.h + +fi + +fi + +# Check for SysV fpsetmask + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether fpsetmask is present" >&5 +$as_echo_n "checking whether fpsetmask is present... " >&6; } +if test "${libgfor_cv_have_fpsetmask+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#if HAVE_FLOATINGPOINT_H +# include +#endif /* HAVE_FLOATINGPOINT_H */ +#if HAVE_IEEEFP_H +# include +#endif /* HAVE_IEEEFP_H */ +int +main () +{ +fpsetmask(0); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "libgfor_cv_have_fpsetmask=yes" +else + eval "libgfor_cv_have_fpsetmask=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_fpsetmask" >&5 +$as_echo "$libgfor_cv_have_fpsetmask" >&6; } + if test x"$libgfor_cv_have_fpsetmask" = xyes; then + have_fpsetmask=yes + +$as_echo "#define HAVE_FPSETMASK 1" >>confdefs.h + + fi + + +# Check for AIX fp_trap and fp_enable +ac_fn_c_check_func "$LINENO" "fp_trap" "ac_cv_func_fp_trap" +if test "x$ac_cv_func_fp_trap" = x""yes; then : + have_fp_trap=yes +$as_echo "#define HAVE_FP_TRAP 1" >>confdefs.h + +fi + +ac_fn_c_check_func "$LINENO" "fp_enable" "ac_cv_func_fp_enable" +if test "x$ac_cv_func_fp_enable" = x""yes; then : + have_fp_enable=yes +$as_echo "#define HAVE_FP_ENABLE 1" >>confdefs.h + +fi + + +# Runs configure.host to set up necessary host-dependent shell variables. +# We then display a message about it, and propagate them through the +# build chain. +. ${srcdir}/configure.host +{ $as_echo "$as_me:${as_lineno-$LINENO}: FPU dependent file will be ${fpu_host}.h" >&5 +$as_echo "$as_me: FPU dependent file will be ${fpu_host}.h" >&6;} +FPU_HOST_HEADER=config/${fpu_host}.h + + +# Some targets require additional compiler options for IEEE compatibility. +IEEE_FLAGS="${ieee_flags}" + + + +# Check for POSIX getpwuid_r +# +# There are two versions of getpwuid_r, the POSIX one with 5 +# arguments, and another one with 4 arguments used by at least HP-UX +# 10.2. +if test "$ac_cv_func_getpwuid_r" = "yes"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking POSIX version of getpwuid_r with 5 arguments" >&5 +$as_echo_n "checking POSIX version of getpwuid_r with 5 arguments... " >&6; } +if test "${libgfor_cv_posix_getpwuid_r+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include +#include +#include +int +main () +{ + + getpwuid_r(0, NULL, NULL, 0, NULL); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + libgfor_cv_posix_getpwuid_r="yes" +else + libgfor_cv_posix_getpwuid_r="no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_posix_getpwuid_r" >&5 +$as_echo "$libgfor_cv_posix_getpwuid_r" >&6; } +fi +if test "$libgfor_cv_posix_getpwuid_r" = "yes"; then + +$as_echo "#define HAVE_POSIX_GETPWUID_R 1" >>confdefs.h + +fi + + +# Check out attribute support. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the target supports hidden visibility" >&5 +$as_echo_n "checking whether the target supports hidden visibility... " >&6; } +if test "${libgfor_cv_have_attribute_visibility+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Werror" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +void __attribute__((visibility("hidden"))) foo(void) { } +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + libgfor_cv_have_attribute_visibility=yes +else + libgfor_cv_have_attribute_visibility=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CFLAGS="$save_CFLAGS" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_attribute_visibility" >&5 +$as_echo "$libgfor_cv_have_attribute_visibility" >&6; } + if test $libgfor_cv_have_attribute_visibility = yes; then + +$as_echo "#define HAVE_ATTRIBUTE_VISIBILITY 1" >>confdefs.h + + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the target supports dllexport" >&5 +$as_echo_n "checking whether the target supports dllexport... " >&6; } +if test "${libgfor_cv_have_attribute_dllexport+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Werror" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +void __attribute__((dllexport)) foo(void) { } +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + libgfor_cv_have_attribute_dllexport=yes +else + libgfor_cv_have_attribute_dllexport=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CFLAGS="$save_CFLAGS" +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_attribute_dllexport" >&5 +$as_echo "$libgfor_cv_have_attribute_dllexport" >&6; } + if test $libgfor_cv_have_attribute_dllexport = yes; then + +$as_echo "#define HAVE_ATTRIBUTE_DLLEXPORT 1" >>confdefs.h + + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the target supports symbol aliases" >&5 +$as_echo_n "checking whether the target supports symbol aliases... " >&6; } +if test "${libgfor_cv_have_attribute_alias+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +void foo(void) { } +extern void bar(void) __attribute__((alias("foo"))); +int +main () +{ +bar(); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + libgfor_cv_have_attribute_alias=yes +else + libgfor_cv_have_attribute_alias=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_attribute_alias" >&5 +$as_echo "$libgfor_cv_have_attribute_alias" >&6; } + if test $libgfor_cv_have_attribute_alias = yes; then + +$as_echo "#define HAVE_ATTRIBUTE_ALIAS 1" >>confdefs.h + + fi + +# Check out sync builtins support. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the target supports __sync_fetch_and_add" >&5 +$as_echo_n "checking whether the target supports __sync_fetch_and_add... " >&6; } +if test "${libgfor_cv_have_sync_fetch_and_add+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test x$gcc_no_link = xyes; then + as_fn_error "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +int foovar = 0; +int +main () +{ + +if (foovar <= 0) return __sync_fetch_and_add (&foovar, 1); +if (foovar > 10) return __sync_add_and_fetch (&foovar, -1); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + libgfor_cv_have_sync_fetch_and_add=yes +else + libgfor_cv_have_sync_fetch_and_add=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_sync_fetch_and_add" >&5 +$as_echo "$libgfor_cv_have_sync_fetch_and_add" >&6; } + if test $libgfor_cv_have_sync_fetch_and_add = yes; then + +$as_echo "#define HAVE_SYNC_FETCH_AND_ADD 1" >>confdefs.h + + fi + +# Check out thread support. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking configured target thread model" >&5 +$as_echo_n "checking configured target thread model... " >&6; } +if test "${libgfor_cv_target_thread_file+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + +libgfor_cv_target_thread_file=`$CC -v 2>&1 | sed -n 's/^Thread model: //p'` +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_target_thread_file" >&5 +$as_echo "$libgfor_cv_target_thread_file" >&6; } + + if test $libgfor_cv_target_thread_file != single; then + +$as_echo "#define HAVE_GTHR_DEFAULT 1" >>confdefs.h + + fi + +# Check out #pragma weak. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pragma weak works" >&5 +$as_echo_n "checking whether pragma weak works... " >&6; } +if test "${libgfor_cv_have_pragma_weak+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + gfor_save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -Wunknown-pragmas" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +void foo (void); +#pragma weak foo +int +main () +{ +if (foo) foo (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + libgfor_cv_have_pragma_weak=yes +else + libgfor_cv_have_pragma_weak=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_pragma_weak" >&5 +$as_echo "$libgfor_cv_have_pragma_weak" >&6; } + if test $libgfor_cv_have_pragma_weak = yes; then + +$as_echo "#define SUPPORTS_WEAK 1" >>confdefs.h + + fi + case "$host" in + *-*-darwin* | *-*-hpux* | *-*-cygwin* | *-*-mingw* | alpha*-dec-osf* ) + +$as_echo "#define GTHREAD_USE_WEAK 0" >>confdefs.h + + ;; + esac + +# Various other checks on target + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the target can unlink an open file" >&5 +$as_echo_n "checking whether the target can unlink an open file... " >&6; } +if test "${libgfor_cv_have_unlink_open_file+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test "$cross_compiling" = yes; then : + +case "${target}" in + *mingw*) libgfor_cv_have_unlink_open_file=no ;; + *) libgfor_cv_have_unlink_open_file=yes;; +esac +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include +#include +#include +#include + +int main () +{ + int fd; + + fd = open ("testfile", O_RDWR | O_CREAT, S_IWRITE | S_IREAD); + if (fd <= 0) + return 0; + if (unlink ("testfile") == -1) + return 1; + write (fd, "This is a test\n", 15); + close (fd); + + if (open ("testfile", O_RDONLY, S_IWRITE | S_IREAD) == -1 && errno == ENOENT) + return 0; + else + return 1; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + libgfor_cv_have_unlink_open_file=yes +else + libgfor_cv_have_unlink_open_file=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_unlink_open_file" >&5 +$as_echo "$libgfor_cv_have_unlink_open_file" >&6; } +if test x"$libgfor_cv_have_unlink_open_file" = xyes; then + +$as_echo "#define HAVE_UNLINK_OPEN_FILE 1" >>confdefs.h + +fi + +# Check whether line terminator is LF or CRLF + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the target has CRLF as line terminator" >&5 +$as_echo_n "checking whether the target has CRLF as line terminator... " >&6; } +if test "${libgfor_cv_have_crlf+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test "$cross_compiling" = yes; then : + +case "${target}" in + *mingw*) libgfor_cv_have_crlf=yes ;; + *) libgfor_cv_have_crlf=no;; +esac +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* This test program should exit with status 0 if system uses a CRLF as + line terminator, and status 1 otherwise. + Since it is used to check for mingw systems, and should return 0 in any + other case, in case of a failure we will not use CRLF. */ +#include +#include +#include +#include + +int main () +{ +#ifndef O_BINARY + exit(1); +#else + int fd, bytes; + char buff[5]; + + fd = open ("foo", O_WRONLY | O_CREAT | O_TRUNC, S_IRWXU); + if (fd < 0) + exit(1); + if (write (fd, "\n", 1) < 0) + perror ("write"); + + close (fd); + + if ((fd = open ("foo", O_RDONLY | O_BINARY, S_IRWXU)) < 0) + exit(1); + bytes = read (fd, buff, 5); + if (bytes == 2 && buff[0] == '\r' && buff[1] == '\n') + exit(0); + else + exit(1); +#endif +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + libgfor_cv_have_crlf=yes +else + libgfor_cv_have_crlf=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgfor_cv_have_crlf" >&5 +$as_echo "$libgfor_cv_have_crlf" >&6; } +if test x"$libgfor_cv_have_crlf" = xyes; then + +$as_echo "#define HAVE_CRLF 1" >>confdefs.h + +fi + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + test "x$cache_file" != "x/dev/null" && + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + cat confcache >$cache_file + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +if test ${multilib} = yes; then + multilib_arg="--enable-multilib" +else + multilib_arg= +fi + +# Write our Makefile and spec file. +ac_config_files="$ac_config_files Makefile libgfortran.spec" + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + test "x$cache_file" != "x/dev/null" && + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + cat confcache >$cache_file + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +DEFS=-DHAVE_CONFIG_H + +ac_libobjs= +ac_ltlibobjs= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + +if test -z "${onestep_TRUE}" && test -z "${onestep_FALSE}"; then + as_fn_error "conditional \"onestep\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi + if test -n "$EXEEXT"; then + am__EXEEXT_TRUE= + am__EXEEXT_FALSE='#' +else + am__EXEEXT_TRUE='#' + am__EXEEXT_FALSE= +fi + +if test -z "${MAINTAINER_MODE_TRUE}" && test -z "${MAINTAINER_MODE_FALSE}"; then + as_fn_error "conditional \"MAINTAINER_MODE\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${AMDEP_TRUE}" && test -z "${AMDEP_FALSE}"; then + as_fn_error "conditional \"AMDEP\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then + as_fn_error "conditional \"am__fastdepCC\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then + as_fn_error "conditional \"am__fastdepCC\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${LIBGFOR_USE_SYMVER_TRUE}" && test -z "${LIBGFOR_USE_SYMVER_FALSE}"; then + as_fn_error "conditional \"LIBGFOR_USE_SYMVER\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${LIBGFOR_USE_SYMVER_GNU_TRUE}" && test -z "${LIBGFOR_USE_SYMVER_GNU_FALSE}"; then + as_fn_error "conditional \"LIBGFOR_USE_SYMVER_GNU\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${LIBGFOR_USE_SYMVER_SUN_TRUE}" && test -z "${LIBGFOR_USE_SYMVER_SUN_FALSE}"; then + as_fn_error "conditional \"LIBGFOR_USE_SYMVER_SUN\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${LIBGFOR_BUILD_QUAD_TRUE}" && test -z "${LIBGFOR_BUILD_QUAD_FALSE}"; then + as_fn_error "conditional \"LIBGFOR_BUILD_QUAD\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi + +: ${CONFIG_STATUS=./config.status} +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error ERROR [LINENO LOG_FD] +# --------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with status $?, using 1 if that was 0. +as_fn_error () +{ + as_status=$?; test $as_status -eq 0 && as_status=1 + if test "$3"; then + as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3 + fi + $as_echo "$as_me: error: $1" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' + fi +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by GNU Fortran Runtime Library $as_me 0.3, which was +generated by GNU Autoconf 2.64. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + +case $ac_config_headers in *" +"*) set x $ac_config_headers; shift; ac_config_headers=$*;; +esac + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" +config_headers="$ac_config_headers" +config_commands="$ac_config_commands" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + --header=FILE[:TEMPLATE] + instantiate the configuration header FILE + +Configuration files: +$config_files + +Configuration headers: +$config_headers + +Configuration commands: +$config_commands + +Report bugs to the package provider. +GNU Fortran Runtime Library home page: . +General help using GNU software: ." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_version="\\ +GNU Fortran Runtime Library config.status 0.3 +configured by $0, generated by GNU Autoconf 2.64, + with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" + +Copyright (C) 2009 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +INSTALL='$INSTALL' +MKDIR_P='$MKDIR_P' +AWK='$AWK' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_HEADERS " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h) + # Conflict between --help and --header + as_fn_error "ambiguous option: \`$1' +Try \`$0 --help' for more information.";; + --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# +# INIT-COMMANDS +# + +srcdir="$srcdir" +host="$host" +target="$target" +with_multisubdir="$with_multisubdir" +with_multisrctop="$with_multisrctop" +with_target_subdir="$with_target_subdir" +ac_configure_args="${multilib_arg} ${ac_configure_args}" +multi_basedir="$multi_basedir" +CONFIG_SHELL=${CONFIG_SHELL-/bin/sh} +CC="$CC" +CXX="$CXX" +GFORTRAN="$GFORTRAN" +GCJ="$GCJ" +AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir" + + +# The HP-UX ksh and POSIX shell print the target directory to stdout +# if CDPATH is set. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +sed_quote_subst='$sed_quote_subst' +double_quote_subst='$double_quote_subst' +delay_variable_subst='$delay_variable_subst' +macro_version='`$ECHO "$macro_version" | $SED "$delay_single_quote_subst"`' +macro_revision='`$ECHO "$macro_revision" | $SED "$delay_single_quote_subst"`' +enable_shared='`$ECHO "$enable_shared" | $SED "$delay_single_quote_subst"`' +enable_static='`$ECHO "$enable_static" | $SED "$delay_single_quote_subst"`' +pic_mode='`$ECHO "$pic_mode" | $SED "$delay_single_quote_subst"`' +enable_fast_install='`$ECHO "$enable_fast_install" | $SED "$delay_single_quote_subst"`' +SHELL='`$ECHO "$SHELL" | $SED "$delay_single_quote_subst"`' +ECHO='`$ECHO "$ECHO" | $SED "$delay_single_quote_subst"`' +host_alias='`$ECHO "$host_alias" | $SED "$delay_single_quote_subst"`' +host='`$ECHO "$host" | $SED "$delay_single_quote_subst"`' +host_os='`$ECHO "$host_os" | $SED "$delay_single_quote_subst"`' +build_alias='`$ECHO "$build_alias" | $SED "$delay_single_quote_subst"`' +build='`$ECHO "$build" | $SED "$delay_single_quote_subst"`' +build_os='`$ECHO "$build_os" | $SED "$delay_single_quote_subst"`' +SED='`$ECHO "$SED" | $SED "$delay_single_quote_subst"`' +Xsed='`$ECHO "$Xsed" | $SED "$delay_single_quote_subst"`' +GREP='`$ECHO "$GREP" | $SED "$delay_single_quote_subst"`' +EGREP='`$ECHO "$EGREP" | $SED "$delay_single_quote_subst"`' +FGREP='`$ECHO "$FGREP" | $SED "$delay_single_quote_subst"`' +LD='`$ECHO "$LD" | $SED "$delay_single_quote_subst"`' +NM='`$ECHO "$NM" | $SED "$delay_single_quote_subst"`' +LN_S='`$ECHO "$LN_S" | $SED "$delay_single_quote_subst"`' +max_cmd_len='`$ECHO "$max_cmd_len" | $SED "$delay_single_quote_subst"`' +ac_objext='`$ECHO "$ac_objext" | $SED "$delay_single_quote_subst"`' +exeext='`$ECHO "$exeext" | $SED "$delay_single_quote_subst"`' +lt_unset='`$ECHO "$lt_unset" | $SED "$delay_single_quote_subst"`' +lt_SP2NL='`$ECHO "$lt_SP2NL" | $SED "$delay_single_quote_subst"`' +lt_NL2SP='`$ECHO "$lt_NL2SP" | $SED "$delay_single_quote_subst"`' +reload_flag='`$ECHO "$reload_flag" | $SED "$delay_single_quote_subst"`' +reload_cmds='`$ECHO "$reload_cmds" | $SED "$delay_single_quote_subst"`' +OBJDUMP='`$ECHO "$OBJDUMP" | $SED "$delay_single_quote_subst"`' +deplibs_check_method='`$ECHO "$deplibs_check_method" | $SED "$delay_single_quote_subst"`' +file_magic_cmd='`$ECHO "$file_magic_cmd" | $SED "$delay_single_quote_subst"`' +AR='`$ECHO "$AR" | $SED "$delay_single_quote_subst"`' +AR_FLAGS='`$ECHO "$AR_FLAGS" | $SED "$delay_single_quote_subst"`' +STRIP='`$ECHO "$STRIP" | $SED "$delay_single_quote_subst"`' +RANLIB='`$ECHO "$RANLIB" | $SED "$delay_single_quote_subst"`' +old_postinstall_cmds='`$ECHO "$old_postinstall_cmds" | $SED "$delay_single_quote_subst"`' +old_postuninstall_cmds='`$ECHO "$old_postuninstall_cmds" | $SED "$delay_single_quote_subst"`' +old_archive_cmds='`$ECHO "$old_archive_cmds" | $SED "$delay_single_quote_subst"`' +lock_old_archive_extraction='`$ECHO "$lock_old_archive_extraction" | $SED "$delay_single_quote_subst"`' +CC='`$ECHO "$CC" | $SED "$delay_single_quote_subst"`' +CFLAGS='`$ECHO "$CFLAGS" | $SED "$delay_single_quote_subst"`' +compiler='`$ECHO "$compiler" | $SED "$delay_single_quote_subst"`' +GCC='`$ECHO "$GCC" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_pipe='`$ECHO "$lt_cv_sys_global_symbol_pipe" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_cdecl='`$ECHO "$lt_cv_sys_global_symbol_to_cdecl" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_c_name_address='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address_lib_prefix" | $SED "$delay_single_quote_subst"`' +objdir='`$ECHO "$objdir" | $SED "$delay_single_quote_subst"`' +MAGIC_CMD='`$ECHO "$MAGIC_CMD" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_no_builtin_flag='`$ECHO "$lt_prog_compiler_no_builtin_flag" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_wl='`$ECHO "$lt_prog_compiler_wl" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_pic='`$ECHO "$lt_prog_compiler_pic" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_static='`$ECHO "$lt_prog_compiler_static" | $SED "$delay_single_quote_subst"`' +lt_cv_prog_compiler_c_o='`$ECHO "$lt_cv_prog_compiler_c_o" | $SED "$delay_single_quote_subst"`' +need_locks='`$ECHO "$need_locks" | $SED "$delay_single_quote_subst"`' +DSYMUTIL='`$ECHO "$DSYMUTIL" | $SED "$delay_single_quote_subst"`' +NMEDIT='`$ECHO "$NMEDIT" | $SED "$delay_single_quote_subst"`' +LIPO='`$ECHO "$LIPO" | $SED "$delay_single_quote_subst"`' +OTOOL='`$ECHO "$OTOOL" | $SED "$delay_single_quote_subst"`' +OTOOL64='`$ECHO "$OTOOL64" | $SED "$delay_single_quote_subst"`' +libext='`$ECHO "$libext" | $SED "$delay_single_quote_subst"`' +shrext_cmds='`$ECHO "$shrext_cmds" | $SED "$delay_single_quote_subst"`' +extract_expsyms_cmds='`$ECHO "$extract_expsyms_cmds" | $SED "$delay_single_quote_subst"`' +archive_cmds_need_lc='`$ECHO "$archive_cmds_need_lc" | $SED "$delay_single_quote_subst"`' +enable_shared_with_static_runtimes='`$ECHO "$enable_shared_with_static_runtimes" | $SED "$delay_single_quote_subst"`' +export_dynamic_flag_spec='`$ECHO "$export_dynamic_flag_spec" | $SED "$delay_single_quote_subst"`' +whole_archive_flag_spec='`$ECHO "$whole_archive_flag_spec" | $SED "$delay_single_quote_subst"`' +compiler_needs_object='`$ECHO "$compiler_needs_object" | $SED "$delay_single_quote_subst"`' +old_archive_from_new_cmds='`$ECHO "$old_archive_from_new_cmds" | $SED "$delay_single_quote_subst"`' +old_archive_from_expsyms_cmds='`$ECHO "$old_archive_from_expsyms_cmds" | $SED "$delay_single_quote_subst"`' +archive_cmds='`$ECHO "$archive_cmds" | $SED "$delay_single_quote_subst"`' +archive_expsym_cmds='`$ECHO "$archive_expsym_cmds" | $SED "$delay_single_quote_subst"`' +module_cmds='`$ECHO "$module_cmds" | $SED "$delay_single_quote_subst"`' +module_expsym_cmds='`$ECHO "$module_expsym_cmds" | $SED "$delay_single_quote_subst"`' +with_gnu_ld='`$ECHO "$with_gnu_ld" | $SED "$delay_single_quote_subst"`' +allow_undefined_flag='`$ECHO "$allow_undefined_flag" | $SED "$delay_single_quote_subst"`' +no_undefined_flag='`$ECHO "$no_undefined_flag" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec='`$ECHO "$hardcode_libdir_flag_spec" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec_ld='`$ECHO "$hardcode_libdir_flag_spec_ld" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_separator='`$ECHO "$hardcode_libdir_separator" | $SED "$delay_single_quote_subst"`' +hardcode_direct='`$ECHO "$hardcode_direct" | $SED "$delay_single_quote_subst"`' +hardcode_direct_absolute='`$ECHO "$hardcode_direct_absolute" | $SED "$delay_single_quote_subst"`' +hardcode_minus_L='`$ECHO "$hardcode_minus_L" | $SED "$delay_single_quote_subst"`' +hardcode_shlibpath_var='`$ECHO "$hardcode_shlibpath_var" | $SED "$delay_single_quote_subst"`' +hardcode_automatic='`$ECHO "$hardcode_automatic" | $SED "$delay_single_quote_subst"`' +inherit_rpath='`$ECHO "$inherit_rpath" | $SED "$delay_single_quote_subst"`' +link_all_deplibs='`$ECHO "$link_all_deplibs" | $SED "$delay_single_quote_subst"`' +fix_srcfile_path='`$ECHO "$fix_srcfile_path" | $SED "$delay_single_quote_subst"`' +always_export_symbols='`$ECHO "$always_export_symbols" | $SED "$delay_single_quote_subst"`' +export_symbols_cmds='`$ECHO "$export_symbols_cmds" | $SED "$delay_single_quote_subst"`' +exclude_expsyms='`$ECHO "$exclude_expsyms" | $SED "$delay_single_quote_subst"`' +include_expsyms='`$ECHO "$include_expsyms" | $SED "$delay_single_quote_subst"`' +prelink_cmds='`$ECHO "$prelink_cmds" | $SED "$delay_single_quote_subst"`' +file_list_spec='`$ECHO "$file_list_spec" | $SED "$delay_single_quote_subst"`' +variables_saved_for_relink='`$ECHO "$variables_saved_for_relink" | $SED "$delay_single_quote_subst"`' +need_lib_prefix='`$ECHO "$need_lib_prefix" | $SED "$delay_single_quote_subst"`' +need_version='`$ECHO "$need_version" | $SED "$delay_single_quote_subst"`' +version_type='`$ECHO "$version_type" | $SED "$delay_single_quote_subst"`' +runpath_var='`$ECHO "$runpath_var" | $SED "$delay_single_quote_subst"`' +shlibpath_var='`$ECHO "$shlibpath_var" | $SED "$delay_single_quote_subst"`' +shlibpath_overrides_runpath='`$ECHO "$shlibpath_overrides_runpath" | $SED "$delay_single_quote_subst"`' +libname_spec='`$ECHO "$libname_spec" | $SED "$delay_single_quote_subst"`' +library_names_spec='`$ECHO "$library_names_spec" | $SED "$delay_single_quote_subst"`' +soname_spec='`$ECHO "$soname_spec" | $SED "$delay_single_quote_subst"`' +install_override_mode='`$ECHO "$install_override_mode" | $SED "$delay_single_quote_subst"`' +postinstall_cmds='`$ECHO "$postinstall_cmds" | $SED "$delay_single_quote_subst"`' +postuninstall_cmds='`$ECHO "$postuninstall_cmds" | $SED "$delay_single_quote_subst"`' +finish_cmds='`$ECHO "$finish_cmds" | $SED "$delay_single_quote_subst"`' +finish_eval='`$ECHO "$finish_eval" | $SED "$delay_single_quote_subst"`' +hardcode_into_libs='`$ECHO "$hardcode_into_libs" | $SED "$delay_single_quote_subst"`' +sys_lib_search_path_spec='`$ECHO "$sys_lib_search_path_spec" | $SED "$delay_single_quote_subst"`' +sys_lib_dlsearch_path_spec='`$ECHO "$sys_lib_dlsearch_path_spec" | $SED "$delay_single_quote_subst"`' +hardcode_action='`$ECHO "$hardcode_action" | $SED "$delay_single_quote_subst"`' +enable_dlopen='`$ECHO "$enable_dlopen" | $SED "$delay_single_quote_subst"`' +enable_dlopen_self='`$ECHO "$enable_dlopen_self" | $SED "$delay_single_quote_subst"`' +enable_dlopen_self_static='`$ECHO "$enable_dlopen_self_static" | $SED "$delay_single_quote_subst"`' +old_striplib='`$ECHO "$old_striplib" | $SED "$delay_single_quote_subst"`' +striplib='`$ECHO "$striplib" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_dirs='`$ECHO "$compiler_lib_search_dirs" | $SED "$delay_single_quote_subst"`' +predep_objects='`$ECHO "$predep_objects" | $SED "$delay_single_quote_subst"`' +postdep_objects='`$ECHO "$postdep_objects" | $SED "$delay_single_quote_subst"`' +predeps='`$ECHO "$predeps" | $SED "$delay_single_quote_subst"`' +postdeps='`$ECHO "$postdeps" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_path='`$ECHO "$compiler_lib_search_path" | $SED "$delay_single_quote_subst"`' +LD_FC='`$ECHO "$LD_FC" | $SED "$delay_single_quote_subst"`' +reload_flag_FC='`$ECHO "$reload_flag_FC" | $SED "$delay_single_quote_subst"`' +reload_cmds_FC='`$ECHO "$reload_cmds_FC" | $SED "$delay_single_quote_subst"`' +old_archive_cmds_FC='`$ECHO "$old_archive_cmds_FC" | $SED "$delay_single_quote_subst"`' +compiler_FC='`$ECHO "$compiler_FC" | $SED "$delay_single_quote_subst"`' +GCC_FC='`$ECHO "$GCC_FC" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_no_builtin_flag_FC='`$ECHO "$lt_prog_compiler_no_builtin_flag_FC" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_wl_FC='`$ECHO "$lt_prog_compiler_wl_FC" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_pic_FC='`$ECHO "$lt_prog_compiler_pic_FC" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_static_FC='`$ECHO "$lt_prog_compiler_static_FC" | $SED "$delay_single_quote_subst"`' +lt_cv_prog_compiler_c_o_FC='`$ECHO "$lt_cv_prog_compiler_c_o_FC" | $SED "$delay_single_quote_subst"`' +archive_cmds_need_lc_FC='`$ECHO "$archive_cmds_need_lc_FC" | $SED "$delay_single_quote_subst"`' +enable_shared_with_static_runtimes_FC='`$ECHO "$enable_shared_with_static_runtimes_FC" | $SED "$delay_single_quote_subst"`' +export_dynamic_flag_spec_FC='`$ECHO "$export_dynamic_flag_spec_FC" | $SED "$delay_single_quote_subst"`' +whole_archive_flag_spec_FC='`$ECHO "$whole_archive_flag_spec_FC" | $SED "$delay_single_quote_subst"`' +compiler_needs_object_FC='`$ECHO "$compiler_needs_object_FC" | $SED "$delay_single_quote_subst"`' +old_archive_from_new_cmds_FC='`$ECHO "$old_archive_from_new_cmds_FC" | $SED "$delay_single_quote_subst"`' +old_archive_from_expsyms_cmds_FC='`$ECHO "$old_archive_from_expsyms_cmds_FC" | $SED "$delay_single_quote_subst"`' +archive_cmds_FC='`$ECHO "$archive_cmds_FC" | $SED "$delay_single_quote_subst"`' +archive_expsym_cmds_FC='`$ECHO "$archive_expsym_cmds_FC" | $SED "$delay_single_quote_subst"`' +module_cmds_FC='`$ECHO "$module_cmds_FC" | $SED "$delay_single_quote_subst"`' +module_expsym_cmds_FC='`$ECHO "$module_expsym_cmds_FC" | $SED "$delay_single_quote_subst"`' +with_gnu_ld_FC='`$ECHO "$with_gnu_ld_FC" | $SED "$delay_single_quote_subst"`' +allow_undefined_flag_FC='`$ECHO "$allow_undefined_flag_FC" | $SED "$delay_single_quote_subst"`' +no_undefined_flag_FC='`$ECHO "$no_undefined_flag_FC" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec_FC='`$ECHO "$hardcode_libdir_flag_spec_FC" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec_ld_FC='`$ECHO "$hardcode_libdir_flag_spec_ld_FC" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_separator_FC='`$ECHO "$hardcode_libdir_separator_FC" | $SED "$delay_single_quote_subst"`' +hardcode_direct_FC='`$ECHO "$hardcode_direct_FC" | $SED "$delay_single_quote_subst"`' +hardcode_direct_absolute_FC='`$ECHO "$hardcode_direct_absolute_FC" | $SED "$delay_single_quote_subst"`' +hardcode_minus_L_FC='`$ECHO "$hardcode_minus_L_FC" | $SED "$delay_single_quote_subst"`' +hardcode_shlibpath_var_FC='`$ECHO "$hardcode_shlibpath_var_FC" | $SED "$delay_single_quote_subst"`' +hardcode_automatic_FC='`$ECHO "$hardcode_automatic_FC" | $SED "$delay_single_quote_subst"`' +inherit_rpath_FC='`$ECHO "$inherit_rpath_FC" | $SED "$delay_single_quote_subst"`' +link_all_deplibs_FC='`$ECHO "$link_all_deplibs_FC" | $SED "$delay_single_quote_subst"`' +fix_srcfile_path_FC='`$ECHO "$fix_srcfile_path_FC" | $SED "$delay_single_quote_subst"`' +always_export_symbols_FC='`$ECHO "$always_export_symbols_FC" | $SED "$delay_single_quote_subst"`' +export_symbols_cmds_FC='`$ECHO "$export_symbols_cmds_FC" | $SED "$delay_single_quote_subst"`' +exclude_expsyms_FC='`$ECHO "$exclude_expsyms_FC" | $SED "$delay_single_quote_subst"`' +include_expsyms_FC='`$ECHO "$include_expsyms_FC" | $SED "$delay_single_quote_subst"`' +prelink_cmds_FC='`$ECHO "$prelink_cmds_FC" | $SED "$delay_single_quote_subst"`' +file_list_spec_FC='`$ECHO "$file_list_spec_FC" | $SED "$delay_single_quote_subst"`' +hardcode_action_FC='`$ECHO "$hardcode_action_FC" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_dirs_FC='`$ECHO "$compiler_lib_search_dirs_FC" | $SED "$delay_single_quote_subst"`' +predep_objects_FC='`$ECHO "$predep_objects_FC" | $SED "$delay_single_quote_subst"`' +postdep_objects_FC='`$ECHO "$postdep_objects_FC" | $SED "$delay_single_quote_subst"`' +predeps_FC='`$ECHO "$predeps_FC" | $SED "$delay_single_quote_subst"`' +postdeps_FC='`$ECHO "$postdeps_FC" | $SED "$delay_single_quote_subst"`' +compiler_lib_search_path_FC='`$ECHO "$compiler_lib_search_path_FC" | $SED "$delay_single_quote_subst"`' + +LTCC='$LTCC' +LTCFLAGS='$LTCFLAGS' +compiler='$compiler_DEFAULT' + +# A function that is used when there is no print builtin or printf. +func_fallback_echo () +{ + eval 'cat <<_LTECHO_EOF +\$1 +_LTECHO_EOF' +} + +# Quote evaled strings. +for var in SHELL \ +ECHO \ +SED \ +GREP \ +EGREP \ +FGREP \ +LD \ +NM \ +LN_S \ +lt_SP2NL \ +lt_NL2SP \ +reload_flag \ +OBJDUMP \ +deplibs_check_method \ +file_magic_cmd \ +AR \ +AR_FLAGS \ +STRIP \ +RANLIB \ +CC \ +CFLAGS \ +compiler \ +lt_cv_sys_global_symbol_pipe \ +lt_cv_sys_global_symbol_to_cdecl \ +lt_cv_sys_global_symbol_to_c_name_address \ +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix \ +lt_prog_compiler_no_builtin_flag \ +lt_prog_compiler_wl \ +lt_prog_compiler_pic \ +lt_prog_compiler_static \ +lt_cv_prog_compiler_c_o \ +need_locks \ +DSYMUTIL \ +NMEDIT \ +LIPO \ +OTOOL \ +OTOOL64 \ +shrext_cmds \ +export_dynamic_flag_spec \ +whole_archive_flag_spec \ +compiler_needs_object \ +with_gnu_ld \ +allow_undefined_flag \ +no_undefined_flag \ +hardcode_libdir_flag_spec \ +hardcode_libdir_flag_spec_ld \ +hardcode_libdir_separator \ +fix_srcfile_path \ +exclude_expsyms \ +include_expsyms \ +file_list_spec \ +variables_saved_for_relink \ +libname_spec \ +library_names_spec \ +soname_spec \ +install_override_mode \ +finish_eval \ +old_striplib \ +striplib \ +compiler_lib_search_dirs \ +predep_objects \ +postdep_objects \ +predeps \ +postdeps \ +compiler_lib_search_path \ +LD_FC \ +reload_flag_FC \ +compiler_FC \ +lt_prog_compiler_no_builtin_flag_FC \ +lt_prog_compiler_wl_FC \ +lt_prog_compiler_pic_FC \ +lt_prog_compiler_static_FC \ +lt_cv_prog_compiler_c_o_FC \ +export_dynamic_flag_spec_FC \ +whole_archive_flag_spec_FC \ +compiler_needs_object_FC \ +with_gnu_ld_FC \ +allow_undefined_flag_FC \ +no_undefined_flag_FC \ +hardcode_libdir_flag_spec_FC \ +hardcode_libdir_flag_spec_ld_FC \ +hardcode_libdir_separator_FC \ +fix_srcfile_path_FC \ +exclude_expsyms_FC \ +include_expsyms_FC \ +file_list_spec_FC \ +compiler_lib_search_dirs_FC \ +predep_objects_FC \ +postdep_objects_FC \ +predeps_FC \ +postdeps_FC \ +compiler_lib_search_path_FC; do + case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in + *[\\\\\\\`\\"\\\$]*) + eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\"" + ;; + *) + eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" + ;; + esac +done + +# Double-quote double-evaled strings. +for var in reload_cmds \ +old_postinstall_cmds \ +old_postuninstall_cmds \ +old_archive_cmds \ +extract_expsyms_cmds \ +old_archive_from_new_cmds \ +old_archive_from_expsyms_cmds \ +archive_cmds \ +archive_expsym_cmds \ +module_cmds \ +module_expsym_cmds \ +export_symbols_cmds \ +prelink_cmds \ +postinstall_cmds \ +postuninstall_cmds \ +finish_cmds \ +sys_lib_search_path_spec \ +sys_lib_dlsearch_path_spec \ +reload_cmds_FC \ +old_archive_cmds_FC \ +old_archive_from_new_cmds_FC \ +old_archive_from_expsyms_cmds_FC \ +archive_cmds_FC \ +archive_expsym_cmds_FC \ +module_cmds_FC \ +module_expsym_cmds_FC \ +export_symbols_cmds_FC \ +prelink_cmds_FC; do + case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in + *[\\\\\\\`\\"\\\$]*) + eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\"" + ;; + *) + eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" + ;; + esac +done + +ac_aux_dir='$ac_aux_dir' +xsi_shell='$xsi_shell' +lt_shell_append='$lt_shell_append' + +# See if we are running on zsh, and set the options which allow our +# commands through without removal of \ escapes INIT. +if test -n "\${ZSH_VERSION+set}" ; then + setopt NO_GLOB_SUBST +fi + + + PACKAGE='$PACKAGE' + VERSION='$VERSION' + TIMESTAMP='$TIMESTAMP' + RM='$RM' + ofile='$ofile' + + + + + + +GCC="$GCC" +CC="$CC" +acx_cv_header_stdint="$acx_cv_header_stdint" +acx_cv_type_int8_t="$acx_cv_type_int8_t" +acx_cv_type_int16_t="$acx_cv_type_int16_t" +acx_cv_type_int32_t="$acx_cv_type_int32_t" +acx_cv_type_int64_t="$acx_cv_type_int64_t" +acx_cv_type_intptr_t="$acx_cv_type_intptr_t" +ac_cv_type_uintmax_t="$ac_cv_type_uintmax_t" +ac_cv_type_uintptr_t="$ac_cv_type_uintptr_t" +ac_cv_type_uint64_t="$ac_cv_type_uint64_t" +ac_cv_type_u_int64_t="$ac_cv_type_u_int64_t" +ac_cv_type_u_int32_t="$ac_cv_type_u_int32_t" +ac_cv_type_int_least32_t="$ac_cv_type_int_least32_t" +ac_cv_type_int_fast32_t="$ac_cv_type_int_fast32_t" +ac_cv_sizeof_void_p="$ac_cv_sizeof_void_p" + + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;; + "default-1") CONFIG_COMMANDS="$CONFIG_COMMANDS default-1" ;; + "depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;; + "libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;; + "gstdint.h") CONFIG_COMMANDS="$CONFIG_COMMANDS gstdint.h" ;; + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "libgfortran.spec") CONFIG_FILES="$CONFIG_FILES libgfortran.spec" ;; + + *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files + test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers + test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= + trap 'exit_status=$? + { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5 + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\).*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\).*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ + || as_fn_error "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove $(srcdir), +# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=/{ +s/:*\$(srcdir):*/:/ +s/:*\${srcdir}:*/:/ +s/:*@srcdir@:*/:/ +s/^\([^=]*=[ ]*\):*/\1/ +s/:*$// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + +# Set up the scripts for CONFIG_HEADERS section. +# No need to generate them if there are no CONFIG_HEADERS. +# This happens for instance with `./config.status Makefile'. +if test -n "$CONFIG_HEADERS"; then +cat >"$tmp/defines.awk" <<\_ACAWK || +BEGIN { +_ACEOF + +# Transform confdefs.h into an awk script `defines.awk', embedded as +# here-document in config.status, that substitutes the proper values into +# config.h.in to produce config.h. + +# Create a delimiter string that does not exist in confdefs.h, to ease +# handling of long lines. +ac_delim='%!_!# ' +for ac_last_try in false false :; do + ac_t=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_t"; then + break + elif $ac_last_try; then + as_fn_error "could not make $CONFIG_HEADERS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +# For the awk script, D is an array of macro values keyed by name, +# likewise P contains macro parameters if any. Preserve backslash +# newline sequences. + +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +sed -n ' +s/.\{148\}/&'"$ac_delim"'/g +t rset +:rset +s/^[ ]*#[ ]*define[ ][ ]*/ / +t def +d +:def +s/\\$// +t bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3"/p +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p +d +:bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3\\\\\\n"\\/p +t cont +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p +t cont +d +:cont +n +s/.\{148\}/&'"$ac_delim"'/g +t clear +:clear +s/\\$// +t bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/"/p +d +:bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p +b cont +' >$CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + for (key in D) D_is_set[key] = 1 + FS = "" +} +/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { + line = \$ 0 + split(line, arg, " ") + if (arg[1] == "#") { + defundef = arg[2] + mac1 = arg[3] + } else { + defundef = substr(arg[1], 2) + mac1 = arg[2] + } + split(mac1, mac2, "(") #) + macro = mac2[1] + prefix = substr(line, 1, index(line, defundef) - 1) + if (D_is_set[macro]) { + # Preserve the white space surrounding the "#". + print prefix "define", macro P[macro] D[macro] + next + } else { + # Replace #undef with comments. This is necessary, for example, + # in the case of _POSIX_SOURCE, which is predefined and required + # on some systems where configure will not decide to define it. + if (defundef == "undef") { + print "/*", prefix defundef, macro, "*/" + next + } + } +} +{ print } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + as_fn_error "could not setup config headers machinery" "$LINENO" 5 +fi # test -n "$CONFIG_HEADERS" + + +eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS :C $CONFIG_COMMANDS" +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$tmp/stdin" \ + || as_fn_error "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac + ac_MKDIR_P=$MKDIR_P + case $MKDIR_P in + [\\/$]* | ?:[\\/]* ) ;; + */*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;; + esac +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +s&@MKDIR_P@&$ac_MKDIR_P&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \ + || as_fn_error "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined." >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined." >&2;} + + rm -f "$tmp/stdin" + case $ac_file in + -) cat "$tmp/out" && rm -f "$tmp/out";; + *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; + esac \ + || as_fn_error "could not create $ac_file" "$LINENO" 5 + ;; + :H) + # + # CONFIG_HEADER + # + if test x"$ac_file" != x-; then + { + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" + } >"$tmp/config.h" \ + || as_fn_error "could not create $ac_file" "$LINENO" 5 + if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 +$as_echo "$as_me: $ac_file is unchanged" >&6;} + else + rm -f "$ac_file" + mv "$tmp/config.h" "$ac_file" \ + || as_fn_error "could not create $ac_file" "$LINENO" 5 + fi + else + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error "could not create -" "$LINENO" 5 + fi +# Compute "$ac_file"'s index in $config_headers. +_am_arg="$ac_file" +_am_stamp_count=1 +for _am_header in $config_headers :; do + case $_am_header in + $_am_arg | $_am_arg:* ) + break ;; + * ) + _am_stamp_count=`expr $_am_stamp_count + 1` ;; + esac +done +echo "timestamp for $_am_arg" >`$as_dirname -- "$_am_arg" || +$as_expr X"$_am_arg" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$_am_arg" : 'X\(//\)[^/]' \| \ + X"$_am_arg" : 'X\(//\)$' \| \ + X"$_am_arg" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$_am_arg" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'`/stamp-h$_am_stamp_count + ;; + + :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 +$as_echo "$as_me: executing $ac_file commands" >&6;} + ;; + esac + + + case $ac_file$ac_mode in + "default-1":C) +# Only add multilib support code if we just rebuilt the top-level +# Makefile. +case " $CONFIG_FILES " in + *" Makefile "*) + ac_file=Makefile . ${multi_basedir}/config-ml.in + ;; +esac ;; + "depfiles":C) test x"$AMDEP_TRUE" != x"" || { + # Autoconf 2.62 quotes --file arguments for eval, but not when files + # are listed without --file. Let's play safe and only enable the eval + # if we detect the quoting. + case $CONFIG_FILES in + *\'*) eval set x "$CONFIG_FILES" ;; + *) set x $CONFIG_FILES ;; + esac + shift + for mf + do + # Strip MF so we end up with the name of the file. + mf=`echo "$mf" | sed -e 's/:.*$//'` + # Check whether this is an Automake generated Makefile or not. + # We used to match only the files named `Makefile.in', but + # some people rename them; so instead we look at the file content. + # Grep'ing the first line is not enough: some people post-process + # each Makefile.in and add a new line on top of each file to say so. + # Grep'ing the whole file is not good either: AIX grep has a line + # limit of 2048, but all sed's we know have understand at least 4000. + if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then + dirpart=`$as_dirname -- "$mf" || +$as_expr X"$mf" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$mf" : 'X\(//\)[^/]' \| \ + X"$mf" : 'X\(//\)$' \| \ + X"$mf" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$mf" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + else + continue + fi + # Extract the definition of DEPDIR, am__include, and am__quote + # from the Makefile without running `make'. + DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"` + test -z "$DEPDIR" && continue + am__include=`sed -n 's/^am__include = //p' < "$mf"` + test -z "am__include" && continue + am__quote=`sed -n 's/^am__quote = //p' < "$mf"` + # When using ansi2knr, U may be empty or an underscore; expand it + U=`sed -n 's/^U = //p' < "$mf"` + # Find all dependency output files, they are included files with + # $(DEPDIR) in their names. We invoke sed twice because it is the + # simplest approach to changing $(DEPDIR) to its actual value in the + # expansion. + for file in `sed -n " + s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \ + sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g' -e 's/\$U/'"$U"'/g'`; do + # Make sure the directory exists. + test -f "$dirpart/$file" && continue + fdir=`$as_dirname -- "$file" || +$as_expr X"$file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$file" : 'X\(//\)[^/]' \| \ + X"$file" : 'X\(//\)$' \| \ + X"$file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir=$dirpart/$fdir; as_fn_mkdir_p + # echo "creating $dirpart/$file" + echo '# dummy' > "$dirpart/$file" + done + done +} + ;; + "libtool":C) + + # See if we are running on zsh, and set the options which allow our + # commands through without removal of \ escapes. + if test -n "${ZSH_VERSION+set}" ; then + setopt NO_GLOB_SUBST + fi + + cfgfile="${ofile}T" + trap "$RM \"$cfgfile\"; exit 1" 1 2 15 + $RM "$cfgfile" + + cat <<_LT_EOF >> "$cfgfile" +#! $SHELL + +# `$ECHO "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services. +# Generated automatically by $as_me ($PACKAGE$TIMESTAMP) $VERSION +# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: +# NOTE: Changes made to this file will be lost: look at ltmain.sh. +# +# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005, +# 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +# Written by Gordon Matzigkeit, 1996 +# +# This file is part of GNU Libtool. +# +# GNU Libtool is free software; you can 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. +# +# As a special exception to the GNU General Public License, +# if you distribute this file as part of a program or library that +# is built using GNU Libtool, you may include this file under the +# same distribution terms that you use for the rest of that program. +# +# GNU Libtool is distributed in the hope that it will be useful, +# but WITHOUT 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 GNU Libtool; see the file COPYING. If not, a copy +# can be downloaded from http://www.gnu.org/licenses/gpl.html, or +# obtained by writing to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + + +# The names of the tagged configurations supported by this script. +available_tags="FC " + +# ### BEGIN LIBTOOL CONFIG + +# Which release of libtool.m4 was used? +macro_version=$macro_version +macro_revision=$macro_revision + +# Whether or not to build shared libraries. +build_libtool_libs=$enable_shared + +# Whether or not to build static libraries. +build_old_libs=$enable_static + +# What type of objects to build. +pic_mode=$pic_mode + +# Whether or not to optimize for fast installation. +fast_install=$enable_fast_install + +# Shell to use when invoking shell scripts. +SHELL=$lt_SHELL + +# An echo program that protects backslashes. +ECHO=$lt_ECHO + +# The host system. +host_alias=$host_alias +host=$host +host_os=$host_os + +# The build system. +build_alias=$build_alias +build=$build +build_os=$build_os + +# A sed program that does not truncate output. +SED=$lt_SED + +# Sed that helps us avoid accidentally triggering echo(1) options like -n. +Xsed="\$SED -e 1s/^X//" + +# A grep program that handles long lines. +GREP=$lt_GREP + +# An ERE matcher. +EGREP=$lt_EGREP + +# A literal string matcher. +FGREP=$lt_FGREP + +# A BSD- or MS-compatible name lister. +NM=$lt_NM + +# Whether we need soft or hard links. +LN_S=$lt_LN_S + +# What is the maximum length of a command? +max_cmd_len=$max_cmd_len + +# Object file suffix (normally "o"). +objext=$ac_objext + +# Executable file suffix (normally ""). +exeext=$exeext + +# whether the shell understands "unset". +lt_unset=$lt_unset + +# turn spaces into newlines. +SP2NL=$lt_lt_SP2NL + +# turn newlines into spaces. +NL2SP=$lt_lt_NL2SP + +# An object symbol dumper. +OBJDUMP=$lt_OBJDUMP + +# Method to check whether dependent libraries are shared objects. +deplibs_check_method=$lt_deplibs_check_method + +# Command to use when deplibs_check_method == "file_magic". +file_magic_cmd=$lt_file_magic_cmd + +# The archiver. +AR=$lt_AR +AR_FLAGS=$lt_AR_FLAGS + +# A symbol stripping program. +STRIP=$lt_STRIP + +# Commands used to install an old-style archive. +RANLIB=$lt_RANLIB +old_postinstall_cmds=$lt_old_postinstall_cmds +old_postuninstall_cmds=$lt_old_postuninstall_cmds + +# Whether to use a lock for old archive extraction. +lock_old_archive_extraction=$lock_old_archive_extraction + +# A C compiler. +LTCC=$lt_CC + +# LTCC compiler flags. +LTCFLAGS=$lt_CFLAGS + +# Take the output of nm and produce a listing of raw symbols and C names. +global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe + +# Transform the output of nm in a proper C declaration. +global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl + +# Transform the output of nm in a C name address pair. +global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address + +# Transform the output of nm in a C name address pair when lib prefix is needed. +global_symbol_to_c_name_address_lib_prefix=$lt_lt_cv_sys_global_symbol_to_c_name_address_lib_prefix + +# The name of the directory that contains temporary libtool files. +objdir=$objdir + +# Used to examine libraries when file_magic_cmd begins with "file". +MAGIC_CMD=$MAGIC_CMD + +# Must we lock files when doing compilation? +need_locks=$lt_need_locks + +# Tool to manipulate archived DWARF debug symbol files on Mac OS X. +DSYMUTIL=$lt_DSYMUTIL + +# Tool to change global to local symbols on Mac OS X. +NMEDIT=$lt_NMEDIT + +# Tool to manipulate fat objects and archives on Mac OS X. +LIPO=$lt_LIPO + +# ldd/readelf like tool for Mach-O binaries on Mac OS X. +OTOOL=$lt_OTOOL + +# ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4. +OTOOL64=$lt_OTOOL64 + +# Old archive suffix (normally "a"). +libext=$libext + +# Shared library suffix (normally ".so"). +shrext_cmds=$lt_shrext_cmds + +# The commands to extract the exported symbol list from a shared archive. +extract_expsyms_cmds=$lt_extract_expsyms_cmds + +# Variables whose values should be saved in libtool wrapper scripts and +# restored at link time. +variables_saved_for_relink=$lt_variables_saved_for_relink + +# Do we need the "lib" prefix for modules? +need_lib_prefix=$need_lib_prefix + +# Do we need a version for libraries? +need_version=$need_version + +# Library versioning type. +version_type=$version_type + +# Shared library runtime path variable. +runpath_var=$runpath_var + +# Shared library path variable. +shlibpath_var=$shlibpath_var + +# Is shlibpath searched before the hard-coded library search path? +shlibpath_overrides_runpath=$shlibpath_overrides_runpath + +# Format of library name prefix. +libname_spec=$lt_libname_spec + +# List of archive names. First name is the real one, the rest are links. +# The last name is the one that the linker finds with -lNAME +library_names_spec=$lt_library_names_spec + +# The coded name of the library, if different from the real name. +soname_spec=$lt_soname_spec + +# Permission mode override for installation of shared libraries. +install_override_mode=$lt_install_override_mode + +# Command to use after installation of a shared archive. +postinstall_cmds=$lt_postinstall_cmds + +# Command to use after uninstallation of a shared archive. +postuninstall_cmds=$lt_postuninstall_cmds + +# Commands used to finish a libtool library installation in a directory. +finish_cmds=$lt_finish_cmds + +# As "finish_cmds", except a single script fragment to be evaled but +# not shown. +finish_eval=$lt_finish_eval + +# Whether we should hardcode library paths into libraries. +hardcode_into_libs=$hardcode_into_libs + +# Compile-time system search path for libraries. +sys_lib_search_path_spec=$lt_sys_lib_search_path_spec + +# Run-time system search path for libraries. +sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec + +# Whether dlopen is supported. +dlopen_support=$enable_dlopen + +# Whether dlopen of programs is supported. +dlopen_self=$enable_dlopen_self + +# Whether dlopen of statically linked programs is supported. +dlopen_self_static=$enable_dlopen_self_static + +# Commands to strip libraries. +old_striplib=$lt_old_striplib +striplib=$lt_striplib + + +# The linker used to build libraries. +LD=$lt_LD + +# How to create reloadable object files. +reload_flag=$lt_reload_flag +reload_cmds=$lt_reload_cmds + +# Commands used to build an old-style archive. +old_archive_cmds=$lt_old_archive_cmds + +# A language specific compiler. +CC=$lt_compiler + +# Is the compiler the GNU compiler? +with_gcc=$GCC + +# Compiler flag to turn off builtin functions. +no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag + +# How to pass a linker flag through the compiler. +wl=$lt_lt_prog_compiler_wl + +# Additional compiler flags for building library objects. +pic_flag=$lt_lt_prog_compiler_pic + +# Compiler flag to prevent dynamic linking. +link_static_flag=$lt_lt_prog_compiler_static + +# Does compiler simultaneously support -c and -o options? +compiler_c_o=$lt_lt_cv_prog_compiler_c_o + +# Whether or not to add -lc for building shared libraries. +build_libtool_need_lc=$archive_cmds_need_lc + +# Whether or not to disallow shared libs when runtime libs are static. +allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes + +# Compiler flag to allow reflexive dlopens. +export_dynamic_flag_spec=$lt_export_dynamic_flag_spec + +# Compiler flag to generate shared objects directly from archives. +whole_archive_flag_spec=$lt_whole_archive_flag_spec + +# Whether the compiler copes with passing no objects directly. +compiler_needs_object=$lt_compiler_needs_object + +# Create an old-style archive from a shared archive. +old_archive_from_new_cmds=$lt_old_archive_from_new_cmds + +# Create a temporary old-style archive to link instead of a shared archive. +old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds + +# Commands used to build a shared archive. +archive_cmds=$lt_archive_cmds +archive_expsym_cmds=$lt_archive_expsym_cmds + +# Commands used to build a loadable module if different from building +# a shared archive. +module_cmds=$lt_module_cmds +module_expsym_cmds=$lt_module_expsym_cmds + +# Whether we are building with GNU ld or not. +with_gnu_ld=$lt_with_gnu_ld + +# Flag that allows shared libraries with undefined symbols to be built. +allow_undefined_flag=$lt_allow_undefined_flag + +# Flag that enforces no undefined symbols. +no_undefined_flag=$lt_no_undefined_flag + +# Flag to hardcode \$libdir into a binary during linking. +# This must work even if \$libdir does not exist +hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec + +# If ld is used when linking, flag to hardcode \$libdir into a binary +# during linking. This must work even if \$libdir does not exist. +hardcode_libdir_flag_spec_ld=$lt_hardcode_libdir_flag_spec_ld + +# Whether we need a single "-rpath" flag with a separated argument. +hardcode_libdir_separator=$lt_hardcode_libdir_separator + +# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes +# DIR into the resulting binary. +hardcode_direct=$hardcode_direct + +# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes +# DIR into the resulting binary and the resulting library dependency is +# "absolute",i.e impossible to change by setting \${shlibpath_var} if the +# library is relocated. +hardcode_direct_absolute=$hardcode_direct_absolute + +# Set to "yes" if using the -LDIR flag during linking hardcodes DIR +# into the resulting binary. +hardcode_minus_L=$hardcode_minus_L + +# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR +# into the resulting binary. +hardcode_shlibpath_var=$hardcode_shlibpath_var + +# Set to "yes" if building a shared library automatically hardcodes DIR +# into the library and all subsequent libraries and executables linked +# against it. +hardcode_automatic=$hardcode_automatic + +# Set to yes if linker adds runtime paths of dependent libraries +# to runtime path list. +inherit_rpath=$inherit_rpath + +# Whether libtool must link a program against all its dependency libraries. +link_all_deplibs=$link_all_deplibs + +# Fix the shell variable \$srcfile for the compiler. +fix_srcfile_path=$lt_fix_srcfile_path + +# Set to "yes" if exported symbols are required. +always_export_symbols=$always_export_symbols + +# The commands to list exported symbols. +export_symbols_cmds=$lt_export_symbols_cmds + +# Symbols that should not be listed in the preloaded symbols. +exclude_expsyms=$lt_exclude_expsyms + +# Symbols that must always be exported. +include_expsyms=$lt_include_expsyms + +# Commands necessary for linking programs (against libraries) with templates. +prelink_cmds=$lt_prelink_cmds + +# Specify filename containing input files. +file_list_spec=$lt_file_list_spec + +# How to hardcode a shared library path into an executable. +hardcode_action=$hardcode_action + +# The directories searched by this compiler when creating a shared library. +compiler_lib_search_dirs=$lt_compiler_lib_search_dirs + +# Dependencies to place before and after the objects being linked to +# create a shared library. +predep_objects=$lt_predep_objects +postdep_objects=$lt_postdep_objects +predeps=$lt_predeps +postdeps=$lt_postdeps + +# The library search path used internally by the compiler when linking +# a shared library. +compiler_lib_search_path=$lt_compiler_lib_search_path + +# ### END LIBTOOL CONFIG + +_LT_EOF + + case $host_os in + aix3*) + cat <<\_LT_EOF >> "$cfgfile" +# AIX sometimes has problems with the GCC collect2 program. For some +# reason, if we set the COLLECT_NAMES environment variable, the problems +# vanish in a puff of smoke. +if test "X${COLLECT_NAMES+set}" != Xset; then + COLLECT_NAMES= + export COLLECT_NAMES +fi +_LT_EOF + ;; + esac + + +ltmain="$ac_aux_dir/ltmain.sh" + + + # We use sed instead of cat because bash on DJGPP gets confused if + # if finds mixed CR/LF and LF-only lines. Since sed operates in + # text mode, it properly converts lines to CR/LF. This bash problem + # is reportedly fixed, but why not run on old versions too? + sed '/^# Generated shell functions inserted here/q' "$ltmain" >> "$cfgfile" \ + || (rm -f "$cfgfile"; exit 1) + + case $xsi_shell in + yes) + cat << \_LT_EOF >> "$cfgfile" + +# func_dirname file append nondir_replacement +# Compute the dirname of FILE. If nonempty, add APPEND to the result, +# otherwise set result to NONDIR_REPLACEMENT. +func_dirname () +{ + case ${1} in + */*) func_dirname_result="${1%/*}${2}" ;; + * ) func_dirname_result="${3}" ;; + esac +} + +# func_basename file +func_basename () +{ + func_basename_result="${1##*/}" +} + +# func_dirname_and_basename file append nondir_replacement +# perform func_basename and func_dirname in a single function +# call: +# dirname: Compute the dirname of FILE. If nonempty, +# add APPEND to the result, otherwise set result +# to NONDIR_REPLACEMENT. +# value returned in "$func_dirname_result" +# basename: Compute filename of FILE. +# value retuned in "$func_basename_result" +# Implementation must be kept synchronized with func_dirname +# and func_basename. For efficiency, we do not delegate to +# those functions but instead duplicate the functionality here. +func_dirname_and_basename () +{ + case ${1} in + */*) func_dirname_result="${1%/*}${2}" ;; + * ) func_dirname_result="${3}" ;; + esac + func_basename_result="${1##*/}" +} + +# func_stripname prefix suffix name +# strip PREFIX and SUFFIX off of NAME. +# PREFIX and SUFFIX must not contain globbing or regex special +# characters, hashes, percent signs, but SUFFIX may contain a leading +# dot (in which case that matches only a dot). +func_stripname () +{ + # pdksh 5.2.14 does not do ${X%$Y} correctly if both X and Y are + # positional parameters, so assign one to ordinary parameter first. + func_stripname_result=${3} + func_stripname_result=${func_stripname_result#"${1}"} + func_stripname_result=${func_stripname_result%"${2}"} +} + +# func_opt_split +func_opt_split () +{ + func_opt_split_opt=${1%%=*} + func_opt_split_arg=${1#*=} +} + +# func_lo2o object +func_lo2o () +{ + case ${1} in + *.lo) func_lo2o_result=${1%.lo}.${objext} ;; + *) func_lo2o_result=${1} ;; + esac +} + +# func_xform libobj-or-source +func_xform () +{ + func_xform_result=${1%.*}.lo +} + +# func_arith arithmetic-term... +func_arith () +{ + func_arith_result=$(( $* )) +} + +# func_len string +# STRING may not start with a hyphen. +func_len () +{ + func_len_result=${#1} +} + +_LT_EOF + ;; + *) # Bourne compatible functions. + cat << \_LT_EOF >> "$cfgfile" + +# func_dirname file append nondir_replacement +# Compute the dirname of FILE. If nonempty, add APPEND to the result, +# otherwise set result to NONDIR_REPLACEMENT. +func_dirname () +{ + # Extract subdirectory from the argument. + func_dirname_result=`$ECHO "${1}" | $SED "$dirname"` + if test "X$func_dirname_result" = "X${1}"; then + func_dirname_result="${3}" + else + func_dirname_result="$func_dirname_result${2}" + fi +} + +# func_basename file +func_basename () +{ + func_basename_result=`$ECHO "${1}" | $SED "$basename"` +} + + +# func_stripname prefix suffix name +# strip PREFIX and SUFFIX off of NAME. +# PREFIX and SUFFIX must not contain globbing or regex special +# characters, hashes, percent signs, but SUFFIX may contain a leading +# dot (in which case that matches only a dot). +# func_strip_suffix prefix name +func_stripname () +{ + case ${2} in + .*) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%\\\\${2}\$%%"`;; + *) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%${2}\$%%"`;; + esac +} + +# sed scripts: +my_sed_long_opt='1s/^\(-[^=]*\)=.*/\1/;q' +my_sed_long_arg='1s/^-[^=]*=//' + +# func_opt_split +func_opt_split () +{ + func_opt_split_opt=`$ECHO "${1}" | $SED "$my_sed_long_opt"` + func_opt_split_arg=`$ECHO "${1}" | $SED "$my_sed_long_arg"` +} + +# func_lo2o object +func_lo2o () +{ + func_lo2o_result=`$ECHO "${1}" | $SED "$lo2o"` +} + +# func_xform libobj-or-source +func_xform () +{ + func_xform_result=`$ECHO "${1}" | $SED 's/\.[^.]*$/.lo/'` +} + +# func_arith arithmetic-term... +func_arith () +{ + func_arith_result=`expr "$@"` +} + +# func_len string +# STRING may not start with a hyphen. +func_len () +{ + func_len_result=`expr "$1" : ".*" 2>/dev/null || echo $max_cmd_len` +} + +_LT_EOF +esac + +case $lt_shell_append in + yes) + cat << \_LT_EOF >> "$cfgfile" + +# func_append var value +# Append VALUE to the end of shell variable VAR. +func_append () +{ + eval "$1+=\$2" +} +_LT_EOF + ;; + *) + cat << \_LT_EOF >> "$cfgfile" + +# func_append var value +# Append VALUE to the end of shell variable VAR. +func_append () +{ + eval "$1=\$$1\$2" +} + +_LT_EOF + ;; + esac + + + sed -n '/^# Generated shell functions inserted here/,$p' "$ltmain" >> "$cfgfile" \ + || (rm -f "$cfgfile"; exit 1) + + mv -f "$cfgfile" "$ofile" || + (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile") + chmod +x "$ofile" + + + cat <<_LT_EOF >> "$ofile" + +# ### BEGIN LIBTOOL TAG CONFIG: FC + +# The linker used to build libraries. +LD=$lt_LD_FC + +# How to create reloadable object files. +reload_flag=$lt_reload_flag_FC +reload_cmds=$lt_reload_cmds_FC + +# Commands used to build an old-style archive. +old_archive_cmds=$lt_old_archive_cmds_FC + +# A language specific compiler. +CC=$lt_compiler_FC + +# Is the compiler the GNU compiler? +with_gcc=$GCC_FC + +# Compiler flag to turn off builtin functions. +no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_FC + +# How to pass a linker flag through the compiler. +wl=$lt_lt_prog_compiler_wl_FC + +# Additional compiler flags for building library objects. +pic_flag=$lt_lt_prog_compiler_pic_FC + +# Compiler flag to prevent dynamic linking. +link_static_flag=$lt_lt_prog_compiler_static_FC + +# Does compiler simultaneously support -c and -o options? +compiler_c_o=$lt_lt_cv_prog_compiler_c_o_FC + +# Whether or not to add -lc for building shared libraries. +build_libtool_need_lc=$archive_cmds_need_lc_FC + +# Whether or not to disallow shared libs when runtime libs are static. +allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_FC + +# Compiler flag to allow reflexive dlopens. +export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_FC + +# Compiler flag to generate shared objects directly from archives. +whole_archive_flag_spec=$lt_whole_archive_flag_spec_FC + +# Whether the compiler copes with passing no objects directly. +compiler_needs_object=$lt_compiler_needs_object_FC + +# Create an old-style archive from a shared archive. +old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_FC + +# Create a temporary old-style archive to link instead of a shared archive. +old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_FC + +# Commands used to build a shared archive. +archive_cmds=$lt_archive_cmds_FC +archive_expsym_cmds=$lt_archive_expsym_cmds_FC + +# Commands used to build a loadable module if different from building +# a shared archive. +module_cmds=$lt_module_cmds_FC +module_expsym_cmds=$lt_module_expsym_cmds_FC + +# Whether we are building with GNU ld or not. +with_gnu_ld=$lt_with_gnu_ld_FC + +# Flag that allows shared libraries with undefined symbols to be built. +allow_undefined_flag=$lt_allow_undefined_flag_FC + +# Flag that enforces no undefined symbols. +no_undefined_flag=$lt_no_undefined_flag_FC + +# Flag to hardcode \$libdir into a binary during linking. +# This must work even if \$libdir does not exist +hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_FC + +# If ld is used when linking, flag to hardcode \$libdir into a binary +# during linking. This must work even if \$libdir does not exist. +hardcode_libdir_flag_spec_ld=$lt_hardcode_libdir_flag_spec_ld_FC + +# Whether we need a single "-rpath" flag with a separated argument. +hardcode_libdir_separator=$lt_hardcode_libdir_separator_FC + +# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes +# DIR into the resulting binary. +hardcode_direct=$hardcode_direct_FC + +# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes +# DIR into the resulting binary and the resulting library dependency is +# "absolute",i.e impossible to change by setting \${shlibpath_var} if the +# library is relocated. +hardcode_direct_absolute=$hardcode_direct_absolute_FC + +# Set to "yes" if using the -LDIR flag during linking hardcodes DIR +# into the resulting binary. +hardcode_minus_L=$hardcode_minus_L_FC + +# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR +# into the resulting binary. +hardcode_shlibpath_var=$hardcode_shlibpath_var_FC + +# Set to "yes" if building a shared library automatically hardcodes DIR +# into the library and all subsequent libraries and executables linked +# against it. +hardcode_automatic=$hardcode_automatic_FC + +# Set to yes if linker adds runtime paths of dependent libraries +# to runtime path list. +inherit_rpath=$inherit_rpath_FC + +# Whether libtool must link a program against all its dependency libraries. +link_all_deplibs=$link_all_deplibs_FC + +# Fix the shell variable \$srcfile for the compiler. +fix_srcfile_path=$lt_fix_srcfile_path_FC + +# Set to "yes" if exported symbols are required. +always_export_symbols=$always_export_symbols_FC + +# The commands to list exported symbols. +export_symbols_cmds=$lt_export_symbols_cmds_FC + +# Symbols that should not be listed in the preloaded symbols. +exclude_expsyms=$lt_exclude_expsyms_FC + +# Symbols that must always be exported. +include_expsyms=$lt_include_expsyms_FC + +# Commands necessary for linking programs (against libraries) with templates. +prelink_cmds=$lt_prelink_cmds_FC + +# Specify filename containing input files. +file_list_spec=$lt_file_list_spec_FC + +# How to hardcode a shared library path into an executable. +hardcode_action=$hardcode_action_FC + +# The directories searched by this compiler when creating a shared library. +compiler_lib_search_dirs=$lt_compiler_lib_search_dirs_FC + +# Dependencies to place before and after the objects being linked to +# create a shared library. +predep_objects=$lt_predep_objects_FC +postdep_objects=$lt_postdep_objects_FC +predeps=$lt_predeps_FC +postdeps=$lt_postdeps_FC + +# The library search path used internally by the compiler when linking +# a shared library. +compiler_lib_search_path=$lt_compiler_lib_search_path_FC + +# ### END LIBTOOL TAG CONFIG: FC +_LT_EOF + + ;; + "gstdint.h":C) +if test "$GCC" = yes; then + echo "/* generated for " `$CC --version | sed 1q` "*/" > tmp-stdint.h +else + echo "/* generated for $CC */" > tmp-stdint.h +fi + +sed 's/^ *//' >> tmp-stdint.h < +EOF + +if test "$acx_cv_header_stdint" != stdint.h; then + echo "#include " >> tmp-stdint.h +fi +if test "$acx_cv_header_stdint" != stddef.h; then + echo "#include <$acx_cv_header_stdint>" >> tmp-stdint.h +fi + +sed 's/^ *//' >> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <= 199901L + #ifndef _INT64_T + #define _INT64_T + #ifndef __int64_t_defined + #ifndef int64_t + typedef long long int64_t; + #endif + #endif + #endif + #ifndef _UINT64_T + #define _UINT64_T + #ifndef uint64_t + typedef unsigned long long uint64_t; + #endif + #endif + + #elif defined __GNUC__ && defined (__STDC__) && __STDC__-0 + /* NextStep 2.0 cc is really gcc 1.93 but it defines __GNUC__ = 2 and + does not implement __extension__. But that compiler doesn't define + __GNUC_MINOR__. */ + # if __GNUC__ < 2 || (__NeXT__ && !__GNUC_MINOR__) + # define __extension__ + # endif + + # ifndef _INT64_T + # define _INT64_T + # ifndef int64_t + __extension__ typedef long long int64_t; + # endif + # endif + # ifndef _UINT64_T + # define _UINT64_T + # ifndef uint64_t + __extension__ typedef unsigned long long uint64_t; + # endif + # endif + + #elif !defined __STRICT_ANSI__ + # if defined _MSC_VER || defined __WATCOMC__ || defined __BORLANDC__ + + # ifndef _INT64_T + # define _INT64_T + # ifndef int64_t + typedef __int64 int64_t; + # endif + # endif + # ifndef _UINT64_T + # define _UINT64_T + # ifndef uint64_t + typedef unsigned __int64 uint64_t; + # endif + # endif + # endif /* compiler */ + + #endif /* ANSI version */ +EOF +fi + +# ------------- done int64_t types, emit intptr types ------------ +if test "$ac_cv_type_uintptr_t" != yes; then + sed 's/^ *//' >> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h <> tmp-stdint.h </dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit $? +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac new file mode 100644 index 000000000..86d716130 --- /dev/null +++ b/libgfortran/configure.ac @@ -0,0 +1,577 @@ +# Process this file with autoconf to produce a configure script, like so: +# aclocal && autoconf && autoheader && automake + +AC_PREREQ(2.64) +AC_INIT([GNU Fortran Runtime Library], 0.3,,[libgfortran]) +AC_CONFIG_HEADER(config.h) +GCC_TOPLEV_SUBDIRS + +# ------- +# Options +# ------- + +AC_MSG_CHECKING([for --enable-version-specific-runtime-libs]) +AC_ARG_ENABLE(version-specific-runtime-libs, +AS_HELP_STRING([--enable-version-specific-runtime-libs], + [specify that runtime libraries should be installed in a compiler-specific directory]), +[case "$enableval" in + yes) version_specific_libs=yes ;; + no) version_specific_libs=no ;; + *) AC_MSG_ERROR([Unknown argument to enable/disable version-specific libs]);; + esac], +[version_specific_libs=no]) +AC_MSG_RESULT($version_specific_libs) + +# Build with intermodule optimisations +AC_MSG_CHECKING([for --enable-intermodule]) +AC_ARG_ENABLE(intermodule, +AS_HELP_STRING([--enable-intermodule],[build the library in one step]), +[case "$enable_intermodule" in + yes) onestep="-onestep";; + *) onestep="";; +esac], +[onestep=""]) +AC_MSG_RESULT($enable_intermodule) +AM_CONDITIONAL(onestep,[test x$onestep = x-onestep]) +AC_SUBST(onestep) + +# Gets build, host, target, *_vendor, *_cpu, *_os, etc. +# +# You will slowly go insane if you do not grok the following fact: when +# building this library, the top-level /target/ becomes the library's /host/. +# +# configure then causes --target to default to --host, exactly like any +# other package using autoconf. Therefore, 'target' and 'host' will +# always be the same. This makes sense both for native and cross compilers +# just think about it for a little while. :-) +# +# Also, if this library is being configured as part of a cross compiler, the +# top-level configure script will pass the "real" host as $with_cross_host. +# +# Do not delete or change the following two lines. For why, see +# http://gcc.gnu.org/ml/libstdc++/2003-07/msg00451.html +AC_CANONICAL_SYSTEM +target_alias=${target_alias-$host_alias} + +# Sets up automake. Must come after AC_CANONICAL_SYSTEM. Each of the +# following is magically included in AUTOMAKE_OPTIONS in each Makefile.am. +# 1.9.6: minimum required version +# no-define: PACKAGE and VERSION will not be #define'd in config.h (a bunch +# of other PACKAGE_* variables will, however, and there's nothing +# we can do about that; they come from AC_INIT). +# foreign: we don't follow the normal rules for GNU packages (no COPYING +# file in the top srcdir, etc, etc), so stop complaining. +# no-dist: we don't want 'dist' and related rules. +# -Wall: turns on all automake warnings... +# -Wno-portability: ...except this one, since GNU make is required. +AM_INIT_AUTOMAKE([1.9.6 no-define foreign no-dist -Wall -Wno-portability]) + +AM_MAINTAINER_MODE +AM_ENABLE_MULTILIB(, ..) + +# Handy for debugging: +#AC_MSG_NOTICE($build / $host / $target / $host_alias / $target_alias); sleep 5 + +# Are we being configured with some form of cross compiler? +# NB: We don't actually need to know this just now, but when, say, a test +# suite is included, we'll have to know. +if test "$build" != "$host"; then + LIBGFOR_IS_NATIVE=false + GCC_NO_EXECUTABLES +else + LIBGFOR_IS_NATIVE=true +fi + +AC_USE_SYSTEM_EXTENSIONS + +# Calculate toolexeclibdir +# Also toolexecdir, though it's only used in toolexeclibdir +case ${version_specific_libs} in + yes) + # Need the gcc compiler version to know where to install libraries + # and header files if --enable-version-specific-runtime-libs option + # is selected. + toolexecdir='$(libdir)/gcc/$(target_alias)' + toolexeclibdir='$(toolexecdir)/$(gcc_version)$(MULTISUBDIR)' + ;; + no) + if test -n "$with_cross_host" && + test x"$with_cross_host" != x"no"; then + # Install a library built with a cross compiler in tooldir, not libdir. + toolexecdir='$(exec_prefix)/$(target_alias)' + toolexeclibdir='$(toolexecdir)/lib' + else + toolexecdir='$(libdir)/gcc-lib/$(target_alias)' + toolexeclibdir='$(libdir)' + fi + multi_os_directory=`$CC -print-multi-os-directory` + case $multi_os_directory in + .) ;; # Avoid trailing /. + *) toolexeclibdir=$toolexeclibdir/$multi_os_directory ;; + esac + ;; +esac +AC_SUBST(toolexecdir) +AC_SUBST(toolexeclibdir) + +# Create a spec file, so that compile/link tests don't fail +test -f libgfortran.spec || touch libgfortran.spec + +# Check the compiler. +# The same as in boehm-gc and libstdc++. Have to borrow it from there. +# We must force CC to /not/ be precious variables; otherwise +# the wrong, non-multilib-adjusted value will be used in multilibs. +# As a side effect, we have to subst CFLAGS ourselves. + +m4_rename([_AC_ARG_VAR_PRECIOUS],[real_PRECIOUS]) +m4_define([_AC_ARG_VAR_PRECIOUS],[]) +AC_PROG_CC +m4_rename_force([real_PRECIOUS],[_AC_ARG_VAR_PRECIOUS]) + +# Add -Wall -fno-repack-arrays -fno-underscoring if we are using GCC. +if test "x$GCC" = "xyes"; then + AM_FCFLAGS="-I . -Wall -Werror -fimplicit-none -fno-repack-arrays -fno-underscoring" + ## We like to use C99 routines when available. This makes sure that + ## __STDC_VERSION__ is set such that libc includes make them available. + AM_CFLAGS="-std=gnu99 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings" + ## Compile the following tests with the same system header contents + ## that we'll encounter when compiling our own source files. + CFLAGS="-std=gnu99 $CFLAGS" +fi +AC_SUBST(AM_FCFLAGS) +AC_SUBST(AM_CFLAGS) +AC_SUBST(CFLAGS) + +# Check for symbol versioning (copied from libssp). +AC_MSG_CHECKING([whether symbol versioning is supported]) +AC_ARG_ENABLE(symvers, +AS_HELP_STRING([--disable-symvers], + [disable symbol versioning for libgfortran]), +gfortran_use_symver=$enableval, +gfortran_use_symver=yes) +if test "x$gfortran_use_symver" = xyes; then + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS -fPIC -shared -Wl,--version-script,./conftest.map" + cat > conftest.map < conftest.map < +#include +#include ], [ + getpwuid_r(0, NULL, NULL, 0, NULL); + ])], [libgfor_cv_posix_getpwuid_r="yes"], [libgfor_cv_posix_getpwuid_r="no"])]) +fi +if test "$libgfor_cv_posix_getpwuid_r" = "yes"; then + AC_DEFINE([HAVE_POSIX_GETPWUID_R], [1], [Define to 1 if we have POSIX getpwuid_r which takes 5 arguments.]) +fi + + +# Check out attribute support. +LIBGFOR_CHECK_ATTRIBUTE_VISIBILITY +LIBGFOR_CHECK_ATTRIBUTE_DLLEXPORT +LIBGFOR_CHECK_ATTRIBUTE_ALIAS + +# Check out sync builtins support. +LIBGFOR_CHECK_SYNC_FETCH_AND_ADD + +# Check out thread support. +LIBGFOR_CHECK_GTHR_DEFAULT + +# Check out #pragma weak. +LIBGFOR_GTHREAD_WEAK + +# Various other checks on target +LIBGFOR_CHECK_UNLINK_OPEN_FILE + +# Check whether line terminator is LF or CRLF +LIBGFOR_CHECK_CRLF + +AC_CACHE_SAVE + +if test ${multilib} = yes; then + multilib_arg="--enable-multilib" +else + multilib_arg= +fi + +# Write our Makefile and spec file. +AC_CONFIG_FILES([ +Makefile +libgfortran.spec +]) +AC_OUTPUT diff --git a/libgfortran/configure.host b/libgfortran/configure.host new file mode 100644 index 000000000..eb68c934c --- /dev/null +++ b/libgfortran/configure.host @@ -0,0 +1,47 @@ +# configure.host +# +# This shell script handles all host based configuration for libgfortran. +# It sets various shell variables based on the the host triplet. +# You can modify this shell script without rerunning autoconf/aclocal/etc. +# This file is "sourced", not executed. +# +# +# It uses the following shell variables as set by config.guess: +# host The configuration host (full CPU-vendor-OS triplet) +# host_cpu The configuration host CPU +# host_os The configuration host OS +# +# +# It sets the following shell variables: +# +# fpu_host FPU-specific code file, defaults to fpu-generic. + + +# DEFAULTS +fpu_host='fpu-generic' + +# HOST-SPECIFIC OVERRIDES +case "${host_cpu}" in + i?86 | x86_64) + fpu_host='fpu-387' ;; +esac + +# CONFIGURATION-SPECIFIC OVERRIDES +if test "x${have_feenableexcept}" = "xyes"; then + fpu_host='fpu-glibc' +fi + +if test "x${have_fpsetmask}" = "xyes"; then + fpu_host='fpu-sysv' +fi + +if test "x${have_fp_enable}" = "xyes" && test "x${have_fp_trap}" = "xyes"; then + fpu_host='fpu-aix' +fi + +# Some targets require additional compiler options for NaN/Inf. +ieee_flags= +case "${host_cpu}" in + sh*) + ieee_flags="-mieee" ;; +esac diff --git a/libgfortran/fmain.c b/libgfortran/fmain.c new file mode 100644 index 000000000..a99263cc5 --- /dev/null +++ b/libgfortran/fmain.c @@ -0,0 +1,24 @@ +/* Note that this file is not used as of GFortran 4.5, and exists here + only for backwards compatibility. */ + +#include "libgfortran.h" + +/* The main Fortran program actually is a function, called MAIN__. + We call it from the main() function in this file. */ +void MAIN__ (void); + +/* Main procedure for fortran programs. All we do is set up the environment + for the Fortran program. */ +int +main (int argc, char *argv[]) +{ + /* Set up the runtime environment. */ + set_args (argc, argv); + + /* Call the Fortran main program. Internally this is a function + called MAIN__ */ + MAIN__ (); + + /* Bye-bye! */ + return 0; +} diff --git a/libgfortran/generated/_abs_c10.F90 b/libgfortran/generated/_abs_c10.F90 new file mode 100644 index 000000000..96938938e --- /dev/null +++ b/libgfortran/generated/_abs_c10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__abs_c10 (parm) + complex (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__abs_c10 + + _gfortran_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 index 000000000..db5cb0087 --- /dev/null +++ b/libgfortran/generated/_abs_c16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__abs_c16 (parm) + complex (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__abs_c16 + + _gfortran_specific__abs_c16 = abs (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_abs_c4.F90 b/libgfortran/generated/_abs_c4.F90 new file mode 100644 index 000000000..d0cb85be3 --- /dev/null +++ b/libgfortran/generated/_abs_c4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__abs_c4 (parm) + complex (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__abs_c4 + + _gfortran_specific__abs_c4 = abs (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_abs_c8.F90 b/libgfortran/generated/_abs_c8.F90 new file mode 100644 index 000000000..b5a284931 --- /dev/null +++ b/libgfortran/generated/_abs_c8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__abs_c8 (parm) + complex (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__abs_c8 + + _gfortran_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 index 000000000..d7b825bfa --- /dev/null +++ b/libgfortran/generated/_abs_i16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_16) + + +elemental function _gfortran_specific__abs_i16 (parm) + integer (kind=16), intent (in) :: parm + integer (kind=16) :: _gfortran_specific__abs_i16 + + _gfortran_specific__abs_i16 = abs (parm) +end function + + +#endif diff --git a/libgfortran/generated/_abs_i4.F90 b/libgfortran/generated/_abs_i4.F90 new file mode 100644 index 000000000..3d6619a27 --- /dev/null +++ b/libgfortran/generated/_abs_i4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_4) + + +elemental function _gfortran_specific__abs_i4 (parm) + integer (kind=4), intent (in) :: parm + integer (kind=4) :: _gfortran_specific__abs_i4 + + _gfortran_specific__abs_i4 = abs (parm) +end function + + +#endif diff --git a/libgfortran/generated/_abs_i8.F90 b/libgfortran/generated/_abs_i8.F90 new file mode 100644 index 000000000..9e68ba667 --- /dev/null +++ b/libgfortran/generated/_abs_i8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_8) + + +elemental function _gfortran_specific__abs_i8 (parm) + integer (kind=8), intent (in) :: parm + integer (kind=8) :: _gfortran_specific__abs_i8 + + _gfortran_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 index 000000000..26b6aa6c7 --- /dev/null +++ b/libgfortran/generated/_abs_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__abs_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__abs_r10 + + _gfortran_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 index 000000000..3117d4a58 --- /dev/null +++ b/libgfortran/generated/_abs_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__abs_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__abs_r16 + + _gfortran_specific__abs_r16 = abs (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_abs_r4.F90 b/libgfortran/generated/_abs_r4.F90 new file mode 100644 index 000000000..bb4ac4a76 --- /dev/null +++ b/libgfortran/generated/_abs_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__abs_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__abs_r4 + + _gfortran_specific__abs_r4 = abs (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_abs_r8.F90 b/libgfortran/generated/_abs_r8.F90 new file mode 100644 index 000000000..b41e69821 --- /dev/null +++ b/libgfortran/generated/_abs_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__abs_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__abs_r8 + + _gfortran_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 index 000000000..d5c3cd5a4 --- /dev/null +++ b/libgfortran/generated/_acos_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__acos_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__acos_r10 + + _gfortran_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 index 000000000..80aa22c8b --- /dev/null +++ b/libgfortran/generated/_acos_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__acos_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__acos_r16 + + _gfortran_specific__acos_r16 = acos (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_acos_r4.F90 b/libgfortran/generated/_acos_r4.F90 new file mode 100644 index 000000000..300524ed6 --- /dev/null +++ b/libgfortran/generated/_acos_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__acos_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__acos_r4 + + _gfortran_specific__acos_r4 = acos (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_acos_r8.F90 b/libgfortran/generated/_acos_r8.F90 new file mode 100644 index 000000000..ca526cbb0 --- /dev/null +++ b/libgfortran/generated/_acos_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__acos_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__acos_r8 + + _gfortran_specific__acos_r8 = acos (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_acosh_r10.F90 b/libgfortran/generated/_acosh_r10.F90 new file mode 100644 index 000000000..f8193f9df --- /dev/null +++ b/libgfortran/generated/_acosh_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_10) +#ifdef HAVE_ACOSHL + +elemental function _gfortran_specific__acosh_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__acosh_r10 + + _gfortran_specific__acosh_r10 = acosh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_acosh_r16.F90 b/libgfortran/generated/_acosh_r16.F90 new file mode 100644 index 000000000..e2ae3bde8 --- /dev/null +++ b/libgfortran/generated/_acosh_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_16) +#ifdef HAVE_ACOSHL + +elemental function _gfortran_specific__acosh_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__acosh_r16 + + _gfortran_specific__acosh_r16 = acosh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_acosh_r4.F90 b/libgfortran/generated/_acosh_r4.F90 new file mode 100644 index 000000000..61412c32e --- /dev/null +++ b/libgfortran/generated/_acosh_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_4) +#ifdef HAVE_ACOSHF + +elemental function _gfortran_specific__acosh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__acosh_r4 + + _gfortran_specific__acosh_r4 = acosh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_acosh_r8.F90 b/libgfortran/generated/_acosh_r8.F90 new file mode 100644 index 000000000..cb230aeed --- /dev/null +++ b/libgfortran/generated/_acosh_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_8) +#ifdef HAVE_ACOSH + +elemental function _gfortran_specific__acosh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__acosh_r8 + + _gfortran_specific__acosh_r8 = acosh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_aimag_c10.F90 b/libgfortran/generated/_aimag_c10.F90 new file mode 100644 index 000000000..584299e39 --- /dev/null +++ b/libgfortran/generated/_aimag_c10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_COMPLEX_10) + + +elemental function _gfortran_specific__aimag_c10 (parm) + complex (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__aimag_c10 + + _gfortran_specific__aimag_c10 = aimag (parm) +end function + + +#endif diff --git a/libgfortran/generated/_aimag_c16.F90 b/libgfortran/generated/_aimag_c16.F90 new file mode 100644 index 000000000..01f24a282 --- /dev/null +++ b/libgfortran/generated/_aimag_c16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_COMPLEX_16) + + +elemental function _gfortran_specific__aimag_c16 (parm) + complex (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__aimag_c16 + + _gfortran_specific__aimag_c16 = aimag (parm) +end function + + +#endif diff --git a/libgfortran/generated/_aimag_c4.F90 b/libgfortran/generated/_aimag_c4.F90 new file mode 100644 index 000000000..d52e057cf --- /dev/null +++ b/libgfortran/generated/_aimag_c4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_COMPLEX_4) + + +elemental function _gfortran_specific__aimag_c4 (parm) + complex (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__aimag_c4 + + _gfortran_specific__aimag_c4 = aimag (parm) +end function + + +#endif diff --git a/libgfortran/generated/_aimag_c8.F90 b/libgfortran/generated/_aimag_c8.F90 new file mode 100644 index 000000000..b1a933ffc --- /dev/null +++ b/libgfortran/generated/_aimag_c8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_COMPLEX_8) + + +elemental function _gfortran_specific__aimag_c8 (parm) + complex (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__aimag_c8 + + _gfortran_specific__aimag_c8 = aimag (parm) +end function + + +#endif diff --git a/libgfortran/generated/_aint_r10.F90 b/libgfortran/generated/_aint_r10.F90 new file mode 100644 index 000000000..47a942405 --- /dev/null +++ b/libgfortran/generated/_aint_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__aint_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__aint_r10 + + _gfortran_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 index 000000000..b91640ee2 --- /dev/null +++ b/libgfortran/generated/_aint_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__aint_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__aint_r16 + + _gfortran_specific__aint_r16 = aint (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_aint_r4.F90 b/libgfortran/generated/_aint_r4.F90 new file mode 100644 index 000000000..7607afdc6 --- /dev/null +++ b/libgfortran/generated/_aint_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__aint_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__aint_r4 + + _gfortran_specific__aint_r4 = aint (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_aint_r8.F90 b/libgfortran/generated/_aint_r8.F90 new file mode 100644 index 000000000..c0b666aa0 --- /dev/null +++ b/libgfortran/generated/_aint_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__aint_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__aint_r8 + + _gfortran_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 index 000000000..a768642e1 --- /dev/null +++ b/libgfortran/generated/_anint_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__anint_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__anint_r10 + + _gfortran_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 index 000000000..924b9143c --- /dev/null +++ b/libgfortran/generated/_anint_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__anint_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__anint_r16 + + _gfortran_specific__anint_r16 = anint (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_anint_r4.F90 b/libgfortran/generated/_anint_r4.F90 new file mode 100644 index 000000000..000a20b01 --- /dev/null +++ b/libgfortran/generated/_anint_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__anint_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__anint_r4 + + _gfortran_specific__anint_r4 = anint (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_anint_r8.F90 b/libgfortran/generated/_anint_r8.F90 new file mode 100644 index 000000000..be122bd3f --- /dev/null +++ b/libgfortran/generated/_anint_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__anint_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__anint_r8 + + _gfortran_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 index 000000000..fe2b68a23 --- /dev/null +++ b/libgfortran/generated/_asin_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__asin_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__asin_r10 + + _gfortran_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 index 000000000..87bf9e783 --- /dev/null +++ b/libgfortran/generated/_asin_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__asin_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__asin_r16 + + _gfortran_specific__asin_r16 = asin (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_asin_r4.F90 b/libgfortran/generated/_asin_r4.F90 new file mode 100644 index 000000000..63367d1e8 --- /dev/null +++ b/libgfortran/generated/_asin_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__asin_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__asin_r4 + + _gfortran_specific__asin_r4 = asin (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_asin_r8.F90 b/libgfortran/generated/_asin_r8.F90 new file mode 100644 index 000000000..97e0088bd --- /dev/null +++ b/libgfortran/generated/_asin_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__asin_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__asin_r8 + + _gfortran_specific__asin_r8 = asin (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_asinh_r10.F90 b/libgfortran/generated/_asinh_r10.F90 new file mode 100644 index 000000000..a05abe78d --- /dev/null +++ b/libgfortran/generated/_asinh_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_10) +#ifdef HAVE_ASINHL + +elemental function _gfortran_specific__asinh_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__asinh_r10 + + _gfortran_specific__asinh_r10 = asinh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_asinh_r16.F90 b/libgfortran/generated/_asinh_r16.F90 new file mode 100644 index 000000000..e0e94d547 --- /dev/null +++ b/libgfortran/generated/_asinh_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_16) +#ifdef HAVE_ASINHL + +elemental function _gfortran_specific__asinh_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__asinh_r16 + + _gfortran_specific__asinh_r16 = asinh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_asinh_r4.F90 b/libgfortran/generated/_asinh_r4.F90 new file mode 100644 index 000000000..f80bf5084 --- /dev/null +++ b/libgfortran/generated/_asinh_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_4) +#ifdef HAVE_ASINHF + +elemental function _gfortran_specific__asinh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__asinh_r4 + + _gfortran_specific__asinh_r4 = asinh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_asinh_r8.F90 b/libgfortran/generated/_asinh_r8.F90 new file mode 100644 index 000000000..8b636a65c --- /dev/null +++ b/libgfortran/generated/_asinh_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_8) +#ifdef HAVE_ASINH + +elemental function _gfortran_specific__asinh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__asinh_r8 + + _gfortran_specific__asinh_r8 = asinh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_atan2_r10.F90 b/libgfortran/generated/_atan2_r10.F90 new file mode 100644 index 000000000..c38b3c335 --- /dev/null +++ b/libgfortran/generated/_atan2_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__atan2_r10 (p1, p2) + real (kind=10), intent (in) :: p1, p2 + real (kind=10) :: _gfortran_specific__atan2_r10 + + _gfortran_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 index 000000000..4d65da2a8 --- /dev/null +++ b/libgfortran/generated/_atan2_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__atan2_r16 (p1, p2) + real (kind=16), intent (in) :: p1, p2 + real (kind=16) :: _gfortran_specific__atan2_r16 + + _gfortran_specific__atan2_r16 = atan2 (p1, p2) +end function + +#endif + +#endif diff --git a/libgfortran/generated/_atan2_r4.F90 b/libgfortran/generated/_atan2_r4.F90 new file mode 100644 index 000000000..cdebd47dd --- /dev/null +++ b/libgfortran/generated/_atan2_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__atan2_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: _gfortran_specific__atan2_r4 + + _gfortran_specific__atan2_r4 = atan2 (p1, p2) +end function + +#endif + +#endif diff --git a/libgfortran/generated/_atan2_r8.F90 b/libgfortran/generated/_atan2_r8.F90 new file mode 100644 index 000000000..7cfe47ec7 --- /dev/null +++ b/libgfortran/generated/_atan2_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__atan2_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: _gfortran_specific__atan2_r8 + + _gfortran_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 index 000000000..36a813b69 --- /dev/null +++ b/libgfortran/generated/_atan_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__atan_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__atan_r10 + + _gfortran_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 index 000000000..b177eeb19 --- /dev/null +++ b/libgfortran/generated/_atan_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__atan_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__atan_r16 + + _gfortran_specific__atan_r16 = atan (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_atan_r4.F90 b/libgfortran/generated/_atan_r4.F90 new file mode 100644 index 000000000..0ec9fe64b --- /dev/null +++ b/libgfortran/generated/_atan_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__atan_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__atan_r4 + + _gfortran_specific__atan_r4 = atan (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_atan_r8.F90 b/libgfortran/generated/_atan_r8.F90 new file mode 100644 index 000000000..df118004a --- /dev/null +++ b/libgfortran/generated/_atan_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__atan_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__atan_r8 + + _gfortran_specific__atan_r8 = atan (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_atanh_r10.F90 b/libgfortran/generated/_atanh_r10.F90 new file mode 100644 index 000000000..a695cee9a --- /dev/null +++ b/libgfortran/generated/_atanh_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_10) +#ifdef HAVE_ATANHL + +elemental function _gfortran_specific__atanh_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__atanh_r10 + + _gfortran_specific__atanh_r10 = atanh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_atanh_r16.F90 b/libgfortran/generated/_atanh_r16.F90 new file mode 100644 index 000000000..d7e216c3e --- /dev/null +++ b/libgfortran/generated/_atanh_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_16) +#ifdef HAVE_ATANHL + +elemental function _gfortran_specific__atanh_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__atanh_r16 + + _gfortran_specific__atanh_r16 = atanh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_atanh_r4.F90 b/libgfortran/generated/_atanh_r4.F90 new file mode 100644 index 000000000..09fc73f5c --- /dev/null +++ b/libgfortran/generated/_atanh_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_4) +#ifdef HAVE_ATANHF + +elemental function _gfortran_specific__atanh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__atanh_r4 + + _gfortran_specific__atanh_r4 = atanh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_atanh_r8.F90 b/libgfortran/generated/_atanh_r8.F90 new file mode 100644 index 000000000..f78eca062 --- /dev/null +++ b/libgfortran/generated/_atanh_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_8) +#ifdef HAVE_ATANH + +elemental function _gfortran_specific__atanh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__atanh_r8 + + _gfortran_specific__atanh_r8 = atanh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_conjg_c10.F90 b/libgfortran/generated/_conjg_c10.F90 new file mode 100644 index 000000000..d53ac1e19 --- /dev/null +++ b/libgfortran/generated/_conjg_c10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_COMPLEX_10) + + +elemental function _gfortran_specific__conjg_10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: _gfortran_specific__conjg_10 + + _gfortran_specific__conjg_10 = conjg (parm) +end function + + +#endif diff --git a/libgfortran/generated/_conjg_c16.F90 b/libgfortran/generated/_conjg_c16.F90 new file mode 100644 index 000000000..0052f611c --- /dev/null +++ b/libgfortran/generated/_conjg_c16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_COMPLEX_16) + + +elemental function _gfortran_specific__conjg_16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: _gfortran_specific__conjg_16 + + _gfortran_specific__conjg_16 = conjg (parm) +end function + + +#endif diff --git a/libgfortran/generated/_conjg_c4.F90 b/libgfortran/generated/_conjg_c4.F90 new file mode 100644 index 000000000..138266eba --- /dev/null +++ b/libgfortran/generated/_conjg_c4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_COMPLEX_4) + + +elemental function _gfortran_specific__conjg_4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: _gfortran_specific__conjg_4 + + _gfortran_specific__conjg_4 = conjg (parm) +end function + + +#endif diff --git a/libgfortran/generated/_conjg_c8.F90 b/libgfortran/generated/_conjg_c8.F90 new file mode 100644 index 000000000..ed1c8f5e1 --- /dev/null +++ b/libgfortran/generated/_conjg_c8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_COMPLEX_8) + + +elemental function _gfortran_specific__conjg_8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: _gfortran_specific__conjg_8 + + _gfortran_specific__conjg_8 = conjg (parm) +end function + + +#endif diff --git a/libgfortran/generated/_cos_c10.F90 b/libgfortran/generated/_cos_c10.F90 new file mode 100644 index 000000000..612d4387e --- /dev/null +++ b/libgfortran/generated/_cos_c10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cos_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: _gfortran_specific__cos_c10 + + _gfortran_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 index 000000000..7cea76493 --- /dev/null +++ b/libgfortran/generated/_cos_c16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cos_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: _gfortran_specific__cos_c16 + + _gfortran_specific__cos_c16 = cos (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_cos_c4.F90 b/libgfortran/generated/_cos_c4.F90 new file mode 100644 index 000000000..f0dd76e8d --- /dev/null +++ b/libgfortran/generated/_cos_c4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cos_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: _gfortran_specific__cos_c4 + + _gfortran_specific__cos_c4 = cos (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_cos_c8.F90 b/libgfortran/generated/_cos_c8.F90 new file mode 100644 index 000000000..7acc35a69 --- /dev/null +++ b/libgfortran/generated/_cos_c8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cos_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: _gfortran_specific__cos_c8 + + _gfortran_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 index 000000000..678dccb57 --- /dev/null +++ b/libgfortran/generated/_cos_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cos_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__cos_r10 + + _gfortran_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 index 000000000..dacd87721 --- /dev/null +++ b/libgfortran/generated/_cos_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cos_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__cos_r16 + + _gfortran_specific__cos_r16 = cos (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_cos_r4.F90 b/libgfortran/generated/_cos_r4.F90 new file mode 100644 index 000000000..c6dc39ae3 --- /dev/null +++ b/libgfortran/generated/_cos_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cos_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__cos_r4 + + _gfortran_specific__cos_r4 = cos (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_cos_r8.F90 b/libgfortran/generated/_cos_r8.F90 new file mode 100644 index 000000000..51b42cd99 --- /dev/null +++ b/libgfortran/generated/_cos_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cos_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__cos_r8 + + _gfortran_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 index 000000000..b7826f25e --- /dev/null +++ b/libgfortran/generated/_cosh_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cosh_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__cosh_r10 + + _gfortran_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 index 000000000..adbb56732 --- /dev/null +++ b/libgfortran/generated/_cosh_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cosh_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__cosh_r16 + + _gfortran_specific__cosh_r16 = cosh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_cosh_r4.F90 b/libgfortran/generated/_cosh_r4.F90 new file mode 100644 index 000000000..98719312e --- /dev/null +++ b/libgfortran/generated/_cosh_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cosh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__cosh_r4 + + _gfortran_specific__cosh_r4 = cosh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_cosh_r8.F90 b/libgfortran/generated/_cosh_r8.F90 new file mode 100644 index 000000000..4b0362f2e --- /dev/null +++ b/libgfortran/generated/_cosh_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__cosh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__cosh_r8 + + _gfortran_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 index 000000000..70753b42f --- /dev/null +++ b/libgfortran/generated/_dim_i16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_16) + + + +elemental function _gfortran_specific__dim_i16 (p1, p2) + integer (kind=16), intent (in) :: p1, p2 + integer (kind=16) :: _gfortran_specific__dim_i16 + + _gfortran_specific__dim_i16 = dim (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_dim_i4.F90 b/libgfortran/generated/_dim_i4.F90 new file mode 100644 index 000000000..c80a367f1 --- /dev/null +++ b/libgfortran/generated/_dim_i4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_4) + + + +elemental function _gfortran_specific__dim_i4 (p1, p2) + integer (kind=4), intent (in) :: p1, p2 + integer (kind=4) :: _gfortran_specific__dim_i4 + + _gfortran_specific__dim_i4 = dim (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_dim_i8.F90 b/libgfortran/generated/_dim_i8.F90 new file mode 100644 index 000000000..cbb45fcf1 --- /dev/null +++ b/libgfortran/generated/_dim_i8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_8) + + + +elemental function _gfortran_specific__dim_i8 (p1, p2) + integer (kind=8), intent (in) :: p1, p2 + integer (kind=8) :: _gfortran_specific__dim_i8 + + _gfortran_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 index 000000000..e84e1428f --- /dev/null +++ b/libgfortran/generated/_dim_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_10) + + + +elemental function _gfortran_specific__dim_r10 (p1, p2) + real (kind=10), intent (in) :: p1, p2 + real (kind=10) :: _gfortran_specific__dim_r10 + + _gfortran_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 index 000000000..6738e735c --- /dev/null +++ b/libgfortran/generated/_dim_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_16) + + + +elemental function _gfortran_specific__dim_r16 (p1, p2) + real (kind=16), intent (in) :: p1, p2 + real (kind=16) :: _gfortran_specific__dim_r16 + + _gfortran_specific__dim_r16 = dim (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_dim_r4.F90 b/libgfortran/generated/_dim_r4.F90 new file mode 100644 index 000000000..22f5f0092 --- /dev/null +++ b/libgfortran/generated/_dim_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_4) + + + +elemental function _gfortran_specific__dim_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: _gfortran_specific__dim_r4 + + _gfortran_specific__dim_r4 = dim (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_dim_r8.F90 b/libgfortran/generated/_dim_r8.F90 new file mode 100644 index 000000000..e209b9452 --- /dev/null +++ b/libgfortran/generated/_dim_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_8) + + + +elemental function _gfortran_specific__dim_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: _gfortran_specific__dim_r8 + + _gfortran_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 index 000000000..5549cd630 --- /dev/null +++ b/libgfortran/generated/_exp_c10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__exp_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: _gfortran_specific__exp_c10 + + _gfortran_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 index 000000000..09f4b72a9 --- /dev/null +++ b/libgfortran/generated/_exp_c16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__exp_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: _gfortran_specific__exp_c16 + + _gfortran_specific__exp_c16 = exp (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_exp_c4.F90 b/libgfortran/generated/_exp_c4.F90 new file mode 100644 index 000000000..27c030aae --- /dev/null +++ b/libgfortran/generated/_exp_c4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__exp_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: _gfortran_specific__exp_c4 + + _gfortran_specific__exp_c4 = exp (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_exp_c8.F90 b/libgfortran/generated/_exp_c8.F90 new file mode 100644 index 000000000..9b03a7120 --- /dev/null +++ b/libgfortran/generated/_exp_c8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__exp_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: _gfortran_specific__exp_c8 + + _gfortran_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 index 000000000..c66a1b71a --- /dev/null +++ b/libgfortran/generated/_exp_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__exp_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__exp_r10 + + _gfortran_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 index 000000000..3c6c02db6 --- /dev/null +++ b/libgfortran/generated/_exp_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__exp_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__exp_r16 + + _gfortran_specific__exp_r16 = exp (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_exp_r4.F90 b/libgfortran/generated/_exp_r4.F90 new file mode 100644 index 000000000..2ed5ee383 --- /dev/null +++ b/libgfortran/generated/_exp_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__exp_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__exp_r4 + + _gfortran_specific__exp_r4 = exp (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_exp_r8.F90 b/libgfortran/generated/_exp_r8.F90 new file mode 100644 index 000000000..64111e0ab --- /dev/null +++ b/libgfortran/generated/_exp_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__exp_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__exp_r8 + + _gfortran_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 index 000000000..4aa1f9826 --- /dev/null +++ b/libgfortran/generated/_log10_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log10_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__log10_r10 + + _gfortran_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 index 000000000..0af36baa8 --- /dev/null +++ b/libgfortran/generated/_log10_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log10_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__log10_r16 + + _gfortran_specific__log10_r16 = log10 (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_log10_r4.F90 b/libgfortran/generated/_log10_r4.F90 new file mode 100644 index 000000000..d98851fce --- /dev/null +++ b/libgfortran/generated/_log10_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log10_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__log10_r4 + + _gfortran_specific__log10_r4 = log10 (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_log10_r8.F90 b/libgfortran/generated/_log10_r8.F90 new file mode 100644 index 000000000..cd687d009 --- /dev/null +++ b/libgfortran/generated/_log10_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log10_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__log10_r8 + + _gfortran_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 index 000000000..c7524e4ed --- /dev/null +++ b/libgfortran/generated/_log_c10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: _gfortran_specific__log_c10 + + _gfortran_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 index 000000000..32a8171db --- /dev/null +++ b/libgfortran/generated/_log_c16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: _gfortran_specific__log_c16 + + _gfortran_specific__log_c16 = log (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_log_c4.F90 b/libgfortran/generated/_log_c4.F90 new file mode 100644 index 000000000..b57818b51 --- /dev/null +++ b/libgfortran/generated/_log_c4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: _gfortran_specific__log_c4 + + _gfortran_specific__log_c4 = log (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_log_c8.F90 b/libgfortran/generated/_log_c8.F90 new file mode 100644 index 000000000..3572b7d0a --- /dev/null +++ b/libgfortran/generated/_log_c8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: _gfortran_specific__log_c8 + + _gfortran_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 index 000000000..86c19aa8d --- /dev/null +++ b/libgfortran/generated/_log_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__log_r10 + + _gfortran_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 index 000000000..094a04b89 --- /dev/null +++ b/libgfortran/generated/_log_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__log_r16 + + _gfortran_specific__log_r16 = log (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_log_r4.F90 b/libgfortran/generated/_log_r4.F90 new file mode 100644 index 000000000..21dfc77d3 --- /dev/null +++ b/libgfortran/generated/_log_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__log_r4 + + _gfortran_specific__log_r4 = log (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_log_r8.F90 b/libgfortran/generated/_log_r8.F90 new file mode 100644 index 000000000..7d0dc9211 --- /dev/null +++ b/libgfortran/generated/_log_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__log_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__log_r8 + + _gfortran_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 index 000000000..343699a8b --- /dev/null +++ b/libgfortran/generated/_mod_i16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_16) + + + +elemental function _gfortran_specific__mod_i16 (p1, p2) + integer (kind=16), intent (in) :: p1, p2 + integer (kind=16) :: _gfortran_specific__mod_i16 + + _gfortran_specific__mod_i16 = mod (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_mod_i4.F90 b/libgfortran/generated/_mod_i4.F90 new file mode 100644 index 000000000..47e835294 --- /dev/null +++ b/libgfortran/generated/_mod_i4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_4) + + + +elemental function _gfortran_specific__mod_i4 (p1, p2) + integer (kind=4), intent (in) :: p1, p2 + integer (kind=4) :: _gfortran_specific__mod_i4 + + _gfortran_specific__mod_i4 = mod (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_mod_i8.F90 b/libgfortran/generated/_mod_i8.F90 new file mode 100644 index 000000000..64418d238 --- /dev/null +++ b/libgfortran/generated/_mod_i8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_8) + + + +elemental function _gfortran_specific__mod_i8 (p1, p2) + integer (kind=8), intent (in) :: p1, p2 + integer (kind=8) :: _gfortran_specific__mod_i8 + + _gfortran_specific__mod_i8 = mod (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_mod_r10.F90 b/libgfortran/generated/_mod_r10.F90 new file mode 100644 index 000000000..104a92016 --- /dev/null +++ b/libgfortran/generated/_mod_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_10) + + + +elemental function _gfortran_specific__mod_r10 (p1, p2) + real (kind=10), intent (in) :: p1, p2 + real (kind=10) :: _gfortran_specific__mod_r10 + + _gfortran_specific__mod_r10 = mod (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_mod_r16.F90 b/libgfortran/generated/_mod_r16.F90 new file mode 100644 index 000000000..13570b1e6 --- /dev/null +++ b/libgfortran/generated/_mod_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_16) + + + +elemental function _gfortran_specific__mod_r16 (p1, p2) + real (kind=16), intent (in) :: p1, p2 + real (kind=16) :: _gfortran_specific__mod_r16 + + _gfortran_specific__mod_r16 = mod (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_mod_r4.F90 b/libgfortran/generated/_mod_r4.F90 new file mode 100644 index 000000000..a31b65a45 --- /dev/null +++ b/libgfortran/generated/_mod_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_4) + + + +elemental function _gfortran_specific__mod_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: _gfortran_specific__mod_r4 + + _gfortran_specific__mod_r4 = mod (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_mod_r8.F90 b/libgfortran/generated/_mod_r8.F90 new file mode 100644 index 000000000..931c14141 --- /dev/null +++ b/libgfortran/generated/_mod_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_8) + + + +elemental function _gfortran_specific__mod_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: _gfortran_specific__mod_r8 + + _gfortran_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 index 000000000..71e2c655d --- /dev/null +++ b/libgfortran/generated/_sign_i16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_16) + + + +elemental function _gfortran_specific__sign_i16 (p1, p2) + integer (kind=16), intent (in) :: p1, p2 + integer (kind=16) :: _gfortran_specific__sign_i16 + + _gfortran_specific__sign_i16 = sign (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_sign_i4.F90 b/libgfortran/generated/_sign_i4.F90 new file mode 100644 index 000000000..77a632cb4 --- /dev/null +++ b/libgfortran/generated/_sign_i4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_4) + + + +elemental function _gfortran_specific__sign_i4 (p1, p2) + integer (kind=4), intent (in) :: p1, p2 + integer (kind=4) :: _gfortran_specific__sign_i4 + + _gfortran_specific__sign_i4 = sign (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_sign_i8.F90 b/libgfortran/generated/_sign_i8.F90 new file mode 100644 index 000000000..cfd3d40db --- /dev/null +++ b/libgfortran/generated/_sign_i8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_INTEGER_8) + + + +elemental function _gfortran_specific__sign_i8 (p1, p2) + integer (kind=8), intent (in) :: p1, p2 + integer (kind=8) :: _gfortran_specific__sign_i8 + + _gfortran_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 index 000000000..43a34fc8f --- /dev/null +++ b/libgfortran/generated/_sign_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_10) + + + +elemental function _gfortran_specific__sign_r10 (p1, p2) + real (kind=10), intent (in) :: p1, p2 + real (kind=10) :: _gfortran_specific__sign_r10 + + _gfortran_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 index 000000000..58ccbebd1 --- /dev/null +++ b/libgfortran/generated/_sign_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_16) + + + +elemental function _gfortran_specific__sign_r16 (p1, p2) + real (kind=16), intent (in) :: p1, p2 + real (kind=16) :: _gfortran_specific__sign_r16 + + _gfortran_specific__sign_r16 = sign (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_sign_r4.F90 b/libgfortran/generated/_sign_r4.F90 new file mode 100644 index 000000000..510b77a44 --- /dev/null +++ b/libgfortran/generated/_sign_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_4) + + + +elemental function _gfortran_specific__sign_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: _gfortran_specific__sign_r4 + + _gfortran_specific__sign_r4 = sign (p1, p2) +end function + + + +#endif diff --git a/libgfortran/generated/_sign_r8.F90 b/libgfortran/generated/_sign_r8.F90 new file mode 100644 index 000000000..107ee1f88 --- /dev/null +++ b/libgfortran/generated/_sign_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + + + +#include "config.h" +#include "kinds.inc" +#include "c99_protos.inc" + +#if defined (HAVE_GFC_REAL_8) + + + +elemental function _gfortran_specific__sign_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: _gfortran_specific__sign_r8 + + _gfortran_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 index 000000000..9870123c4 --- /dev/null +++ b/libgfortran/generated/_sin_c10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sin_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: _gfortran_specific__sin_c10 + + _gfortran_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 index 000000000..cc335be68 --- /dev/null +++ b/libgfortran/generated/_sin_c16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sin_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: _gfortran_specific__sin_c16 + + _gfortran_specific__sin_c16 = sin (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_sin_c4.F90 b/libgfortran/generated/_sin_c4.F90 new file mode 100644 index 000000000..35f02708e --- /dev/null +++ b/libgfortran/generated/_sin_c4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sin_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: _gfortran_specific__sin_c4 + + _gfortran_specific__sin_c4 = sin (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_sin_c8.F90 b/libgfortran/generated/_sin_c8.F90 new file mode 100644 index 000000000..31eb0950c --- /dev/null +++ b/libgfortran/generated/_sin_c8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sin_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: _gfortran_specific__sin_c8 + + _gfortran_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 index 000000000..3cda76226 --- /dev/null +++ b/libgfortran/generated/_sin_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sin_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__sin_r10 + + _gfortran_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 index 000000000..08ff41ed0 --- /dev/null +++ b/libgfortran/generated/_sin_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sin_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__sin_r16 + + _gfortran_specific__sin_r16 = sin (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_sin_r4.F90 b/libgfortran/generated/_sin_r4.F90 new file mode 100644 index 000000000..dd9d02c26 --- /dev/null +++ b/libgfortran/generated/_sin_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sin_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__sin_r4 + + _gfortran_specific__sin_r4 = sin (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_sin_r8.F90 b/libgfortran/generated/_sin_r8.F90 new file mode 100644 index 000000000..acdc22573 --- /dev/null +++ b/libgfortran/generated/_sin_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sin_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__sin_r8 + + _gfortran_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 index 000000000..344cda2c1 --- /dev/null +++ b/libgfortran/generated/_sinh_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sinh_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__sinh_r10 + + _gfortran_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 index 000000000..34b0b5534 --- /dev/null +++ b/libgfortran/generated/_sinh_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sinh_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__sinh_r16 + + _gfortran_specific__sinh_r16 = sinh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_sinh_r4.F90 b/libgfortran/generated/_sinh_r4.F90 new file mode 100644 index 000000000..6962c7838 --- /dev/null +++ b/libgfortran/generated/_sinh_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sinh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__sinh_r4 + + _gfortran_specific__sinh_r4 = sinh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_sinh_r8.F90 b/libgfortran/generated/_sinh_r8.F90 new file mode 100644 index 000000000..2a8157570 --- /dev/null +++ b/libgfortran/generated/_sinh_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sinh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__sinh_r8 + + _gfortran_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 index 000000000..9fe264f40 --- /dev/null +++ b/libgfortran/generated/_sqrt_c10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sqrt_c10 (parm) + complex (kind=10), intent (in) :: parm + complex (kind=10) :: _gfortran_specific__sqrt_c10 + + _gfortran_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 index 000000000..399182149 --- /dev/null +++ b/libgfortran/generated/_sqrt_c16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sqrt_c16 (parm) + complex (kind=16), intent (in) :: parm + complex (kind=16) :: _gfortran_specific__sqrt_c16 + + _gfortran_specific__sqrt_c16 = sqrt (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_sqrt_c4.F90 b/libgfortran/generated/_sqrt_c4.F90 new file mode 100644 index 000000000..0a3ae7c36 --- /dev/null +++ b/libgfortran/generated/_sqrt_c4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sqrt_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: _gfortran_specific__sqrt_c4 + + _gfortran_specific__sqrt_c4 = sqrt (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_sqrt_c8.F90 b/libgfortran/generated/_sqrt_c8.F90 new file mode 100644 index 000000000..78b22194b --- /dev/null +++ b/libgfortran/generated/_sqrt_c8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sqrt_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: _gfortran_specific__sqrt_c8 + + _gfortran_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 index 000000000..37a23f600 --- /dev/null +++ b/libgfortran/generated/_sqrt_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sqrt_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__sqrt_r10 + + _gfortran_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 index 000000000..3669ae4d2 --- /dev/null +++ b/libgfortran/generated/_sqrt_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sqrt_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__sqrt_r16 + + _gfortran_specific__sqrt_r16 = sqrt (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_sqrt_r4.F90 b/libgfortran/generated/_sqrt_r4.F90 new file mode 100644 index 000000000..409383605 --- /dev/null +++ b/libgfortran/generated/_sqrt_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sqrt_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__sqrt_r4 + + _gfortran_specific__sqrt_r4 = sqrt (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_sqrt_r8.F90 b/libgfortran/generated/_sqrt_r8.F90 new file mode 100644 index 000000000..a772e10a4 --- /dev/null +++ b/libgfortran/generated/_sqrt_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__sqrt_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__sqrt_r8 + + _gfortran_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 index 000000000..c087bc60b --- /dev/null +++ b/libgfortran/generated/_tan_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__tan_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__tan_r10 + + _gfortran_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 index 000000000..d12c1a391 --- /dev/null +++ b/libgfortran/generated/_tan_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__tan_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__tan_r16 + + _gfortran_specific__tan_r16 = tan (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_tan_r4.F90 b/libgfortran/generated/_tan_r4.F90 new file mode 100644 index 000000000..4d90a556b --- /dev/null +++ b/libgfortran/generated/_tan_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__tan_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__tan_r4 + + _gfortran_specific__tan_r4 = tan (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_tan_r8.F90 b/libgfortran/generated/_tan_r8.F90 new file mode 100644 index 000000000..4ddf82db5 --- /dev/null +++ b/libgfortran/generated/_tan_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__tan_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__tan_r8 + + _gfortran_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 index 000000000..ee396b74f --- /dev/null +++ b/libgfortran/generated/_tanh_r10.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__tanh_r10 (parm) + real (kind=10), intent (in) :: parm + real (kind=10) :: _gfortran_specific__tanh_r10 + + _gfortran_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 index 000000000..41aead446 --- /dev/null +++ b/libgfortran/generated/_tanh_r16.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__tanh_r16 (parm) + real (kind=16), intent (in) :: parm + real (kind=16) :: _gfortran_specific__tanh_r16 + + _gfortran_specific__tanh_r16 = tanh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_tanh_r4.F90 b/libgfortran/generated/_tanh_r4.F90 new file mode 100644 index 000000000..5113b8581 --- /dev/null +++ b/libgfortran/generated/_tanh_r4.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__tanh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: _gfortran_specific__tanh_r4 + + _gfortran_specific__tanh_r4 = tanh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/_tanh_r8.F90 b/libgfortran/generated/_tanh_r8.F90 new file mode 100644 index 000000000..7b772d328 --- /dev/null +++ b/libgfortran/generated/_tanh_r8.F90 @@ -0,0 +1,46 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!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 _gfortran_specific__tanh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: _gfortran_specific__tanh_r8 + + _gfortran_specific__tanh_r8 = tanh (parm) +end function + +#endif +#endif diff --git a/libgfortran/generated/all_l1.c b/libgfortran/generated/all_l1.c new file mode 100644 index 000000000..edf981848 --- /dev/null +++ b/libgfortran/generated/all_l1.c @@ -0,0 +1,221 @@ +/* Implementation of the ALL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_1) + + +extern void all_l1 (gfc_array_l1 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(all_l1); + +void +all_l1 (gfc_array_l1 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " ALL intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ALL intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in ALL intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_LOGICAL_1 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/all_l16.c b/libgfortran/generated/all_l16.c new file mode 100644 index 000000000..d5cde25a9 --- /dev/null +++ b/libgfortran/generated/all_l16.c @@ -0,0 +1,221 @@ +/* Implementation of the ALL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_16) + + +extern void all_l16 (gfc_array_l16 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(all_l16); + +void +all_l16 (gfc_array_l16 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " ALL intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ALL intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in ALL intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/all_l2.c b/libgfortran/generated/all_l2.c new file mode 100644 index 000000000..1128adabf --- /dev/null +++ b/libgfortran/generated/all_l2.c @@ -0,0 +1,221 @@ +/* Implementation of the ALL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_2) + + +extern void all_l2 (gfc_array_l2 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(all_l2); + +void +all_l2 (gfc_array_l2 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " ALL intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ALL intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in ALL intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_LOGICAL_2 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/all_l4.c b/libgfortran/generated/all_l4.c new file mode 100644 index 000000000..97ad5a4f6 --- /dev/null +++ b/libgfortran/generated/all_l4.c @@ -0,0 +1,221 @@ +/* Implementation of the ALL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_4) + + +extern void all_l4 (gfc_array_l4 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(all_l4); + +void +all_l4 (gfc_array_l4 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " ALL intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ALL intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in ALL intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_LOGICAL_4 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/all_l8.c b/libgfortran/generated/all_l8.c new file mode 100644 index 000000000..8846d34e5 --- /dev/null +++ b/libgfortran/generated/all_l8.c @@ -0,0 +1,221 @@ +/* Implementation of the ALL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_8) + + +extern void all_l8 (gfc_array_l8 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(all_l8); + +void +all_l8 (gfc_array_l8 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " ALL intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ALL intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in ALL intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_LOGICAL_8 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/any_l1.c b/libgfortran/generated/any_l1.c new file mode 100644 index 000000000..8f52b51fd --- /dev/null +++ b/libgfortran/generated/any_l1.c @@ -0,0 +1,221 @@ +/* Implementation of the ANY intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_1) + + +extern void any_l1 (gfc_array_l1 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(any_l1); + +void +any_l1 (gfc_array_l1 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " ANY intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ANY intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in ANY intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_LOGICAL_1 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/any_l16.c b/libgfortran/generated/any_l16.c new file mode 100644 index 000000000..7f3f69e11 --- /dev/null +++ b/libgfortran/generated/any_l16.c @@ -0,0 +1,221 @@ +/* Implementation of the ANY intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_16) + + +extern void any_l16 (gfc_array_l16 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(any_l16); + +void +any_l16 (gfc_array_l16 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " ANY intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ANY intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in ANY intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/any_l2.c b/libgfortran/generated/any_l2.c new file mode 100644 index 000000000..d2c4dbedb --- /dev/null +++ b/libgfortran/generated/any_l2.c @@ -0,0 +1,221 @@ +/* Implementation of the ANY intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_2) + + +extern void any_l2 (gfc_array_l2 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(any_l2); + +void +any_l2 (gfc_array_l2 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " ANY intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ANY intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in ANY intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_LOGICAL_2 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/any_l4.c b/libgfortran/generated/any_l4.c new file mode 100644 index 000000000..f9d563743 --- /dev/null +++ b/libgfortran/generated/any_l4.c @@ -0,0 +1,221 @@ +/* Implementation of the ANY intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_4) + + +extern void any_l4 (gfc_array_l4 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(any_l4); + +void +any_l4 (gfc_array_l4 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " ANY intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ANY intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in ANY intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_LOGICAL_4 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/any_l8.c b/libgfortran/generated/any_l8.c new file mode 100644 index 000000000..f595826cc --- /dev/null +++ b/libgfortran/generated/any_l8.c @@ -0,0 +1,221 @@ +/* Implementation of the ANY intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_8) + + +extern void any_l8 (gfc_array_l8 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(any_l8); + +void +any_l8 (gfc_array_l8 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " ANY intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ANY intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in ANY intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_LOGICAL_8 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/bessel_r10.c b/libgfortran/generated/bessel_r10.c new file mode 100644 index 000000000..87599fea6 --- /dev/null +++ b/libgfortran/generated/bessel_r10.c @@ -0,0 +1,187 @@ +/* Implementation of the BESSEL_JN and BESSEL_YN transformational + function using a recurrence algorithm. + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + + +#define MATHFUNC(funcname) funcname ## l +#define BUILTINMATHFUNC(funcname) MATHFUNC(funcname) + +#if defined (HAVE_GFC_REAL_10) + + + +#if defined (HAVE_JNL) +extern void bessel_jn_r10 (gfc_array_r10 * const restrict ret, int n1, + int n2, GFC_REAL_10 x); +export_proto(bessel_jn_r10); + +void +bessel_jn_r10 (gfc_array_r10 * const restrict ret, int n1, int n2, GFC_REAL_10 x) +{ + int i; + index_type stride; + + GFC_REAL_10 last1, last2, x2rev; + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (ret->data == NULL) + { + size_t size = n2 < n1 ? 0 : n2-n1+1; + GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + ret->data = internal_malloc_size (sizeof (GFC_REAL_10) * size); + ret->offset = 0; + } + + if (unlikely (n2 < n1)) + return; + + if (unlikely (compile_options.bounds_check) + && GFC_DESCRIPTOR_EXTENT(ret,0) != (n2-n1+1)) + runtime_error("Incorrect extent in return value of BESSEL_JN " + "(%ld vs. %ld)", (long int) n2-n1, + (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (unlikely (x == 0)) + { + ret->data[0] = 1; + for (i = 1; i <= n2-n1; i++) + ret->data[i*stride] = 0; + return; + } + + ret->data = ret->data; + last1 = MATHFUNC(jn) (n2, x); + ret->data[(n2-n1)*stride] = last1; + + if (n1 == n2) + return; + + last2 = MATHFUNC(jn) (n2 - 1, x); + ret->data[(n2-n1-1)*stride] = last2; + + if (n1 + 1 == n2) + return; + + x2rev = GFC_REAL_10_LITERAL(2.)/x; + + for (i = n2-n1-2; i >= 0; i--) + { + ret->data[i*stride] = x2rev * (i+1+n1) * last2 - last1; + last1 = last2; + last2 = ret->data[i*stride]; + } +} + +#endif + +#if defined (HAVE_YNL) +extern void bessel_yn_r10 (gfc_array_r10 * const restrict ret, + int n1, int n2, GFC_REAL_10 x); +export_proto(bessel_yn_r10); + +void +bessel_yn_r10 (gfc_array_r10 * const restrict ret, int n1, int n2, + GFC_REAL_10 x) +{ + int i; + index_type stride; + + GFC_REAL_10 last1, last2, x2rev; + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (ret->data == NULL) + { + size_t size = n2 < n1 ? 0 : n2-n1+1; + GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + ret->data = internal_malloc_size (sizeof (GFC_REAL_10) * size); + ret->offset = 0; + } + + if (unlikely (n2 < n1)) + return; + + if (unlikely (compile_options.bounds_check) + && GFC_DESCRIPTOR_EXTENT(ret,0) != (n2-n1+1)) + runtime_error("Incorrect extent in return value of BESSEL_JN " + "(%ld vs. %ld)", (long int) n2-n1, + (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (unlikely (x == 0)) + { + for (i = 0; i <= n2-n1; i++) +#if defined(GFC_REAL_10_INFINITY) + ret->data[i*stride] = -GFC_REAL_10_INFINITY; +#else + ret->data[i*stride] = -GFC_REAL_10_HUGE; +#endif + return; + } + + ret->data = ret->data; + last1 = MATHFUNC(yn) (n1, x); + ret->data[0] = last1; + + if (n1 == n2) + return; + + last2 = MATHFUNC(yn) (n1 + 1, x); + ret->data[1*stride] = last2; + + if (n1 + 1 == n2) + return; + + x2rev = GFC_REAL_10_LITERAL(2.)/x; + + for (i = 2; i <= n1+n2; i++) + { +#if defined(GFC_REAL_10_INFINITY) + if (unlikely (last2 == -GFC_REAL_10_INFINITY)) + { + ret->data[i*stride] = -GFC_REAL_10_INFINITY; + } + else +#endif + { + ret->data[i*stride] = x2rev * (i-1+n1) * last2 - last1; + last1 = last2; + last2 = ret->data[i*stride]; + } + } +} +#endif + +#endif + diff --git a/libgfortran/generated/bessel_r16.c b/libgfortran/generated/bessel_r16.c new file mode 100644 index 000000000..7097f6b04 --- /dev/null +++ b/libgfortran/generated/bessel_r16.c @@ -0,0 +1,195 @@ +/* Implementation of the BESSEL_JN and BESSEL_YN transformational + function using a recurrence algorithm. + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define MATHFUNC(funcname) funcname ## q +#else +#define MATHFUNC(funcname) funcname ## l +#endif +#if defined(GFC_REAL_16_IS_FLOAT128) +#define BUILTINMATHFUNC(funcname) funcname ## q +#else +#define BUILTINMATHFUNC(funcname) funcname ## l +#endif + +#if defined (HAVE_GFC_REAL_16) + + + +#if (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_JNL)) +extern void bessel_jn_r16 (gfc_array_r16 * const restrict ret, int n1, + int n2, GFC_REAL_16 x); +export_proto(bessel_jn_r16); + +void +bessel_jn_r16 (gfc_array_r16 * const restrict ret, int n1, int n2, GFC_REAL_16 x) +{ + int i; + index_type stride; + + GFC_REAL_16 last1, last2, x2rev; + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (ret->data == NULL) + { + size_t size = n2 < n1 ? 0 : n2-n1+1; + GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + ret->data = internal_malloc_size (sizeof (GFC_REAL_16) * size); + ret->offset = 0; + } + + if (unlikely (n2 < n1)) + return; + + if (unlikely (compile_options.bounds_check) + && GFC_DESCRIPTOR_EXTENT(ret,0) != (n2-n1+1)) + runtime_error("Incorrect extent in return value of BESSEL_JN " + "(%ld vs. %ld)", (long int) n2-n1, + (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (unlikely (x == 0)) + { + ret->data[0] = 1; + for (i = 1; i <= n2-n1; i++) + ret->data[i*stride] = 0; + return; + } + + ret->data = ret->data; + last1 = MATHFUNC(jn) (n2, x); + ret->data[(n2-n1)*stride] = last1; + + if (n1 == n2) + return; + + last2 = MATHFUNC(jn) (n2 - 1, x); + ret->data[(n2-n1-1)*stride] = last2; + + if (n1 + 1 == n2) + return; + + x2rev = GFC_REAL_16_LITERAL(2.)/x; + + for (i = n2-n1-2; i >= 0; i--) + { + ret->data[i*stride] = x2rev * (i+1+n1) * last2 - last1; + last1 = last2; + last2 = ret->data[i*stride]; + } +} + +#endif + +#if (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_YNL)) +extern void bessel_yn_r16 (gfc_array_r16 * const restrict ret, + int n1, int n2, GFC_REAL_16 x); +export_proto(bessel_yn_r16); + +void +bessel_yn_r16 (gfc_array_r16 * const restrict ret, int n1, int n2, + GFC_REAL_16 x) +{ + int i; + index_type stride; + + GFC_REAL_16 last1, last2, x2rev; + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (ret->data == NULL) + { + size_t size = n2 < n1 ? 0 : n2-n1+1; + GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + ret->data = internal_malloc_size (sizeof (GFC_REAL_16) * size); + ret->offset = 0; + } + + if (unlikely (n2 < n1)) + return; + + if (unlikely (compile_options.bounds_check) + && GFC_DESCRIPTOR_EXTENT(ret,0) != (n2-n1+1)) + runtime_error("Incorrect extent in return value of BESSEL_JN " + "(%ld vs. %ld)", (long int) n2-n1, + (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (unlikely (x == 0)) + { + for (i = 0; i <= n2-n1; i++) +#if defined(GFC_REAL_16_INFINITY) + ret->data[i*stride] = -GFC_REAL_16_INFINITY; +#else + ret->data[i*stride] = -GFC_REAL_16_HUGE; +#endif + return; + } + + ret->data = ret->data; + last1 = MATHFUNC(yn) (n1, x); + ret->data[0] = last1; + + if (n1 == n2) + return; + + last2 = MATHFUNC(yn) (n1 + 1, x); + ret->data[1*stride] = last2; + + if (n1 + 1 == n2) + return; + + x2rev = GFC_REAL_16_LITERAL(2.)/x; + + for (i = 2; i <= n1+n2; i++) + { +#if defined(GFC_REAL_16_INFINITY) + if (unlikely (last2 == -GFC_REAL_16_INFINITY)) + { + ret->data[i*stride] = -GFC_REAL_16_INFINITY; + } + else +#endif + { + ret->data[i*stride] = x2rev * (i-1+n1) * last2 - last1; + last1 = last2; + last2 = ret->data[i*stride]; + } + } +} +#endif + +#endif + diff --git a/libgfortran/generated/bessel_r4.c b/libgfortran/generated/bessel_r4.c new file mode 100644 index 000000000..75d2ff0a8 --- /dev/null +++ b/libgfortran/generated/bessel_r4.c @@ -0,0 +1,187 @@ +/* Implementation of the BESSEL_JN and BESSEL_YN transformational + function using a recurrence algorithm. + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + + +#define MATHFUNC(funcname) funcname ## f +#define BUILTINMATHFUNC(funcname) MATHFUNC(funcname) + +#if defined (HAVE_GFC_REAL_4) + + + +#if defined (HAVE_JNF) +extern void bessel_jn_r4 (gfc_array_r4 * const restrict ret, int n1, + int n2, GFC_REAL_4 x); +export_proto(bessel_jn_r4); + +void +bessel_jn_r4 (gfc_array_r4 * const restrict ret, int n1, int n2, GFC_REAL_4 x) +{ + int i; + index_type stride; + + GFC_REAL_4 last1, last2, x2rev; + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (ret->data == NULL) + { + size_t size = n2 < n1 ? 0 : n2-n1+1; + GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + ret->data = internal_malloc_size (sizeof (GFC_REAL_4) * size); + ret->offset = 0; + } + + if (unlikely (n2 < n1)) + return; + + if (unlikely (compile_options.bounds_check) + && GFC_DESCRIPTOR_EXTENT(ret,0) != (n2-n1+1)) + runtime_error("Incorrect extent in return value of BESSEL_JN " + "(%ld vs. %ld)", (long int) n2-n1, + (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (unlikely (x == 0)) + { + ret->data[0] = 1; + for (i = 1; i <= n2-n1; i++) + ret->data[i*stride] = 0; + return; + } + + ret->data = ret->data; + last1 = MATHFUNC(jn) (n2, x); + ret->data[(n2-n1)*stride] = last1; + + if (n1 == n2) + return; + + last2 = MATHFUNC(jn) (n2 - 1, x); + ret->data[(n2-n1-1)*stride] = last2; + + if (n1 + 1 == n2) + return; + + x2rev = GFC_REAL_4_LITERAL(2.)/x; + + for (i = n2-n1-2; i >= 0; i--) + { + ret->data[i*stride] = x2rev * (i+1+n1) * last2 - last1; + last1 = last2; + last2 = ret->data[i*stride]; + } +} + +#endif + +#if defined (HAVE_YNF) +extern void bessel_yn_r4 (gfc_array_r4 * const restrict ret, + int n1, int n2, GFC_REAL_4 x); +export_proto(bessel_yn_r4); + +void +bessel_yn_r4 (gfc_array_r4 * const restrict ret, int n1, int n2, + GFC_REAL_4 x) +{ + int i; + index_type stride; + + GFC_REAL_4 last1, last2, x2rev; + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (ret->data == NULL) + { + size_t size = n2 < n1 ? 0 : n2-n1+1; + GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + ret->data = internal_malloc_size (sizeof (GFC_REAL_4) * size); + ret->offset = 0; + } + + if (unlikely (n2 < n1)) + return; + + if (unlikely (compile_options.bounds_check) + && GFC_DESCRIPTOR_EXTENT(ret,0) != (n2-n1+1)) + runtime_error("Incorrect extent in return value of BESSEL_JN " + "(%ld vs. %ld)", (long int) n2-n1, + (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (unlikely (x == 0)) + { + for (i = 0; i <= n2-n1; i++) +#if defined(GFC_REAL_4_INFINITY) + ret->data[i*stride] = -GFC_REAL_4_INFINITY; +#else + ret->data[i*stride] = -GFC_REAL_4_HUGE; +#endif + return; + } + + ret->data = ret->data; + last1 = MATHFUNC(yn) (n1, x); + ret->data[0] = last1; + + if (n1 == n2) + return; + + last2 = MATHFUNC(yn) (n1 + 1, x); + ret->data[1*stride] = last2; + + if (n1 + 1 == n2) + return; + + x2rev = GFC_REAL_4_LITERAL(2.)/x; + + for (i = 2; i <= n1+n2; i++) + { +#if defined(GFC_REAL_4_INFINITY) + if (unlikely (last2 == -GFC_REAL_4_INFINITY)) + { + ret->data[i*stride] = -GFC_REAL_4_INFINITY; + } + else +#endif + { + ret->data[i*stride] = x2rev * (i-1+n1) * last2 - last1; + last1 = last2; + last2 = ret->data[i*stride]; + } + } +} +#endif + +#endif + diff --git a/libgfortran/generated/bessel_r8.c b/libgfortran/generated/bessel_r8.c new file mode 100644 index 000000000..899237b1e --- /dev/null +++ b/libgfortran/generated/bessel_r8.c @@ -0,0 +1,187 @@ +/* Implementation of the BESSEL_JN and BESSEL_YN transformational + function using a recurrence algorithm. + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + + +#define MATHFUNC(funcname) funcname +#define BUILTINMATHFUNC(funcname) MATHFUNC(funcname) + +#if defined (HAVE_GFC_REAL_8) + + + +#if defined (HAVE_JN) +extern void bessel_jn_r8 (gfc_array_r8 * const restrict ret, int n1, + int n2, GFC_REAL_8 x); +export_proto(bessel_jn_r8); + +void +bessel_jn_r8 (gfc_array_r8 * const restrict ret, int n1, int n2, GFC_REAL_8 x) +{ + int i; + index_type stride; + + GFC_REAL_8 last1, last2, x2rev; + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (ret->data == NULL) + { + size_t size = n2 < n1 ? 0 : n2-n1+1; + GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + ret->data = internal_malloc_size (sizeof (GFC_REAL_8) * size); + ret->offset = 0; + } + + if (unlikely (n2 < n1)) + return; + + if (unlikely (compile_options.bounds_check) + && GFC_DESCRIPTOR_EXTENT(ret,0) != (n2-n1+1)) + runtime_error("Incorrect extent in return value of BESSEL_JN " + "(%ld vs. %ld)", (long int) n2-n1, + (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (unlikely (x == 0)) + { + ret->data[0] = 1; + for (i = 1; i <= n2-n1; i++) + ret->data[i*stride] = 0; + return; + } + + ret->data = ret->data; + last1 = MATHFUNC(jn) (n2, x); + ret->data[(n2-n1)*stride] = last1; + + if (n1 == n2) + return; + + last2 = MATHFUNC(jn) (n2 - 1, x); + ret->data[(n2-n1-1)*stride] = last2; + + if (n1 + 1 == n2) + return; + + x2rev = GFC_REAL_8_LITERAL(2.)/x; + + for (i = n2-n1-2; i >= 0; i--) + { + ret->data[i*stride] = x2rev * (i+1+n1) * last2 - last1; + last1 = last2; + last2 = ret->data[i*stride]; + } +} + +#endif + +#if defined (HAVE_YN) +extern void bessel_yn_r8 (gfc_array_r8 * const restrict ret, + int n1, int n2, GFC_REAL_8 x); +export_proto(bessel_yn_r8); + +void +bessel_yn_r8 (gfc_array_r8 * const restrict ret, int n1, int n2, + GFC_REAL_8 x) +{ + int i; + index_type stride; + + GFC_REAL_8 last1, last2, x2rev; + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (ret->data == NULL) + { + size_t size = n2 < n1 ? 0 : n2-n1+1; + GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + ret->data = internal_malloc_size (sizeof (GFC_REAL_8) * size); + ret->offset = 0; + } + + if (unlikely (n2 < n1)) + return; + + if (unlikely (compile_options.bounds_check) + && GFC_DESCRIPTOR_EXTENT(ret,0) != (n2-n1+1)) + runtime_error("Incorrect extent in return value of BESSEL_JN " + "(%ld vs. %ld)", (long int) n2-n1, + (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (unlikely (x == 0)) + { + for (i = 0; i <= n2-n1; i++) +#if defined(GFC_REAL_8_INFINITY) + ret->data[i*stride] = -GFC_REAL_8_INFINITY; +#else + ret->data[i*stride] = -GFC_REAL_8_HUGE; +#endif + return; + } + + ret->data = ret->data; + last1 = MATHFUNC(yn) (n1, x); + ret->data[0] = last1; + + if (n1 == n2) + return; + + last2 = MATHFUNC(yn) (n1 + 1, x); + ret->data[1*stride] = last2; + + if (n1 + 1 == n2) + return; + + x2rev = GFC_REAL_8_LITERAL(2.)/x; + + for (i = 2; i <= n1+n2; i++) + { +#if defined(GFC_REAL_8_INFINITY) + if (unlikely (last2 == -GFC_REAL_8_INFINITY)) + { + ret->data[i*stride] = -GFC_REAL_8_INFINITY; + } + else +#endif + { + ret->data[i*stride] = x2rev * (i-1+n1) * last2 - last1; + last1 = last2; + last2 = ret->data[i*stride]; + } + } +} +#endif + +#endif + diff --git a/libgfortran/generated/count_16_l.c b/libgfortran/generated/count_16_l.c new file mode 100644 index 000000000..e894e561d --- /dev/null +++ b/libgfortran/generated/count_16_l.c @@ -0,0 +1,217 @@ +/* Implementation of the COUNT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + + +extern void count_16_l (gfc_array_i16 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(count_16_l); + +void +count_16_l (gfc_array_i16 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in COUNT intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/count_1_l.c b/libgfortran/generated/count_1_l.c new file mode 100644 index 000000000..894ad0c29 --- /dev/null +++ b/libgfortran/generated/count_1_l.c @@ -0,0 +1,217 @@ +/* Implementation of the COUNT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) + + +extern void count_1_l (gfc_array_i1 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(count_1_l); + +void +count_1_l (gfc_array_i1 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in COUNT intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_INTEGER_1 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/count_2_l.c b/libgfortran/generated/count_2_l.c new file mode 100644 index 000000000..d0e5ee497 --- /dev/null +++ b/libgfortran/generated/count_2_l.c @@ -0,0 +1,217 @@ +/* Implementation of the COUNT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) + + +extern void count_2_l (gfc_array_i2 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(count_2_l); + +void +count_2_l (gfc_array_i2 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in COUNT intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_INTEGER_2 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/count_4_l.c b/libgfortran/generated/count_4_l.c new file mode 100644 index 000000000..43af56b78 --- /dev/null +++ b/libgfortran/generated/count_4_l.c @@ -0,0 +1,217 @@ +/* Implementation of the COUNT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + + +extern void count_4_l (gfc_array_i4 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(count_4_l); + +void +count_4_l (gfc_array_i4 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in COUNT intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/count_8_l.c b/libgfortran/generated/count_8_l.c new file mode 100644 index 000000000..6ddd701f9 --- /dev/null +++ b/libgfortran/generated/count_8_l.c @@ -0,0 +1,217 @@ +/* Implementation of the COUNT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + + +extern void count_8_l (gfc_array_i8 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(count_8_l); + +void +count_8_l (gfc_array_i8 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in COUNT intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/cshift0_c10.c b/libgfortran/generated/cshift0_c10.c new file mode 100644 index 000000000..16c113deb --- /dev/null +++ b/libgfortran/generated/cshift0_c10.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_10) + +void +cshift0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_COMPLEX_10 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_COMPLEX_10 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_COMPLEX_10); + size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_10); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_COMPLEX_10 *dest = rptr; + const GFC_COMPLEX_10 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_c16.c b/libgfortran/generated/cshift0_c16.c new file mode 100644 index 000000000..df83ccb85 --- /dev/null +++ b/libgfortran/generated/cshift0_c16.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_16) + +void +cshift0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_COMPLEX_16 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_COMPLEX_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_COMPLEX_16); + size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_16); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_COMPLEX_16 *dest = rptr; + const GFC_COMPLEX_16 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_c4.c b/libgfortran/generated/cshift0_c4.c new file mode 100644 index 000000000..52d277f1c --- /dev/null +++ b/libgfortran/generated/cshift0_c4.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_4) + +void +cshift0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_COMPLEX_4 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_COMPLEX_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_COMPLEX_4); + size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_4); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_COMPLEX_4 *dest = rptr; + const GFC_COMPLEX_4 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_c8.c b/libgfortran/generated/cshift0_c8.c new file mode 100644 index 000000000..9b9c3b2ac --- /dev/null +++ b/libgfortran/generated/cshift0_c8.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_8) + +void +cshift0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_COMPLEX_8 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_COMPLEX_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_COMPLEX_8); + size_t len2 = (len - shift) * sizeof (GFC_COMPLEX_8); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_COMPLEX_8 *dest = rptr; + const GFC_COMPLEX_8 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_i1.c b/libgfortran/generated/cshift0_i1.c new file mode 100644 index 000000000..7ed44bddb --- /dev/null +++ b/libgfortran/generated/cshift0_i1.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) + +void +cshift0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_INTEGER_1 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_INTEGER_1 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_INTEGER_1); + size_t len2 = (len - shift) * sizeof (GFC_INTEGER_1); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_INTEGER_1 *dest = rptr; + const GFC_INTEGER_1 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_i16.c b/libgfortran/generated/cshift0_i16.c new file mode 100644 index 000000000..145724b6e --- /dev/null +++ b/libgfortran/generated/cshift0_i16.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +void +cshift0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_INTEGER_16 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_INTEGER_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_INTEGER_16); + size_t len2 = (len - shift) * sizeof (GFC_INTEGER_16); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_INTEGER_16 *dest = rptr; + const GFC_INTEGER_16 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_i2.c b/libgfortran/generated/cshift0_i2.c new file mode 100644 index 000000000..df3328175 --- /dev/null +++ b/libgfortran/generated/cshift0_i2.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) + +void +cshift0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_INTEGER_2 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_INTEGER_2 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_INTEGER_2); + size_t len2 = (len - shift) * sizeof (GFC_INTEGER_2); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_INTEGER_2 *dest = rptr; + const GFC_INTEGER_2 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_i4.c b/libgfortran/generated/cshift0_i4.c new file mode 100644 index 000000000..a1e118589 --- /dev/null +++ b/libgfortran/generated/cshift0_i4.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +void +cshift0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_INTEGER_4 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_INTEGER_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_INTEGER_4); + size_t len2 = (len - shift) * sizeof (GFC_INTEGER_4); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_INTEGER_4 *dest = rptr; + const GFC_INTEGER_4 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_i8.c b/libgfortran/generated/cshift0_i8.c new file mode 100644 index 000000000..cbe13f153 --- /dev/null +++ b/libgfortran/generated/cshift0_i8.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +void +cshift0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_INTEGER_8 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_INTEGER_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_INTEGER_8); + size_t len2 = (len - shift) * sizeof (GFC_INTEGER_8); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_INTEGER_8 *dest = rptr; + const GFC_INTEGER_8 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_r10.c b/libgfortran/generated/cshift0_r10.c new file mode 100644 index 000000000..8ba544d2d --- /dev/null +++ b/libgfortran/generated/cshift0_r10.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) + +void +cshift0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_REAL_10 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_REAL_10 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_REAL_10); + size_t len2 = (len - shift) * sizeof (GFC_REAL_10); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_REAL_10 *dest = rptr; + const GFC_REAL_10 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_r16.c b/libgfortran/generated/cshift0_r16.c new file mode 100644 index 000000000..0725048c2 --- /dev/null +++ b/libgfortran/generated/cshift0_r16.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) + +void +cshift0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_REAL_16 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_REAL_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_REAL_16); + size_t len2 = (len - shift) * sizeof (GFC_REAL_16); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_REAL_16 *dest = rptr; + const GFC_REAL_16 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_r4.c b/libgfortran/generated/cshift0_r4.c new file mode 100644 index 000000000..515c36b41 --- /dev/null +++ b/libgfortran/generated/cshift0_r4.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) + +void +cshift0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_REAL_4 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_REAL_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_REAL_4); + size_t len2 = (len - shift) * sizeof (GFC_REAL_4); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_REAL_4 *dest = rptr; + const GFC_REAL_4 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift0_r8.c b/libgfortran/generated/cshift0_r8.c new file mode 100644 index 000000000..5a721e495 --- /dev/null +++ b/libgfortran/generated/cshift0_r8.c @@ -0,0 +1,171 @@ +/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) + +void +cshift0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + GFC_REAL_8 *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const GFC_REAL_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof (GFC_REAL_8); + size_t len2 = (len - shift) * sizeof (GFC_REAL_8); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + GFC_REAL_8 *dest = rptr; + const GFC_REAL_8 *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif diff --git a/libgfortran/generated/cshift1_16.c b/libgfortran/generated/cshift1_16.c new file mode 100644 index 000000000..b2cb7f17c --- /dev/null +++ b/libgfortran/generated/cshift1_16.c @@ -0,0 +1,273 @@ +/* Implementation of the CSHIFT intrinsic + Copyright 2003, 2007, 2009 Free Software Foundation, Inc. + Contributed by Feng Wang + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +static void +cshift1 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const GFC_INTEGER_16 * const restrict pwhich) +{ + /* 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; + index_type arraysize; + index_type size; + + 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'"); + + size = GFC_DESCRIPTOR_SIZE(array); + + arraysize = size0 ((array_t *)array); + + if (ret->data == NULL) + { + int i; + + ret->data = internal_malloc_size (size * arraysize); + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * + GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "CSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "CSHIFT"); + } + + if (arraysize == 0) + return; + + 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 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + 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; + 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 probably 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 restrict, + const gfc_array_char * const restrict, + const gfc_array_i16 * const restrict, + const GFC_INTEGER_16 * const restrict); +export_proto(cshift1_16); + +void +cshift1_16 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const GFC_INTEGER_16 * const restrict pwhich) +{ + cshift1 (ret, array, h, pwhich); +} + + +void cshift1_16_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_16_char); + +void +cshift1_16_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused))) +{ + cshift1 (ret, array, h, pwhich); +} + + +void cshift1_16_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_16_char4); + +void +cshift1_16_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused))) +{ + cshift1 (ret, array, h, pwhich); +} + +#endif diff --git a/libgfortran/generated/cshift1_4.c b/libgfortran/generated/cshift1_4.c new file mode 100644 index 000000000..30f3d99dc --- /dev/null +++ b/libgfortran/generated/cshift1_4.c @@ -0,0 +1,273 @@ +/* Implementation of the CSHIFT intrinsic + Copyright 2003, 2007, 2009 Free Software Foundation, Inc. + Contributed by Feng Wang + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +static void +cshift1 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const GFC_INTEGER_4 * const restrict pwhich) +{ + /* 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_4 *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_4 sh; + index_type arraysize; + index_type size; + + 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'"); + + size = GFC_DESCRIPTOR_SIZE(array); + + arraysize = size0 ((array_t *)array); + + if (ret->data == NULL) + { + int i; + + ret->data = internal_malloc_size (size * arraysize); + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * + GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "CSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "CSHIFT"); + } + + if (arraysize == 0) + return; + + 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 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + 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; + 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 probably 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_4 (gfc_array_char * const restrict, + const gfc_array_char * const restrict, + const gfc_array_i4 * const restrict, + const GFC_INTEGER_4 * const restrict); +export_proto(cshift1_4); + +void +cshift1_4 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const GFC_INTEGER_4 * const restrict pwhich) +{ + cshift1 (ret, array, h, pwhich); +} + + +void cshift1_4_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_4_char); + +void +cshift1_4_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused))) +{ + cshift1 (ret, array, h, pwhich); +} + + +void cshift1_4_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_4_char4); + +void +cshift1_4_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused))) +{ + cshift1 (ret, array, h, pwhich); +} + +#endif diff --git a/libgfortran/generated/cshift1_8.c b/libgfortran/generated/cshift1_8.c new file mode 100644 index 000000000..c3bf473e4 --- /dev/null +++ b/libgfortran/generated/cshift1_8.c @@ -0,0 +1,273 @@ +/* Implementation of the CSHIFT intrinsic + Copyright 2003, 2007, 2009 Free Software Foundation, Inc. + Contributed by Feng Wang + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +static void +cshift1 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const GFC_INTEGER_8 * const restrict pwhich) +{ + /* 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_8 *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_8 sh; + index_type arraysize; + index_type size; + + 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'"); + + size = GFC_DESCRIPTOR_SIZE(array); + + arraysize = size0 ((array_t *)array); + + if (ret->data == NULL) + { + int i; + + ret->data = internal_malloc_size (size * arraysize); + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * + GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "CSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "CSHIFT"); + } + + if (arraysize == 0) + return; + + 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 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + 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; + 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 probably 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_8 (gfc_array_char * const restrict, + const gfc_array_char * const restrict, + const gfc_array_i8 * const restrict, + const GFC_INTEGER_8 * const restrict); +export_proto(cshift1_8); + +void +cshift1_8 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const GFC_INTEGER_8 * const restrict pwhich) +{ + cshift1 (ret, array, h, pwhich); +} + + +void cshift1_8_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_8_char); + +void +cshift1_8_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused))) +{ + cshift1 (ret, array, h, pwhich); +} + + +void cshift1_8_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_8_char4); + +void +cshift1_8_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused))) +{ + cshift1 (ret, array, h, pwhich); +} + +#endif diff --git a/libgfortran/generated/eoshift1_16.c b/libgfortran/generated/eoshift1_16.c new file mode 100644 index 000000000..48fa03b67 --- /dev/null +++ b/libgfortran/generated/eoshift1_16.c @@ -0,0 +1,318 @@ +/* Implementation of the EOSHIFT intrinsic + Copyright 2002, 2005, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +static void +eoshift1 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_16 * const restrict pwhich, + const char * filler, index_type filler_len) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char * restrict 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; + index_type size; + index_type arraysize; + 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; + + size = GFC_DESCRIPTOR_SIZE(array); + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + extent[0] = 1; + count[0] = 0; + + arraysize = size0 ((array_t *) array); + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + + } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + 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--) + { + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + + 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 probably 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 restrict, + const gfc_array_char * const restrict, + const gfc_array_i16 * const restrict, const char * const restrict, + const GFC_INTEGER_16 * const restrict); +export_proto(eoshift1_16); + +void +eoshift1_16 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_16 * const restrict pwhich) +{ + eoshift1 (ret, array, h, pbound, pwhich, "\0", 1); +} + + +void eoshift1_16_char (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i16 * const restrict, + const char * const restrict, + const GFC_INTEGER_16 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_16_char); + +void +eoshift1_16_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + eoshift1 (ret, array, h, pbound, pwhich, " ", 1); +} + + +void eoshift1_16_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i16 * const restrict, + const char * const restrict, + const GFC_INTEGER_16 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_16_char4); + +void +eoshift1_16_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift1 (ret, array, h, pbound, pwhich, + (const char *) &space, sizeof (gfc_char4_t)); +} + +#endif diff --git a/libgfortran/generated/eoshift1_4.c b/libgfortran/generated/eoshift1_4.c new file mode 100644 index 000000000..3b9f7309c --- /dev/null +++ b/libgfortran/generated/eoshift1_4.c @@ -0,0 +1,318 @@ +/* Implementation of the EOSHIFT intrinsic + Copyright 2002, 2005, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +static void +eoshift1 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_4 * const restrict pwhich, + const char * filler, index_type filler_len) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char * restrict 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_4 *hptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + index_type size; + index_type arraysize; + int which; + GFC_INTEGER_4 sh; + GFC_INTEGER_4 delta; + + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + + size = GFC_DESCRIPTOR_SIZE(array); + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + extent[0] = 1; + count[0] = 0; + + arraysize = size0 ((array_t *) array); + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + + } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + 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--) + { + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + + 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 probably 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_4 (gfc_array_char * const restrict, + const gfc_array_char * const restrict, + const gfc_array_i4 * const restrict, const char * const restrict, + const GFC_INTEGER_4 * const restrict); +export_proto(eoshift1_4); + +void +eoshift1_4 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_4 * const restrict pwhich) +{ + eoshift1 (ret, array, h, pbound, pwhich, "\0", 1); +} + + +void eoshift1_4_char (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i4 * const restrict, + const char * const restrict, + const GFC_INTEGER_4 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_4_char); + +void +eoshift1_4_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + eoshift1 (ret, array, h, pbound, pwhich, " ", 1); +} + + +void eoshift1_4_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i4 * const restrict, + const char * const restrict, + const GFC_INTEGER_4 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_4_char4); + +void +eoshift1_4_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift1 (ret, array, h, pbound, pwhich, + (const char *) &space, sizeof (gfc_char4_t)); +} + +#endif diff --git a/libgfortran/generated/eoshift1_8.c b/libgfortran/generated/eoshift1_8.c new file mode 100644 index 000000000..60c8667bd --- /dev/null +++ b/libgfortran/generated/eoshift1_8.c @@ -0,0 +1,318 @@ +/* Implementation of the EOSHIFT intrinsic + Copyright 2002, 2005, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +static void +eoshift1 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_8 * const restrict pwhich, + const char * filler, index_type filler_len) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char * restrict 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_8 *hptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + index_type size; + index_type arraysize; + int which; + GFC_INTEGER_8 sh; + GFC_INTEGER_8 delta; + + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + + size = GFC_DESCRIPTOR_SIZE(array); + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + extent[0] = 1; + count[0] = 0; + + arraysize = size0 ((array_t *) array); + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + + } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + 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--) + { + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + + 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 probably 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_8 (gfc_array_char * const restrict, + const gfc_array_char * const restrict, + const gfc_array_i8 * const restrict, const char * const restrict, + const GFC_INTEGER_8 * const restrict); +export_proto(eoshift1_8); + +void +eoshift1_8 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_8 * const restrict pwhich) +{ + eoshift1 (ret, array, h, pbound, pwhich, "\0", 1); +} + + +void eoshift1_8_char (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i8 * const restrict, + const char * const restrict, + const GFC_INTEGER_8 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_8_char); + +void +eoshift1_8_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + eoshift1 (ret, array, h, pbound, pwhich, " ", 1); +} + + +void eoshift1_8_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i8 * const restrict, + const char * const restrict, + const GFC_INTEGER_8 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_8_char4); + +void +eoshift1_8_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift1 (ret, array, h, pbound, pwhich, + (const char *) &space, sizeof (gfc_char4_t)); +} + +#endif diff --git a/libgfortran/generated/eoshift3_16.c b/libgfortran/generated/eoshift3_16.c new file mode 100644 index 000000000..95772e9a8 --- /dev/null +++ b/libgfortran/generated/eoshift3_16.c @@ -0,0 +1,336 @@ +/* Implementation of the EOSHIFT intrinsic + Copyright 2002, 2005, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +static void +eoshift3 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_16 * const restrict pwhich, + const char * filler, index_type filler_len) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char * restrict 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; + index_type size; + index_type arraysize; + 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; + + arraysize = size0 ((array_t *) array); + size = GFC_DESCRIPTOR_SIZE(array); + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + + } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + + extent[0] = 1; + count[0] = 0; + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + if (bound) + bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); + 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--) + { + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + + 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 probably 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 restrict, + const gfc_array_char * const restrict, + const gfc_array_i16 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_16 *); +export_proto(eoshift3_16); + +void +eoshift3_16 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_16 * const restrict pwhich) +{ + eoshift3 (ret, array, h, bound, pwhich, "\0", 1); +} + + +extern void eoshift3_16_char (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i16 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_16 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_16_char); + +void +eoshift3_16_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + eoshift3 (ret, array, h, bound, pwhich, " ", 1); +} + + +extern void eoshift3_16_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i16 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_16 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_16_char4); + +void +eoshift3_16_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift3 (ret, array, h, bound, pwhich, + (const char *) &space, sizeof (gfc_char4_t)); +} + +#endif diff --git a/libgfortran/generated/eoshift3_4.c b/libgfortran/generated/eoshift3_4.c new file mode 100644 index 000000000..04cbd9f03 --- /dev/null +++ b/libgfortran/generated/eoshift3_4.c @@ -0,0 +1,336 @@ +/* Implementation of the EOSHIFT intrinsic + Copyright 2002, 2005, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +static void +eoshift3 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_4 * const restrict pwhich, + const char * filler, index_type filler_len) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char * restrict 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_4 *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; + index_type size; + index_type arraysize; + int which; + GFC_INTEGER_4 sh; + GFC_INTEGER_4 delta; + + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + + arraysize = size0 ((array_t *) array); + size = GFC_DESCRIPTOR_SIZE(array); + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + + } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + + extent[0] = 1; + count[0] = 0; + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + if (bound) + bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); + 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--) + { + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + + 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 probably 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_4 (gfc_array_char * const restrict, + const gfc_array_char * const restrict, + const gfc_array_i4 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_4 *); +export_proto(eoshift3_4); + +void +eoshift3_4 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_4 * const restrict pwhich) +{ + eoshift3 (ret, array, h, bound, pwhich, "\0", 1); +} + + +extern void eoshift3_4_char (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i4 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_4 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_4_char); + +void +eoshift3_4_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + eoshift3 (ret, array, h, bound, pwhich, " ", 1); +} + + +extern void eoshift3_4_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i4 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_4 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_4_char4); + +void +eoshift3_4_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift3 (ret, array, h, bound, pwhich, + (const char *) &space, sizeof (gfc_char4_t)); +} + +#endif diff --git a/libgfortran/generated/eoshift3_8.c b/libgfortran/generated/eoshift3_8.c new file mode 100644 index 000000000..f2b5a8a50 --- /dev/null +++ b/libgfortran/generated/eoshift3_8.c @@ -0,0 +1,336 @@ +/* Implementation of the EOSHIFT intrinsic + Copyright 2002, 2005, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +static void +eoshift3 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_8 * const restrict pwhich, + const char * filler, index_type filler_len) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char * restrict 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_8 *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; + index_type size; + index_type arraysize; + int which; + GFC_INTEGER_8 sh; + GFC_INTEGER_8 delta; + + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + + arraysize = size0 ((array_t *) array); + size = GFC_DESCRIPTOR_SIZE(array); + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + + } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + + extent[0] = 1; + count[0] = 0; + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + if (bound) + bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); + 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--) + { + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + + 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 probably 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_8 (gfc_array_char * const restrict, + const gfc_array_char * const restrict, + const gfc_array_i8 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_8 *); +export_proto(eoshift3_8); + +void +eoshift3_8 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_8 * const restrict pwhich) +{ + eoshift3 (ret, array, h, bound, pwhich, "\0", 1); +} + + +extern void eoshift3_8_char (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i8 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_8 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_8_char); + +void +eoshift3_8_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + eoshift3 (ret, array, h, bound, pwhich, " ", 1); +} + + +extern void eoshift3_8_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i8 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_8 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_8_char4); + +void +eoshift3_8_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift3 (ret, array, h, bound, pwhich, + (const char *) &space, sizeof (gfc_char4_t)); +} + +#endif diff --git a/libgfortran/generated/exponent_r10.c b/libgfortran/generated/exponent_r10.c new file mode 100644 index 000000000..a33451f0c --- /dev/null +++ b/libgfortran/generated/exponent_r10.c @@ -0,0 +1,45 @@ +/* Implementation of the EXPONENT intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## l + +#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; + MATHFUNC(frexp) (s, &ret); + return ret; +} + +#endif diff --git a/libgfortran/generated/exponent_r16.c b/libgfortran/generated/exponent_r16.c new file mode 100644 index 000000000..f05aad255 --- /dev/null +++ b/libgfortran/generated/exponent_r16.c @@ -0,0 +1,49 @@ +/* Implementation of the EXPONENT intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define MATHFUNC(funcname) funcname ## q +#else +#define MATHFUNC(funcname) funcname ## l +#endif + +#if defined (HAVE_GFC_REAL_16) && (defined(GFC_REAL_16_IS_FLOAT128) || 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; + MATHFUNC(frexp) (s, &ret); + return ret; +} + +#endif diff --git a/libgfortran/generated/exponent_r4.c b/libgfortran/generated/exponent_r4.c new file mode 100644 index 000000000..02e36020d --- /dev/null +++ b/libgfortran/generated/exponent_r4.c @@ -0,0 +1,45 @@ +/* Implementation of the EXPONENT intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## f + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_FREXPF) + +extern GFC_INTEGER_4 exponent_r4 (GFC_REAL_4 s); +export_proto(exponent_r4); + +GFC_INTEGER_4 +exponent_r4 (GFC_REAL_4 s) +{ + int ret; + MATHFUNC(frexp) (s, &ret); + return ret; +} + +#endif diff --git a/libgfortran/generated/exponent_r8.c b/libgfortran/generated/exponent_r8.c new file mode 100644 index 000000000..b1633f10c --- /dev/null +++ b/libgfortran/generated/exponent_r8.c @@ -0,0 +1,45 @@ +/* Implementation of the EXPONENT intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_FREXP) + +extern GFC_INTEGER_4 exponent_r8 (GFC_REAL_8 s); +export_proto(exponent_r8); + +GFC_INTEGER_4 +exponent_r8 (GFC_REAL_8 s) +{ + int ret; + MATHFUNC(frexp) (s, &ret); + return ret; +} + +#endif diff --git a/libgfortran/generated/fraction_r10.c b/libgfortran/generated/fraction_r10.c new file mode 100644 index 000000000..c883ac943 --- /dev/null +++ b/libgfortran/generated/fraction_r10.c @@ -0,0 +1,44 @@ +/* Implementation of the FRACTION intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## l + +#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 MATHFUNC(frexp) (s, &dummy_exp); +} + +#endif diff --git a/libgfortran/generated/fraction_r16.c b/libgfortran/generated/fraction_r16.c new file mode 100644 index 000000000..df692e1f1 --- /dev/null +++ b/libgfortran/generated/fraction_r16.c @@ -0,0 +1,48 @@ +/* Implementation of the FRACTION intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define MATHFUNC(funcname) funcname ## q +#else +#define MATHFUNC(funcname) funcname ## l +#endif + +#if defined (HAVE_GFC_REAL_16) && (defined(GFC_REAL_16_IS_FLOAT128) || 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 MATHFUNC(frexp) (s, &dummy_exp); +} + +#endif diff --git a/libgfortran/generated/fraction_r4.c b/libgfortran/generated/fraction_r4.c new file mode 100644 index 000000000..f8cac78a3 --- /dev/null +++ b/libgfortran/generated/fraction_r4.c @@ -0,0 +1,44 @@ +/* Implementation of the FRACTION intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## f + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_FREXPF) + +extern GFC_REAL_4 fraction_r4 (GFC_REAL_4 s); +export_proto(fraction_r4); + +GFC_REAL_4 +fraction_r4 (GFC_REAL_4 s) +{ + int dummy_exp; + return MATHFUNC(frexp) (s, &dummy_exp); +} + +#endif diff --git a/libgfortran/generated/fraction_r8.c b/libgfortran/generated/fraction_r8.c new file mode 100644 index 000000000..02ac746c6 --- /dev/null +++ b/libgfortran/generated/fraction_r8.c @@ -0,0 +1,44 @@ +/* Implementation of the FRACTION intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_FREXP) + +extern GFC_REAL_8 fraction_r8 (GFC_REAL_8 s); +export_proto(fraction_r8); + +GFC_REAL_8 +fraction_r8 (GFC_REAL_8 s) +{ + int dummy_exp; + return MATHFUNC(frexp) (s, &dummy_exp); +} + +#endif diff --git a/libgfortran/generated/iall_i1.c b/libgfortran/generated/iall_i1.c new file mode 100644 index 000000000..c6bacab6e --- /dev/null +++ b/libgfortran/generated/iall_i1.c @@ -0,0 +1,509 @@ +/* Implementation of the IALL intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1) + + +extern void iall_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(iall_i1); + +void +iall_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IALL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IALL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_1 result; + src = base; + { + + result = (GFC_INTEGER_1) -1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result &= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miall_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miall_i1); + +void +miall_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IALL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IALL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IALL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_1 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result &= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siall_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siall_i1); + +void +siall_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iall_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IALL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IALL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iall_i16.c b/libgfortran/generated/iall_i16.c new file mode 100644 index 000000000..618f33388 --- /dev/null +++ b/libgfortran/generated/iall_i16.c @@ -0,0 +1,509 @@ +/* Implementation of the IALL intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void iall_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(iall_i16); + +void +iall_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IALL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IALL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + result = (GFC_INTEGER_16) -1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result &= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miall_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miall_i16); + +void +miall_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IALL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IALL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IALL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result &= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siall_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siall_i16); + +void +siall_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iall_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IALL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IALL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iall_i2.c b/libgfortran/generated/iall_i2.c new file mode 100644 index 000000000..c90005947 --- /dev/null +++ b/libgfortran/generated/iall_i2.c @@ -0,0 +1,509 @@ +/* Implementation of the IALL intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2) + + +extern void iall_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(iall_i2); + +void +iall_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IALL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IALL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_2 result; + src = base; + { + + result = (GFC_INTEGER_2) -1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result &= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miall_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miall_i2); + +void +miall_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IALL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IALL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IALL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_2 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result &= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siall_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siall_i2); + +void +siall_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iall_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IALL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IALL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iall_i4.c b/libgfortran/generated/iall_i4.c new file mode 100644 index 000000000..d5e7dfe3f --- /dev/null +++ b/libgfortran/generated/iall_i4.c @@ -0,0 +1,509 @@ +/* Implementation of the IALL intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void iall_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(iall_i4); + +void +iall_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IALL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IALL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + result = (GFC_INTEGER_4) -1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result &= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miall_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miall_i4); + +void +miall_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IALL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IALL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IALL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result &= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siall_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siall_i4); + +void +siall_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iall_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IALL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IALL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iall_i8.c b/libgfortran/generated/iall_i8.c new file mode 100644 index 000000000..74ae1b5ed --- /dev/null +++ b/libgfortran/generated/iall_i8.c @@ -0,0 +1,509 @@ +/* Implementation of the IALL intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void iall_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(iall_i8); + +void +iall_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IALL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IALL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + result = (GFC_INTEGER_8) -1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result &= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miall_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miall_i8); + +void +miall_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IALL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IALL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IALL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result &= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siall_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siall_i8); + +void +siall_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iall_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IALL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IALL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iany_i1.c b/libgfortran/generated/iany_i1.c new file mode 100644 index 000000000..e5d7855a7 --- /dev/null +++ b/libgfortran/generated/iany_i1.c @@ -0,0 +1,509 @@ +/* Implementation of the IANY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1) + + +extern void iany_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(iany_i1); + +void +iany_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IANY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IANY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_1 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result |= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miany_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miany_i1); + +void +miany_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IANY intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IANY"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IANY"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_1 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result |= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siany_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siany_i1); + +void +siany_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iany_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IANY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IANY intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iany_i16.c b/libgfortran/generated/iany_i16.c new file mode 100644 index 000000000..20d14d56d --- /dev/null +++ b/libgfortran/generated/iany_i16.c @@ -0,0 +1,509 @@ +/* Implementation of the IANY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void iany_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(iany_i16); + +void +iany_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IANY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IANY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result |= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miany_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miany_i16); + +void +miany_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IANY intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IANY"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IANY"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result |= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siany_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siany_i16); + +void +siany_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iany_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IANY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IANY intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iany_i2.c b/libgfortran/generated/iany_i2.c new file mode 100644 index 000000000..b464c5d5f --- /dev/null +++ b/libgfortran/generated/iany_i2.c @@ -0,0 +1,509 @@ +/* Implementation of the IANY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2) + + +extern void iany_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(iany_i2); + +void +iany_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IANY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IANY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_2 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result |= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miany_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miany_i2); + +void +miany_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IANY intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IANY"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IANY"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_2 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result |= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siany_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siany_i2); + +void +siany_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iany_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IANY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IANY intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iany_i4.c b/libgfortran/generated/iany_i4.c new file mode 100644 index 000000000..3e202820d --- /dev/null +++ b/libgfortran/generated/iany_i4.c @@ -0,0 +1,509 @@ +/* Implementation of the IANY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void iany_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(iany_i4); + +void +iany_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IANY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IANY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result |= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miany_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miany_i4); + +void +miany_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IANY intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IANY"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IANY"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result |= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siany_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siany_i4); + +void +siany_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iany_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IANY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IANY intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iany_i8.c b/libgfortran/generated/iany_i8.c new file mode 100644 index 000000000..8c89e4d28 --- /dev/null +++ b/libgfortran/generated/iany_i8.c @@ -0,0 +1,509 @@ +/* Implementation of the IANY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void iany_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(iany_i8); + +void +iany_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IANY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IANY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result |= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miany_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miany_i8); + +void +miany_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IANY intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IANY"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IANY"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result |= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siany_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siany_i8); + +void +siany_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iany_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IANY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IANY intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/in_pack_c10.c b/libgfortran/generated/in_pack_c10.c new file mode 100644 index 000000000..97ce9d1ea --- /dev/null +++ b/libgfortran/generated/in_pack_c10.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#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 * restrict dest; + GFC_COMPLEX_10 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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 probably 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 index 000000000..74e3cb67d --- /dev/null +++ b/libgfortran/generated/in_pack_c16.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#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 * restrict dest; + GFC_COMPLEX_16 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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 probably 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_c4.c b/libgfortran/generated/in_pack_c4.c new file mode 100644 index 000000000..ae52bc689 --- /dev/null +++ b/libgfortran/generated/in_pack_c4.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_4) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_COMPLEX_4 * +internal_pack_c4 (gfc_array_c4 * 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_4 *src; + GFC_COMPLEX_4 * restrict dest; + GFC_COMPLEX_4 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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_4 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_4)); + 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 probably 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_c8.c b/libgfortran/generated/in_pack_c8.c new file mode 100644 index 000000000..142ad99cd --- /dev/null +++ b/libgfortran/generated/in_pack_c8.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_8) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_COMPLEX_8 * +internal_pack_c8 (gfc_array_c8 * 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_8 *src; + GFC_COMPLEX_8 * restrict dest; + GFC_COMPLEX_8 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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_8 *)internal_malloc_size (ssize * sizeof (GFC_COMPLEX_8)); + 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 probably 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_i1.c b/libgfortran/generated/in_pack_i1.c new file mode 100644 index 000000000..dc26c1af6 --- /dev/null +++ b/libgfortran/generated/in_pack_i1.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_INTEGER_1 * +internal_pack_1 (gfc_array_i1 * 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_1 *src; + GFC_INTEGER_1 * restrict dest; + GFC_INTEGER_1 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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_1 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_1)); + 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 probably 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_i16.c b/libgfortran/generated/in_pack_i16.c new file mode 100644 index 000000000..32ce3a4ea --- /dev/null +++ b/libgfortran/generated/in_pack_i16.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#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 * restrict dest; + GFC_INTEGER_16 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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 probably 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_i2.c b/libgfortran/generated/in_pack_i2.c new file mode 100644 index 000000000..3c39f8e61 --- /dev/null +++ b/libgfortran/generated/in_pack_i2.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_INTEGER_2 * +internal_pack_2 (gfc_array_i2 * 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_2 *src; + GFC_INTEGER_2 * restrict dest; + GFC_INTEGER_2 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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_2 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_2)); + 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 probably 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_i4.c b/libgfortran/generated/in_pack_i4.c new file mode 100644 index 000000000..4cd7dba47 --- /dev/null +++ b/libgfortran/generated/in_pack_i4.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_INTEGER_4 * +internal_pack_4 (gfc_array_i4 * 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_4 *src; + GFC_INTEGER_4 * restrict dest; + GFC_INTEGER_4 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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_4 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_4)); + 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 probably 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_i8.c b/libgfortran/generated/in_pack_i8.c new file mode 100644 index 000000000..17acc684f --- /dev/null +++ b/libgfortran/generated/in_pack_i8.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_INTEGER_8 * +internal_pack_8 (gfc_array_i8 * 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_8 *src; + GFC_INTEGER_8 * restrict dest; + GFC_INTEGER_8 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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_8 *)internal_malloc_size (ssize * sizeof (GFC_INTEGER_8)); + 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 probably 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_r10.c b/libgfortran/generated/in_pack_r10.c new file mode 100644 index 000000000..557ccc2aa --- /dev/null +++ b/libgfortran/generated/in_pack_r10.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_10) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_REAL_10 * +internal_pack_r10 (gfc_array_r10 * 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_REAL_10 *src; + GFC_REAL_10 * restrict dest; + GFC_REAL_10 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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_REAL_10 *)internal_malloc_size (ssize * sizeof (GFC_REAL_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 probably 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_r16.c b/libgfortran/generated/in_pack_r16.c new file mode 100644 index 000000000..b737cc7d2 --- /dev/null +++ b/libgfortran/generated/in_pack_r16.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_16) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_REAL_16 * +internal_pack_r16 (gfc_array_r16 * 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_REAL_16 *src; + GFC_REAL_16 * restrict dest; + GFC_REAL_16 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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_REAL_16 *)internal_malloc_size (ssize * sizeof (GFC_REAL_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 probably 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_r4.c b/libgfortran/generated/in_pack_r4.c new file mode 100644 index 000000000..68a7e5a0d --- /dev/null +++ b/libgfortran/generated/in_pack_r4.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_4) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_REAL_4 * +internal_pack_r4 (gfc_array_r4 * 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_REAL_4 *src; + GFC_REAL_4 * restrict dest; + GFC_REAL_4 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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_REAL_4 *)internal_malloc_size (ssize * sizeof (GFC_REAL_4)); + 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 probably 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_r8.c b/libgfortran/generated/in_pack_r8.c new file mode 100644 index 000000000..1453f86b5 --- /dev/null +++ b/libgfortran/generated/in_pack_r8.c @@ -0,0 +1,119 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_8) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_REAL_8 * +internal_pack_r8 (gfc_array_r8 * 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_REAL_8 *src; + GFC_REAL_8 * restrict dest; + GFC_REAL_8 *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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_REAL_8 *)internal_malloc_size (ssize * sizeof (GFC_REAL_8)); + 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 probably 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_unpack_c10.c b/libgfortran/generated/in_unpack_c10.c new file mode 100644 index 000000000..bcac6e7a5 --- /dev/null +++ b/libgfortran/generated/in_unpack_c10.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#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 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + 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 probably 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 index 000000000..1d09a8006 --- /dev/null +++ b/libgfortran/generated/in_unpack_c16.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#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 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + 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 probably 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_c4.c b/libgfortran/generated/in_unpack_c4.c new file mode 100644 index 000000000..9ad8a3310 --- /dev/null +++ b/libgfortran/generated/in_unpack_c4.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_4) + +void +internal_unpack_c4 (gfc_array_c4 * d, const GFC_COMPLEX_4 * 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_4 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_4)); + 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 probably 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_c8.c b/libgfortran/generated/in_unpack_c8.c new file mode 100644 index 000000000..6adae640e --- /dev/null +++ b/libgfortran/generated/in_unpack_c8.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_8) + +void +internal_unpack_c8 (gfc_array_c8 * d, const GFC_COMPLEX_8 * 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_8 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_COMPLEX_8)); + 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 probably 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_i1.c b/libgfortran/generated/in_unpack_i1.c new file mode 100644 index 000000000..e632816c9 --- /dev/null +++ b/libgfortran/generated/in_unpack_i1.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) + +void +internal_unpack_1 (gfc_array_i1 * d, const GFC_INTEGER_1 * 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_1 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_INTEGER_1)); + 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 probably 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_i16.c b/libgfortran/generated/in_unpack_i16.c new file mode 100644 index 000000000..c7199207e --- /dev/null +++ b/libgfortran/generated/in_unpack_i16.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#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 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + 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 probably 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_i2.c b/libgfortran/generated/in_unpack_i2.c new file mode 100644 index 000000000..ec0c1c3ac --- /dev/null +++ b/libgfortran/generated/in_unpack_i2.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) + +void +internal_unpack_2 (gfc_array_i2 * d, const GFC_INTEGER_2 * 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_2 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_INTEGER_2)); + 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 probably 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_i4.c b/libgfortran/generated/in_unpack_i4.c new file mode 100644 index 000000000..ce5d29df7 --- /dev/null +++ b/libgfortran/generated/in_unpack_i4.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +void +internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * 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_4 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_INTEGER_4)); + 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 probably 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_i8.c b/libgfortran/generated/in_unpack_i8.c new file mode 100644 index 000000000..347f0116c --- /dev/null +++ b/libgfortran/generated/in_unpack_i8.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +void +internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * 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_8 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_INTEGER_8)); + 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 probably 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_r10.c b/libgfortran/generated/in_unpack_r10.c new file mode 100644 index 000000000..aa5f08eb2 --- /dev/null +++ b/libgfortran/generated/in_unpack_r10.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) + +void +internal_unpack_r10 (gfc_array_r10 * d, const GFC_REAL_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_REAL_10 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_REAL_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 probably 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_r16.c b/libgfortran/generated/in_unpack_r16.c new file mode 100644 index 000000000..0b08228ce --- /dev/null +++ b/libgfortran/generated/in_unpack_r16.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) + +void +internal_unpack_r16 (gfc_array_r16 * d, const GFC_REAL_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_REAL_16 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_REAL_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 probably 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_r4.c b/libgfortran/generated/in_unpack_r4.c new file mode 100644 index 000000000..f436c8afa --- /dev/null +++ b/libgfortran/generated/in_unpack_r4.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) + +void +internal_unpack_r4 (gfc_array_r4 * d, const GFC_REAL_4 * 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_REAL_4 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_REAL_4)); + 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 probably 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_r8.c b/libgfortran/generated/in_unpack_r8.c new file mode 100644 index 000000000..76aff2e59 --- /dev/null +++ b/libgfortran/generated/in_unpack_r8.c @@ -0,0 +1,107 @@ +/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) + +void +internal_unpack_r8 (gfc_array_r8 * d, const GFC_REAL_8 * 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_REAL_8 * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof (GFC_REAL_8)); + 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 probably 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/iparity_i1.c b/libgfortran/generated/iparity_i1.c new file mode 100644 index 000000000..35c51c04d --- /dev/null +++ b/libgfortran/generated/iparity_i1.c @@ -0,0 +1,509 @@ +/* Implementation of the IPARITY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1) + + +extern void iparity_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(iparity_i1); + +void +iparity_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IPARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IPARITY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_1 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result ^= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miparity_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miparity_i1); + +void +miparity_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IPARITY intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IPARITY"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IPARITY"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_1 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result ^= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siparity_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siparity_i1); + +void +siparity_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iparity_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IPARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IPARITY intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iparity_i16.c b/libgfortran/generated/iparity_i16.c new file mode 100644 index 000000000..608fe224a --- /dev/null +++ b/libgfortran/generated/iparity_i16.c @@ -0,0 +1,509 @@ +/* Implementation of the IPARITY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void iparity_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(iparity_i16); + +void +iparity_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IPARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IPARITY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result ^= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miparity_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miparity_i16); + +void +miparity_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IPARITY intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IPARITY"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IPARITY"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result ^= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siparity_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siparity_i16); + +void +siparity_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iparity_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IPARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IPARITY intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iparity_i2.c b/libgfortran/generated/iparity_i2.c new file mode 100644 index 000000000..a1e465c5c --- /dev/null +++ b/libgfortran/generated/iparity_i2.c @@ -0,0 +1,509 @@ +/* Implementation of the IPARITY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2) + + +extern void iparity_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(iparity_i2); + +void +iparity_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IPARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IPARITY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_2 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result ^= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miparity_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miparity_i2); + +void +miparity_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IPARITY intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IPARITY"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IPARITY"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_2 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result ^= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siparity_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siparity_i2); + +void +siparity_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iparity_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IPARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IPARITY intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iparity_i4.c b/libgfortran/generated/iparity_i4.c new file mode 100644 index 000000000..e4a492cbf --- /dev/null +++ b/libgfortran/generated/iparity_i4.c @@ -0,0 +1,509 @@ +/* Implementation of the IPARITY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void iparity_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(iparity_i4); + +void +iparity_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IPARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IPARITY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result ^= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miparity_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miparity_i4); + +void +miparity_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IPARITY intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IPARITY"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IPARITY"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result ^= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siparity_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siparity_i4); + +void +siparity_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iparity_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IPARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IPARITY intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/iparity_i8.c b/libgfortran/generated/iparity_i8.c new file mode 100644 index 000000000..b3997518c --- /dev/null +++ b/libgfortran/generated/iparity_i8.c @@ -0,0 +1,509 @@ +/* Implementation of the IPARITY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void iparity_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(iparity_i8); + +void +iparity_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IPARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IPARITY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result ^= *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void miparity_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(miparity_i8); + +void +miparity_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in IPARITY intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "IPARITY"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "IPARITY"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result ^= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void siparity_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(siparity_i8); + +void +siparity_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + iparity_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " IPARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " IPARITY intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_c10.c b/libgfortran/generated/matmul_c10.c new file mode 100644 index 000000000..c54c78ed4 --- /dev/null +++ b/libgfortran/generated/matmul_c10.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_10) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_COMPLEX_10 *, const GFC_COMPLEX_10 *, + const int *, const GFC_COMPLEX_10 *, const int *, + const GFC_COMPLEX_10 *, GFC_COMPLEX_10 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict a, gfc_array_c10 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_c10); + +void +matmul_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict a, gfc_array_c10 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_COMPLEX_10 * restrict abase; + const GFC_COMPLEX_10 * restrict bbase; + GFC_COMPLEX_10 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_COMPLEX_10 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_COMPLEX_10 * restrict bbase_y; + GFC_COMPLEX_10 * restrict dest_y; + const GFC_COMPLEX_10 * restrict abase_n; + GFC_COMPLEX_10 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_COMPLEX_10) * xcount * ycount)); + 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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_COMPLEX_10 *restrict abase_x; + const GFC_COMPLEX_10 *restrict bbase_y; + GFC_COMPLEX_10 *restrict dest_y; + GFC_COMPLEX_10 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_COMPLEX_10) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_COMPLEX_10 *restrict bbase_y; + GFC_COMPLEX_10 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_COMPLEX_10) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + 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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_COMPLEX_10 *restrict bbase_y; + GFC_COMPLEX_10 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_COMPLEX_10) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_COMPLEX_10 *restrict abase_x; + const GFC_COMPLEX_10 *restrict bbase_y; + GFC_COMPLEX_10 *restrict dest_y; + GFC_COMPLEX_10 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_COMPLEX_10) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_c16.c b/libgfortran/generated/matmul_c16.c new file mode 100644 index 000000000..880c0e127 --- /dev/null +++ b/libgfortran/generated/matmul_c16.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_16) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_COMPLEX_16 *, const GFC_COMPLEX_16 *, + const int *, const GFC_COMPLEX_16 *, const int *, + const GFC_COMPLEX_16 *, GFC_COMPLEX_16 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict a, gfc_array_c16 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_c16); + +void +matmul_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict a, gfc_array_c16 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_COMPLEX_16 * restrict abase; + const GFC_COMPLEX_16 * restrict bbase; + GFC_COMPLEX_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_COMPLEX_16 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_COMPLEX_16 * restrict bbase_y; + GFC_COMPLEX_16 * restrict dest_y; + const GFC_COMPLEX_16 * restrict abase_n; + GFC_COMPLEX_16 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_COMPLEX_16) * xcount * ycount)); + 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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_COMPLEX_16 *restrict abase_x; + const GFC_COMPLEX_16 *restrict bbase_y; + GFC_COMPLEX_16 *restrict dest_y; + GFC_COMPLEX_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_COMPLEX_16) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_COMPLEX_16 *restrict bbase_y; + GFC_COMPLEX_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_COMPLEX_16) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + 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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_COMPLEX_16 *restrict bbase_y; + GFC_COMPLEX_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_COMPLEX_16) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_COMPLEX_16 *restrict abase_x; + const GFC_COMPLEX_16 *restrict bbase_y; + GFC_COMPLEX_16 *restrict dest_y; + GFC_COMPLEX_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_COMPLEX_16) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_c4.c b/libgfortran/generated/matmul_c4.c new file mode 100644 index 000000000..020033a77 --- /dev/null +++ b/libgfortran/generated/matmul_c4.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_4) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_COMPLEX_4 *, const GFC_COMPLEX_4 *, + const int *, const GFC_COMPLEX_4 *, const int *, + const GFC_COMPLEX_4 *, GFC_COMPLEX_4 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict a, gfc_array_c4 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_c4); + +void +matmul_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict a, gfc_array_c4 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_COMPLEX_4 * restrict abase; + const GFC_COMPLEX_4 * restrict bbase; + GFC_COMPLEX_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_COMPLEX_4 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_COMPLEX_4 * restrict bbase_y; + GFC_COMPLEX_4 * restrict dest_y; + const GFC_COMPLEX_4 * restrict abase_n; + GFC_COMPLEX_4 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_COMPLEX_4) * xcount * ycount)); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_COMPLEX_4)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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_COMPLEX_4 *restrict abase_x; + const GFC_COMPLEX_4 *restrict bbase_y; + GFC_COMPLEX_4 *restrict dest_y; + GFC_COMPLEX_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_COMPLEX_4) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_COMPLEX_4 *restrict bbase_y; + GFC_COMPLEX_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_COMPLEX_4) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_COMPLEX_4)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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_COMPLEX_4 *restrict bbase_y; + GFC_COMPLEX_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_COMPLEX_4) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_COMPLEX_4 *restrict abase_x; + const GFC_COMPLEX_4 *restrict bbase_y; + GFC_COMPLEX_4 *restrict dest_y; + GFC_COMPLEX_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_COMPLEX_4) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_c8.c b/libgfortran/generated/matmul_c8.c new file mode 100644 index 000000000..1522dcd5a --- /dev/null +++ b/libgfortran/generated/matmul_c8.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_8) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_COMPLEX_8 *, const GFC_COMPLEX_8 *, + const int *, const GFC_COMPLEX_8 *, const int *, + const GFC_COMPLEX_8 *, GFC_COMPLEX_8 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_c8 (gfc_array_c8 * const restrict retarray, + gfc_array_c8 * const restrict a, gfc_array_c8 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_c8); + +void +matmul_c8 (gfc_array_c8 * const restrict retarray, + gfc_array_c8 * const restrict a, gfc_array_c8 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_COMPLEX_8 * restrict abase; + const GFC_COMPLEX_8 * restrict bbase; + GFC_COMPLEX_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_COMPLEX_8 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_COMPLEX_8 * restrict bbase_y; + GFC_COMPLEX_8 * restrict dest_y; + const GFC_COMPLEX_8 * restrict abase_n; + GFC_COMPLEX_8 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_COMPLEX_8) * xcount * ycount)); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_COMPLEX_8)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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_COMPLEX_8 *restrict abase_x; + const GFC_COMPLEX_8 *restrict bbase_y; + GFC_COMPLEX_8 *restrict dest_y; + GFC_COMPLEX_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_COMPLEX_8) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_COMPLEX_8 *restrict bbase_y; + GFC_COMPLEX_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_COMPLEX_8) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_COMPLEX_8)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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_COMPLEX_8 *restrict bbase_y; + GFC_COMPLEX_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_COMPLEX_8) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_COMPLEX_8 *restrict abase_x; + const GFC_COMPLEX_8 *restrict bbase_y; + GFC_COMPLEX_8 *restrict dest_y; + GFC_COMPLEX_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_COMPLEX_8) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_i1.c b/libgfortran/generated/matmul_i1.c new file mode 100644 index 000000000..db5667851 --- /dev/null +++ b/libgfortran/generated/matmul_i1.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_INTEGER_1 *, const GFC_INTEGER_1 *, + const int *, const GFC_INTEGER_1 *, const int *, + const GFC_INTEGER_1 *, GFC_INTEGER_1 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict a, gfc_array_i1 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_i1); + +void +matmul_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict a, gfc_array_i1 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_INTEGER_1 * restrict abase; + const GFC_INTEGER_1 * restrict bbase; + GFC_INTEGER_1 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_1) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_INTEGER_1 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_INTEGER_1 * restrict bbase_y; + GFC_INTEGER_1 * restrict dest_y; + const GFC_INTEGER_1 * restrict abase_n; + GFC_INTEGER_1 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_INTEGER_1) * xcount * ycount)); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_INTEGER_1)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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_INTEGER_1 *restrict abase_x; + const GFC_INTEGER_1 *restrict bbase_y; + GFC_INTEGER_1 *restrict dest_y; + GFC_INTEGER_1 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_INTEGER_1) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_INTEGER_1 *restrict bbase_y; + GFC_INTEGER_1 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_INTEGER_1) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_INTEGER_1)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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_INTEGER_1 *restrict bbase_y; + GFC_INTEGER_1 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_INTEGER_1) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_INTEGER_1 *restrict abase_x; + const GFC_INTEGER_1 *restrict bbase_y; + GFC_INTEGER_1 *restrict dest_y; + GFC_INTEGER_1 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_INTEGER_1) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_i16.c b/libgfortran/generated/matmul_i16.c new file mode 100644 index 000000000..f607e27b8 --- /dev/null +++ b/libgfortran/generated/matmul_i16.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_INTEGER_16 *, const GFC_INTEGER_16 *, + const int *, const GFC_INTEGER_16 *, const int *, + const GFC_INTEGER_16 *, GFC_INTEGER_16 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict a, gfc_array_i16 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_i16); + +void +matmul_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict a, gfc_array_i16 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_INTEGER_16 * restrict abase; + const GFC_INTEGER_16 * restrict bbase; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_INTEGER_16 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_INTEGER_16 * restrict bbase_y; + GFC_INTEGER_16 * restrict dest_y; + const GFC_INTEGER_16 * restrict abase_n; + GFC_INTEGER_16 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_INTEGER_16) * xcount * ycount)); + 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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_INTEGER_16 *restrict abase_x; + const GFC_INTEGER_16 *restrict bbase_y; + GFC_INTEGER_16 *restrict dest_y; + GFC_INTEGER_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_INTEGER_16) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_INTEGER_16 *restrict bbase_y; + GFC_INTEGER_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_INTEGER_16) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + 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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_INTEGER_16 *restrict bbase_y; + GFC_INTEGER_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_INTEGER_16) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_INTEGER_16 *restrict abase_x; + const GFC_INTEGER_16 *restrict bbase_y; + GFC_INTEGER_16 *restrict dest_y; + GFC_INTEGER_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_INTEGER_16) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_i2.c b/libgfortran/generated/matmul_i2.c new file mode 100644 index 000000000..58e340b77 --- /dev/null +++ b/libgfortran/generated/matmul_i2.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_INTEGER_2 *, const GFC_INTEGER_2 *, + const int *, const GFC_INTEGER_2 *, const int *, + const GFC_INTEGER_2 *, GFC_INTEGER_2 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict a, gfc_array_i2 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_i2); + +void +matmul_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict a, gfc_array_i2 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_INTEGER_2 * restrict abase; + const GFC_INTEGER_2 * restrict bbase; + GFC_INTEGER_2 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_2) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_INTEGER_2 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_INTEGER_2 * restrict bbase_y; + GFC_INTEGER_2 * restrict dest_y; + const GFC_INTEGER_2 * restrict abase_n; + GFC_INTEGER_2 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_INTEGER_2) * xcount * ycount)); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_INTEGER_2)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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_INTEGER_2 *restrict abase_x; + const GFC_INTEGER_2 *restrict bbase_y; + GFC_INTEGER_2 *restrict dest_y; + GFC_INTEGER_2 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_INTEGER_2) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_INTEGER_2 *restrict bbase_y; + GFC_INTEGER_2 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_INTEGER_2) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_INTEGER_2)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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_INTEGER_2 *restrict bbase_y; + GFC_INTEGER_2 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_INTEGER_2) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_INTEGER_2 *restrict abase_x; + const GFC_INTEGER_2 *restrict bbase_y; + GFC_INTEGER_2 *restrict dest_y; + GFC_INTEGER_2 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_INTEGER_2) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_i4.c b/libgfortran/generated/matmul_i4.c new file mode 100644 index 000000000..46ed493d0 --- /dev/null +++ b/libgfortran/generated/matmul_i4.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_INTEGER_4 *, const GFC_INTEGER_4 *, + const int *, const GFC_INTEGER_4 *, const int *, + const GFC_INTEGER_4 *, GFC_INTEGER_4 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict a, gfc_array_i4 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_i4); + +void +matmul_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict a, gfc_array_i4 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_INTEGER_4 * restrict abase; + const GFC_INTEGER_4 * restrict bbase; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_INTEGER_4 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_INTEGER_4 * restrict bbase_y; + GFC_INTEGER_4 * restrict dest_y; + const GFC_INTEGER_4 * restrict abase_n; + GFC_INTEGER_4 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_INTEGER_4) * xcount * ycount)); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_INTEGER_4)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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_INTEGER_4 *restrict abase_x; + const GFC_INTEGER_4 *restrict bbase_y; + GFC_INTEGER_4 *restrict dest_y; + GFC_INTEGER_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_INTEGER_4) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_INTEGER_4 *restrict bbase_y; + GFC_INTEGER_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_INTEGER_4) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_INTEGER_4)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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_INTEGER_4 *restrict bbase_y; + GFC_INTEGER_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_INTEGER_4) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_INTEGER_4 *restrict abase_x; + const GFC_INTEGER_4 *restrict bbase_y; + GFC_INTEGER_4 *restrict dest_y; + GFC_INTEGER_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_INTEGER_4) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_i8.c b/libgfortran/generated/matmul_i8.c new file mode 100644 index 000000000..54ffe6248 --- /dev/null +++ b/libgfortran/generated/matmul_i8.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_INTEGER_8 *, const GFC_INTEGER_8 *, + const int *, const GFC_INTEGER_8 *, const int *, + const GFC_INTEGER_8 *, GFC_INTEGER_8 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict a, gfc_array_i8 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_i8); + +void +matmul_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict a, gfc_array_i8 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_INTEGER_8 * restrict abase; + const GFC_INTEGER_8 * restrict bbase; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_INTEGER_8 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_INTEGER_8 * restrict bbase_y; + GFC_INTEGER_8 * restrict dest_y; + const GFC_INTEGER_8 * restrict abase_n; + GFC_INTEGER_8 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_INTEGER_8) * xcount * ycount)); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_INTEGER_8)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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_INTEGER_8 *restrict abase_x; + const GFC_INTEGER_8 *restrict bbase_y; + GFC_INTEGER_8 *restrict dest_y; + GFC_INTEGER_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_INTEGER_8) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_INTEGER_8 *restrict bbase_y; + GFC_INTEGER_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_INTEGER_8) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_INTEGER_8)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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_INTEGER_8 *restrict bbase_y; + GFC_INTEGER_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_INTEGER_8) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_INTEGER_8 *restrict abase_x; + const GFC_INTEGER_8 *restrict bbase_y; + GFC_INTEGER_8 *restrict dest_y; + GFC_INTEGER_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_INTEGER_8) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_l16.c b/libgfortran/generated/matmul_l16.c new file mode 100644 index 000000000..5fbeeb7da --- /dev/null +++ b/libgfortran/generated/matmul_l16.c @@ -0,0 +1,239 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#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 * const restrict, + gfc_array_l1 * const restrict, gfc_array_l1 * const restrict); +export_proto(matmul_l16); + +void +matmul_l16 (gfc_array_l16 * const restrict retarray, + gfc_array_l1 * const restrict a, gfc_array_l1 * const restrict b) +{ + const GFC_LOGICAL_1 * restrict abase; + const GFC_LOGICAL_1 * restrict bbase; + GFC_LOGICAL_16 * restrict 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; + int a_kind; + int b_kind; + + const GFC_LOGICAL_1 * restrict pa; + const GFC_LOGICAL_1 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_LOGICAL_16) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + abase = a->data; + a_kind = GFC_DESCRIPTOR_SIZE (a); + + if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || a_kind == 16 +#endif + ) + abase = GFOR_POINTER_TO_L1 (abase, a_kind); + else + internal_error (NULL, "Funny sized logical array"); + + bbase = b->data; + b_kind = GFC_DESCRIPTOR_SIZE (b); + + if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || b_kind == 16 +#endif + ) + bbase = GFOR_POINTER_TO_L1 (bbase, b_kind); + else + internal_error (NULL, "Funny sized logical array"); + + dest = retarray->data; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = rxstride; + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + count = GFC_DESCRIPTOR_EXTENT(a,0); + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + count = GFC_DESCRIPTOR_EXTENT(a,1); + xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + 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 + diff --git a/libgfortran/generated/matmul_l4.c b/libgfortran/generated/matmul_l4.c new file mode 100644 index 000000000..19ca9f1e5 --- /dev/null +++ b/libgfortran/generated/matmul_l4.c @@ -0,0 +1,239 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#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. */ + +extern void matmul_l4 (gfc_array_l4 * const restrict, + gfc_array_l1 * const restrict, gfc_array_l1 * const restrict); +export_proto(matmul_l4); + +void +matmul_l4 (gfc_array_l4 * const restrict retarray, + gfc_array_l1 * const restrict a, gfc_array_l1 * const restrict b) +{ + const GFC_LOGICAL_1 * restrict abase; + const GFC_LOGICAL_1 * restrict bbase; + GFC_LOGICAL_4 * restrict 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; + int a_kind; + int b_kind; + + const GFC_LOGICAL_1 * restrict pa; + const GFC_LOGICAL_1 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_LOGICAL_4) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + abase = a->data; + a_kind = GFC_DESCRIPTOR_SIZE (a); + + if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || a_kind == 16 +#endif + ) + abase = GFOR_POINTER_TO_L1 (abase, a_kind); + else + internal_error (NULL, "Funny sized logical array"); + + bbase = b->data; + b_kind = GFC_DESCRIPTOR_SIZE (b); + + if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || b_kind == 16 +#endif + ) + bbase = GFOR_POINTER_TO_L1 (bbase, b_kind); + else + internal_error (NULL, "Funny sized logical array"); + + dest = retarray->data; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = rxstride; + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + count = GFC_DESCRIPTOR_EXTENT(a,0); + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + count = GFC_DESCRIPTOR_EXTENT(a,1); + xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + 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 + diff --git a/libgfortran/generated/matmul_l8.c b/libgfortran/generated/matmul_l8.c new file mode 100644 index 000000000..558ed252e --- /dev/null +++ b/libgfortran/generated/matmul_l8.c @@ -0,0 +1,239 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#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. */ + +extern void matmul_l8 (gfc_array_l8 * const restrict, + gfc_array_l1 * const restrict, gfc_array_l1 * const restrict); +export_proto(matmul_l8); + +void +matmul_l8 (gfc_array_l8 * const restrict retarray, + gfc_array_l1 * const restrict a, gfc_array_l1 * const restrict b) +{ + const GFC_LOGICAL_1 * restrict abase; + const GFC_LOGICAL_1 * restrict bbase; + GFC_LOGICAL_8 * restrict 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; + int a_kind; + int b_kind; + + const GFC_LOGICAL_1 * restrict pa; + const GFC_LOGICAL_1 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_LOGICAL_8) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + abase = a->data; + a_kind = GFC_DESCRIPTOR_SIZE (a); + + if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || a_kind == 16 +#endif + ) + abase = GFOR_POINTER_TO_L1 (abase, a_kind); + else + internal_error (NULL, "Funny sized logical array"); + + bbase = b->data; + b_kind = GFC_DESCRIPTOR_SIZE (b); + + if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || b_kind == 16 +#endif + ) + bbase = GFOR_POINTER_TO_L1 (bbase, b_kind); + else + internal_error (NULL, "Funny sized logical array"); + + dest = retarray->data; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = rxstride; + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + count = GFC_DESCRIPTOR_EXTENT(a,0); + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + count = GFC_DESCRIPTOR_EXTENT(a,1); + xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + 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 + diff --git a/libgfortran/generated/matmul_r10.c b/libgfortran/generated/matmul_r10.c new file mode 100644 index 000000000..8e325549c --- /dev/null +++ b/libgfortran/generated/matmul_r10.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_REAL_10 *, const GFC_REAL_10 *, + const int *, const GFC_REAL_10 *, const int *, + const GFC_REAL_10 *, GFC_REAL_10 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict a, gfc_array_r10 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_r10); + +void +matmul_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict a, gfc_array_r10 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_REAL_10 * restrict abase; + const GFC_REAL_10 * restrict bbase; + GFC_REAL_10 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_REAL_10 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_REAL_10 * restrict bbase_y; + GFC_REAL_10 * restrict dest_y; + const GFC_REAL_10 * restrict abase_n; + GFC_REAL_10 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_REAL_10) * xcount * ycount)); + 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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_REAL_10 *restrict abase_x; + const GFC_REAL_10 *restrict bbase_y; + GFC_REAL_10 *restrict dest_y; + GFC_REAL_10 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_REAL_10) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_REAL_10 *restrict bbase_y; + GFC_REAL_10 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_REAL_10) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + 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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_REAL_10 *restrict bbase_y; + GFC_REAL_10 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_REAL_10) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_REAL_10 *restrict abase_x; + const GFC_REAL_10 *restrict bbase_y; + GFC_REAL_10 *restrict dest_y; + GFC_REAL_10 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_REAL_10) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_r16.c b/libgfortran/generated/matmul_r16.c new file mode 100644 index 000000000..c11553180 --- /dev/null +++ b/libgfortran/generated/matmul_r16.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_REAL_16 *, const GFC_REAL_16 *, + const int *, const GFC_REAL_16 *, const int *, + const GFC_REAL_16 *, GFC_REAL_16 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict a, gfc_array_r16 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_r16); + +void +matmul_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict a, gfc_array_r16 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_REAL_16 * restrict abase; + const GFC_REAL_16 * restrict bbase; + GFC_REAL_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_REAL_16 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_REAL_16 * restrict bbase_y; + GFC_REAL_16 * restrict dest_y; + const GFC_REAL_16 * restrict abase_n; + GFC_REAL_16 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_REAL_16) * xcount * ycount)); + 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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_REAL_16 *restrict abase_x; + const GFC_REAL_16 *restrict bbase_y; + GFC_REAL_16 *restrict dest_y; + GFC_REAL_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_REAL_16) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_REAL_16 *restrict bbase_y; + GFC_REAL_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_REAL_16) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + 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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_REAL_16 *restrict bbase_y; + GFC_REAL_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_REAL_16) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_REAL_16 *restrict abase_x; + const GFC_REAL_16 *restrict bbase_y; + GFC_REAL_16 *restrict dest_y; + GFC_REAL_16 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_REAL_16) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_r4.c b/libgfortran/generated/matmul_r4.c new file mode 100644 index 000000000..54208725d --- /dev/null +++ b/libgfortran/generated/matmul_r4.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_REAL_4 *, const GFC_REAL_4 *, + const int *, const GFC_REAL_4 *, const int *, + const GFC_REAL_4 *, GFC_REAL_4 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict a, gfc_array_r4 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_r4); + +void +matmul_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict a, gfc_array_r4 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_REAL_4 * restrict abase; + const GFC_REAL_4 * restrict bbase; + GFC_REAL_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_REAL_4 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_REAL_4 * restrict bbase_y; + GFC_REAL_4 * restrict dest_y; + const GFC_REAL_4 * restrict abase_n; + GFC_REAL_4 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_REAL_4) * xcount * ycount)); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_REAL_4)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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_REAL_4 *restrict abase_x; + const GFC_REAL_4 *restrict bbase_y; + GFC_REAL_4 *restrict dest_y; + GFC_REAL_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_REAL_4) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_REAL_4 *restrict bbase_y; + GFC_REAL_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_REAL_4) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_REAL_4)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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_REAL_4 *restrict bbase_y; + GFC_REAL_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_REAL_4) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_REAL_4 *restrict abase_x; + const GFC_REAL_4 *restrict bbase_y; + GFC_REAL_4 *restrict dest_y; + GFC_REAL_4 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_REAL_4) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/matmul_r8.c b/libgfortran/generated/matmul_r8.c new file mode 100644 index 000000000..72ad1fd58 --- /dev/null +++ b/libgfortran/generated/matmul_r8.c @@ -0,0 +1,376 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we'll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const GFC_REAL_8 *, const GFC_REAL_8 *, + const int *, const GFC_REAL_8 *, const int *, + const GFC_REAL_8 *, GFC_REAL_8 *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict a, gfc_array_r8 * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_r8); + +void +matmul_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict a, gfc_array_r8 * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const GFC_REAL_8 * restrict abase; + const GFC_REAL_8 * restrict bbase; + GFC_REAL_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we're performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const GFC_REAL_8 one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const GFC_REAL_8 * restrict bbase_y; + GFC_REAL_8 * restrict dest_y; + const GFC_REAL_8 * restrict abase_n; + GFC_REAL_8 bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof (GFC_REAL_8) * xcount * ycount)); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = (GFC_REAL_8)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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const GFC_REAL_8 *restrict abase_x; + const GFC_REAL_8 *restrict bbase_y; + GFC_REAL_8 *restrict dest_y; + GFC_REAL_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_REAL_8) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const GFC_REAL_8 *restrict bbase_y; + GFC_REAL_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_REAL_8) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = (GFC_REAL_8)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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const GFC_REAL_8 *restrict bbase_y; + GFC_REAL_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = (GFC_REAL_8) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const GFC_REAL_8 *restrict abase_x; + const GFC_REAL_8 *restrict bbase_y; + GFC_REAL_8 *restrict dest_y; + GFC_REAL_8 s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = (GFC_REAL_8) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc0_16_i1.c b/libgfortran/generated/maxloc0_16_i1.c new file mode 100644 index 000000000..5649018db --- /dev/null +++ b/libgfortran/generated/maxloc0_16_i1.c @@ -0,0 +1,383 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc0_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array); +export_proto(maxloc0_16_i1); + +void +maxloc0_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_1 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_1 maxval; +#if defined(GFC_INTEGER_1_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_1_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_16_i1 (gfc_array_i16 * const restrict, + gfc_array_i1 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_16_i1); + +void +mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_INTEGER_1 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_1 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_1_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_16_i1 (gfc_array_i16 * const restrict, + gfc_array_i1 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_i1); + +void +smaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_i1 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc0_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array); +export_proto(maxloc0_16_i16); + +void +maxloc0_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_16 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_16_i16); + +void +mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_INTEGER_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_16 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_i16); + +void +smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_i16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc0_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array); +export_proto(maxloc0_16_i2); + +void +maxloc0_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_2 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_2 maxval; +#if defined(GFC_INTEGER_2_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_2_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_16_i2 (gfc_array_i16 * const restrict, + gfc_array_i2 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_16_i2); + +void +mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_INTEGER_2 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_2 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_2_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_16_i2 (gfc_array_i16 * const restrict, + gfc_array_i2 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_i2); + +void +smaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_i2 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc0_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array); +export_proto(maxloc0_16_i4); + +void +maxloc0_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_4 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_16_i4); + +void +mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_INTEGER_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_4 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_i4); + +void +smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_i4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc0_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array); +export_proto(maxloc0_16_i8); + +void +maxloc0_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_8 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_16_i8); + +void +mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_INTEGER_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_8 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_i8); + +void +smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_i8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc0_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array); +export_proto(maxloc0_16_r10); + +void +maxloc0_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_10 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_10_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_10_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_16_r10); + +void +mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_REAL_10 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_10 maxval; + int fast = 0; + +#if defined(GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_10_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_r10); + +void +smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_r10 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc0_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array); +export_proto(maxloc0_16_r16); + +void +maxloc0_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_16 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_16_r16); + +void +mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_REAL_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_16 maxval; + int fast = 0; + +#if defined(GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_r16); + +void +smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_r16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array); +export_proto(maxloc0_16_r4); + +void +maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_4 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_16_r4); + +void +mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_REAL_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_4 maxval; + int fast = 0; + +#if defined(GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_r4); + +void +smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_r4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc0_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array); +export_proto(maxloc0_16_r8); + +void +maxloc0_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_8 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_16_r8); + +void +mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_REAL_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_8 maxval; + int fast = 0; + +#if defined(GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_16_r8); + +void +smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + maxloc0_16_r8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc0_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array); +export_proto(maxloc0_4_i1); + +void +maxloc0_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_1 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_1 maxval; +#if defined(GFC_INTEGER_1_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_1_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_4_i1 (gfc_array_i4 * const restrict, + gfc_array_i1 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_4_i1); + +void +mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_INTEGER_1 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_1 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_1_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_4_i1 (gfc_array_i4 * const restrict, + gfc_array_i1 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_i1); + +void +smaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_i1 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array); +export_proto(maxloc0_4_i16); + +void +maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_16 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_4_i16); + +void +mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_INTEGER_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_16 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_i16); + +void +smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_i16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc0_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array); +export_proto(maxloc0_4_i2); + +void +maxloc0_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_2 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_2 maxval; +#if defined(GFC_INTEGER_2_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_2_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_4_i2 (gfc_array_i4 * const restrict, + gfc_array_i2 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_4_i2); + +void +mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_INTEGER_2 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_2 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_2_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_4_i2 (gfc_array_i4 * const restrict, + gfc_array_i2 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_i2); + +void +smaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_i2 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc0_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array); +export_proto(maxloc0_4_i4); + +void +maxloc0_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_4 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_4_i4); + +void +mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_INTEGER_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_4 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_i4); + +void +smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_i4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array); +export_proto(maxloc0_4_i8); + +void +maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_8 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_4_i8); + +void +mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_INTEGER_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_8 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_i8); + +void +smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_i8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array); +export_proto(maxloc0_4_r10); + +void +maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_10 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_10_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_10_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_4_r10); + +void +mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_REAL_10 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_10 maxval; + int fast = 0; + +#if defined(GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_10_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_r10); + +void +smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_r10 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array); +export_proto(maxloc0_4_r16); + +void +maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_16 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_4_r16); + +void +mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_REAL_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_16 maxval; + int fast = 0; + +#if defined(GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_r16); + +void +smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_r16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc0_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array); +export_proto(maxloc0_4_r4); + +void +maxloc0_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_4 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_4_r4); + +void +mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_REAL_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_4 maxval; + int fast = 0; + +#if defined(GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_r4); + +void +smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_r4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc0_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array); +export_proto(maxloc0_4_r8); + +void +maxloc0_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_8 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_4_r8); + +void +mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_REAL_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_8 maxval; + int fast = 0; + +#if defined(GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_4_r8); + +void +smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + maxloc0_4_r8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc0_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array); +export_proto(maxloc0_8_i1); + +void +maxloc0_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_1 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_1 maxval; +#if defined(GFC_INTEGER_1_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_1_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_8_i1 (gfc_array_i8 * const restrict, + gfc_array_i1 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_8_i1); + +void +mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_INTEGER_1 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_1 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_1_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_8_i1 (gfc_array_i8 * const restrict, + gfc_array_i1 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_i1); + +void +smaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_i1 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc0_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array); +export_proto(maxloc0_8_i16); + +void +maxloc0_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_16 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_8_i16); + +void +mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_INTEGER_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_16 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_i16); + +void +smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_i16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc0_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array); +export_proto(maxloc0_8_i2); + +void +maxloc0_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_2 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_2 maxval; +#if defined(GFC_INTEGER_2_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_2_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_8_i2 (gfc_array_i8 * const restrict, + gfc_array_i2 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_8_i2); + +void +mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_INTEGER_2 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_2 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_2_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_8_i2 (gfc_array_i8 * const restrict, + gfc_array_i2 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_i2); + +void +smaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_i2 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc0_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array); +export_proto(maxloc0_8_i4); + +void +maxloc0_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_4 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_8_i4); + +void +mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_INTEGER_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_4 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_i4); + +void +smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_i4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc0_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array); +export_proto(maxloc0_8_i8); + +void +maxloc0_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_8 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_8_i8); + +void +mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_INTEGER_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_8 maxval; + int fast = 0; + +#if defined(GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_i8); + +void +smaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_i8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array); +export_proto(maxloc0_8_r10); + +void +maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_10 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_10_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_10_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_8_r10); + +void +mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_REAL_10 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_10 maxval; + int fast = 0; + +#if defined(GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_10_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_r10); + +void +smaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_r10 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc0_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array); +export_proto(maxloc0_8_r16); + +void +maxloc0_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_16 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_8_r16); + +void +mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_REAL_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_16 maxval; + int fast = 0; + +#if defined(GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_r16); + +void +smaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_r16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc0_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array); +export_proto(maxloc0_8_r4); + +void +maxloc0_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_4 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_8_r4); + +void +mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_REAL_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_4 maxval; + int fast = 0; + +#if defined(GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_r4); + +void +smaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_r4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc0_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array); +export_proto(maxloc0_8_r8); + +void +maxloc0_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_8 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mmaxloc0_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mmaxloc0_8_r8); + +void +mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_REAL_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_8 maxval; + int fast = 0; + +#if defined(GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void smaxloc0_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, GFC_LOGICAL_4 *); +export_proto(smaxloc0_8_r8); + +void +smaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + maxloc0_8_r8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc1_16_i1 (gfc_array_i16 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(maxloc1_16_i1); + +void +maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_1 maxval; +#if defined (GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_16_i1 (gfc_array_i16 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_16_i1); + +void +mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_1 maxval; +#if defined (GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif +#if defined (GFC_INTEGER_1_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_16_i1 (gfc_array_i16 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_i1); + +void +smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_16_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_16_i16.c b/libgfortran/generated/maxloc1_16_i16.c new file mode 100644 index 000000000..d6819aa71 --- /dev/null +++ b/libgfortran/generated/maxloc1_16_i16.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc1_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(maxloc1_16_i16); + +void +maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_16 maxval; +#if defined (GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_16_i16); + +void +mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 maxval; +#if defined (GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif +#if defined (GFC_INTEGER_16_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_i16); + +void +smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_16_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_16_i2.c b/libgfortran/generated/maxloc1_16_i2.c new file mode 100644 index 000000000..691d03486 --- /dev/null +++ b/libgfortran/generated/maxloc1_16_i2.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc1_16_i2 (gfc_array_i16 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(maxloc1_16_i2); + +void +maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_2 maxval; +#if defined (GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_16_i2 (gfc_array_i16 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_16_i2); + +void +mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_2 maxval; +#if defined (GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif +#if defined (GFC_INTEGER_2_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_16_i2 (gfc_array_i16 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_i2); + +void +smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_16_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_16_i4.c b/libgfortran/generated/maxloc1_16_i4.c new file mode 100644 index 000000000..1e5b87cab --- /dev/null +++ b/libgfortran/generated/maxloc1_16_i4.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc1_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(maxloc1_16_i4); + +void +maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_4 maxval; +#if defined (GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_16_i4); + +void +mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 maxval; +#if defined (GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif +#if defined (GFC_INTEGER_4_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_i4); + +void +smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_16_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_16_i8.c b/libgfortran/generated/maxloc1_16_i8.c new file mode 100644 index 000000000..c6a73d833 --- /dev/null +++ b/libgfortran/generated/maxloc1_16_i8.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc1_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(maxloc1_16_i8); + +void +maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_8 maxval; +#if defined (GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_16_i8); + +void +mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 maxval; +#if defined (GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif +#if defined (GFC_INTEGER_8_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_i8); + +void +smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_16_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_16_r10.c b/libgfortran/generated/maxloc1_16_r10.c new file mode 100644 index 000000000..d954000c8 --- /dev/null +++ b/libgfortran/generated/maxloc1_16_r10.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc1_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(maxloc1_16_r10); + +void +maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_10 maxval; +#if defined (GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_10_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_16_r10); + +void +mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 maxval; +#if defined (GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif +#if defined (GFC_REAL_10_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_10_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_REAL_10_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_r10); + +void +smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_16_r10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_16_r16.c b/libgfortran/generated/maxloc1_16_r16.c new file mode 100644 index 000000000..4ecb78418 --- /dev/null +++ b/libgfortran/generated/maxloc1_16_r16.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc1_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(maxloc1_16_r16); + +void +maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_16 maxval; +#if defined (GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_16_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_16_r16); + +void +mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_REAL_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 maxval; +#if defined (GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif +#if defined (GFC_REAL_16_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_REAL_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_r16); + +void +smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_16_r16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_16_r4.c b/libgfortran/generated/maxloc1_16_r4.c new file mode 100644 index 000000000..e5cd29156 --- /dev/null +++ b/libgfortran/generated/maxloc1_16_r4.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc1_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(maxloc1_16_r4); + +void +maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_4 maxval; +#if defined (GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_4_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_16_r4); + +void +mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_REAL_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 maxval; +#if defined (GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif +#if defined (GFC_REAL_4_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_REAL_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_r4); + +void +smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_16_r4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_16_r8.c b/libgfortran/generated/maxloc1_16_r8.c new file mode 100644 index 000000000..2d209d786 --- /dev/null +++ b/libgfortran/generated/maxloc1_16_r8.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxloc1_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(maxloc1_16_r8); + +void +maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_8 maxval; +#if defined (GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_8_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_16_r8); + +void +mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_REAL_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 maxval; +#if defined (GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif +#if defined (GFC_REAL_8_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_REAL_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_16_r8); + +void +smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_16_r8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_4_i1.c b/libgfortran/generated/maxloc1_4_i1.c new file mode 100644 index 000000000..efd695807 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_i1.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc1_4_i1 (gfc_array_i4 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(maxloc1_4_i1); + +void +maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_1 maxval; +#if defined (GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_4_i1 (gfc_array_i4 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_4_i1); + +void +mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_1 maxval; +#if defined (GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif +#if defined (GFC_INTEGER_1_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_4_i1 (gfc_array_i4 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_i1); + +void +smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_4_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_4_i16.c b/libgfortran/generated/maxloc1_4_i16.c new file mode 100644 index 000000000..71850fcf8 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_i16.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc1_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(maxloc1_4_i16); + +void +maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_16 maxval; +#if defined (GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_4_i16); + +void +mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 maxval; +#if defined (GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif +#if defined (GFC_INTEGER_16_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_i16); + +void +smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_4_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_4_i2.c b/libgfortran/generated/maxloc1_4_i2.c new file mode 100644 index 000000000..d825039e8 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_i2.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc1_4_i2 (gfc_array_i4 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(maxloc1_4_i2); + +void +maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_2 maxval; +#if defined (GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_4_i2 (gfc_array_i4 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_4_i2); + +void +mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_2 maxval; +#if defined (GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif +#if defined (GFC_INTEGER_2_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_4_i2 (gfc_array_i4 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_i2); + +void +smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_4_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_4_i4.c b/libgfortran/generated/maxloc1_4_i4.c new file mode 100644 index 000000000..f70b5aa10 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_i4.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc1_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(maxloc1_4_i4); + +void +maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_4 maxval; +#if defined (GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_4_i4); + +void +mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 maxval; +#if defined (GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif +#if defined (GFC_INTEGER_4_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_i4); + +void +smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_4_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_4_i8.c b/libgfortran/generated/maxloc1_4_i8.c new file mode 100644 index 000000000..cda4a99ca --- /dev/null +++ b/libgfortran/generated/maxloc1_4_i8.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc1_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(maxloc1_4_i8); + +void +maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_8 maxval; +#if defined (GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_4_i8); + +void +mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 maxval; +#if defined (GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif +#if defined (GFC_INTEGER_8_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_i8); + +void +smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_4_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_4_r10.c b/libgfortran/generated/maxloc1_4_r10.c new file mode 100644 index 000000000..7901a4b15 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_r10.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc1_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(maxloc1_4_r10); + +void +maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_10 maxval; +#if defined (GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_10_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_4_r10); + +void +mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 maxval; +#if defined (GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif +#if defined (GFC_REAL_10_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_10_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_REAL_10_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_r10); + +void +smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_4_r10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_4_r16.c b/libgfortran/generated/maxloc1_4_r16.c new file mode 100644 index 000000000..f06d7b2bb --- /dev/null +++ b/libgfortran/generated/maxloc1_4_r16.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc1_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(maxloc1_4_r16); + +void +maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_16 maxval; +#if defined (GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_16_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_4_r16); + +void +mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_REAL_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 maxval; +#if defined (GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif +#if defined (GFC_REAL_16_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_REAL_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_r16); + +void +smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_4_r16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_4_r4.c b/libgfortran/generated/maxloc1_4_r4.c new file mode 100644 index 000000000..e6837aa61 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_r4.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc1_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(maxloc1_4_r4); + +void +maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_4 maxval; +#if defined (GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_4_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_4_r4); + +void +mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_REAL_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 maxval; +#if defined (GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif +#if defined (GFC_REAL_4_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_REAL_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_r4); + +void +smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_4_r4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_4_r8.c b/libgfortran/generated/maxloc1_4_r8.c new file mode 100644 index 000000000..26c10c7b9 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_r8.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxloc1_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(maxloc1_4_r8); + +void +maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_8 maxval; +#if defined (GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_8_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_4_r8); + +void +mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_REAL_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 maxval; +#if defined (GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif +#if defined (GFC_REAL_8_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_REAL_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_4_r8); + +void +smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_4_r8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_8_i1.c b/libgfortran/generated/maxloc1_8_i1.c new file mode 100644 index 000000000..c9dc61020 --- /dev/null +++ b/libgfortran/generated/maxloc1_8_i1.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc1_8_i1 (gfc_array_i8 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(maxloc1_8_i1); + +void +maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_1 maxval; +#if defined (GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_8_i1 (gfc_array_i8 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_8_i1); + +void +mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_1 maxval; +#if defined (GFC_INTEGER_1_INFINITY) + maxval = -GFC_INTEGER_1_INFINITY; +#else + maxval = (-GFC_INTEGER_1_HUGE-1); +#endif +#if defined (GFC_INTEGER_1_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_8_i1 (gfc_array_i8 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_i1); + +void +smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_8_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_8_i16.c b/libgfortran/generated/maxloc1_8_i16.c new file mode 100644 index 000000000..7cd62ac3a --- /dev/null +++ b/libgfortran/generated/maxloc1_8_i16.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc1_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(maxloc1_8_i16); + +void +maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_16 maxval; +#if defined (GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_8_i16); + +void +mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 maxval; +#if defined (GFC_INTEGER_16_INFINITY) + maxval = -GFC_INTEGER_16_INFINITY; +#else + maxval = (-GFC_INTEGER_16_HUGE-1); +#endif +#if defined (GFC_INTEGER_16_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_i16); + +void +smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_8_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_8_i2.c b/libgfortran/generated/maxloc1_8_i2.c new file mode 100644 index 000000000..fd0cc2172 --- /dev/null +++ b/libgfortran/generated/maxloc1_8_i2.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc1_8_i2 (gfc_array_i8 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(maxloc1_8_i2); + +void +maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_2 maxval; +#if defined (GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_8_i2 (gfc_array_i8 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_8_i2); + +void +mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_2 maxval; +#if defined (GFC_INTEGER_2_INFINITY) + maxval = -GFC_INTEGER_2_INFINITY; +#else + maxval = (-GFC_INTEGER_2_HUGE-1); +#endif +#if defined (GFC_INTEGER_2_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_8_i2 (gfc_array_i8 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_i2); + +void +smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_8_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_8_i4.c b/libgfortran/generated/maxloc1_8_i4.c new file mode 100644 index 000000000..97cd54bb5 --- /dev/null +++ b/libgfortran/generated/maxloc1_8_i4.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc1_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(maxloc1_8_i4); + +void +maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_4 maxval; +#if defined (GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_8_i4); + +void +mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 maxval; +#if defined (GFC_INTEGER_4_INFINITY) + maxval = -GFC_INTEGER_4_INFINITY; +#else + maxval = (-GFC_INTEGER_4_HUGE-1); +#endif +#if defined (GFC_INTEGER_4_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_i4); + +void +smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_8_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_8_i8.c b/libgfortran/generated/maxloc1_8_i8.c new file mode 100644 index 000000000..f9c455cb0 --- /dev/null +++ b/libgfortran/generated/maxloc1_8_i8.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc1_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(maxloc1_8_i8); + +void +maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_8 maxval; +#if defined (GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_8_i8); + +void +mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 maxval; +#if defined (GFC_INTEGER_8_INFINITY) + maxval = -GFC_INTEGER_8_INFINITY; +#else + maxval = (-GFC_INTEGER_8_HUGE-1); +#endif +#if defined (GFC_INTEGER_8_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_i8); + +void +smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_8_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_8_r10.c b/libgfortran/generated/maxloc1_8_r10.c new file mode 100644 index 000000000..ab1173c6c --- /dev/null +++ b/libgfortran/generated/maxloc1_8_r10.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc1_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(maxloc1_8_r10); + +void +maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_10 maxval; +#if defined (GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_10_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_8_r10); + +void +mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 maxval; +#if defined (GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif +#if defined (GFC_REAL_10_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_10_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_REAL_10_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_r10); + +void +smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_8_r10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_8_r16.c b/libgfortran/generated/maxloc1_8_r16.c new file mode 100644 index 000000000..9a02e1273 --- /dev/null +++ b/libgfortran/generated/maxloc1_8_r16.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc1_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(maxloc1_8_r16); + +void +maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_16 maxval; +#if defined (GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_16_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_8_r16); + +void +mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_REAL_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 maxval; +#if defined (GFC_REAL_16_INFINITY) + maxval = -GFC_REAL_16_INFINITY; +#else + maxval = -GFC_REAL_16_HUGE; +#endif +#if defined (GFC_REAL_16_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_REAL_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_r16); + +void +smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_8_r16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_8_r4.c b/libgfortran/generated/maxloc1_8_r4.c new file mode 100644 index 000000000..584bdb81f --- /dev/null +++ b/libgfortran/generated/maxloc1_8_r4.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc1_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(maxloc1_8_r4); + +void +maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_4 maxval; +#if defined (GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_4_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_8_r4); + +void +mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_REAL_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 maxval; +#if defined (GFC_REAL_4_INFINITY) + maxval = -GFC_REAL_4_INFINITY; +#else + maxval = -GFC_REAL_4_HUGE; +#endif +#if defined (GFC_REAL_4_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_REAL_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_r4); + +void +smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_8_r4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxloc1_8_r8.c b/libgfortran/generated/maxloc1_8_r8.c new file mode 100644 index 000000000..c6f3efd70 --- /dev/null +++ b/libgfortran/generated/maxloc1_8_r8.c @@ -0,0 +1,563 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxloc1_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(maxloc1_8_r8); + +void +maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_8 maxval; +#if defined (GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_8_QUIET_NAN) + if (*src >= maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxloc1_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxloc1_8_r8); + +void +mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_REAL_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 maxval; +#if defined (GFC_REAL_8_INFINITY) + maxval = -GFC_REAL_8_INFINITY; +#else + maxval = -GFC_REAL_8_HUGE; +#endif +#if defined (GFC_REAL_8_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_REAL_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxloc1_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxloc1_8_r8); + +void +smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxloc1_8_r8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxval_i1.c b/libgfortran/generated/maxval_i1.c new file mode 100644 index 000000000..5b676827d --- /dev/null +++ b/libgfortran/generated/maxval_i1.c @@ -0,0 +1,550 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1) + + +extern void maxval_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(maxval_i1); + +void +maxval_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_1 result; + src = base; + { + +#if defined (GFC_INTEGER_1_INFINITY) + result = -GFC_INTEGER_1_INFINITY; +#else + result = (-GFC_INTEGER_1_HUGE-1); +#endif + if (len <= 0) + *dest = (-GFC_INTEGER_1_HUGE-1); + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (*src >= result) + break; + } + if (unlikely (n >= len)) + result = GFC_INTEGER_1_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxval_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxval_i1); + +void +mmaxval_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_1 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_INTEGER_1_INFINITY) + result = -GFC_INTEGER_1_INFINITY; +#else + result = (-GFC_INTEGER_1_HUGE-1); +#endif +#if defined (GFC_INTEGER_1_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = (-GFC_INTEGER_1_HUGE-1); + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_INTEGER_1_INFINITY) || defined (GFC_INTEGER_1_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_INTEGER_1_QUIET_NAN) + non_empty_p = 1; + if (*src >= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_INTEGER_1_QUIET_NAN) + result = non_empty_p ? GFC_INTEGER_1_QUIET_NAN : (-GFC_INTEGER_1_HUGE-1); +#else + result = (-GFC_INTEGER_1_HUGE-1); +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxval_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_i1); + +void +smaxval_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxval_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = (-GFC_INTEGER_1_HUGE-1); + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxval_i16.c b/libgfortran/generated/maxval_i16.c new file mode 100644 index 000000000..148319d62 --- /dev/null +++ b/libgfortran/generated/maxval_i16.c @@ -0,0 +1,550 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void maxval_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(maxval_i16); + +void +maxval_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + +#if defined (GFC_INTEGER_16_INFINITY) + result = -GFC_INTEGER_16_INFINITY; +#else + result = (-GFC_INTEGER_16_HUGE-1); +#endif + if (len <= 0) + *dest = (-GFC_INTEGER_16_HUGE-1); + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (*src >= result) + break; + } + if (unlikely (n >= len)) + result = GFC_INTEGER_16_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxval_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxval_i16); + +void +mmaxval_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_INTEGER_16_INFINITY) + result = -GFC_INTEGER_16_INFINITY; +#else + result = (-GFC_INTEGER_16_HUGE-1); +#endif +#if defined (GFC_INTEGER_16_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = (-GFC_INTEGER_16_HUGE-1); + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_INTEGER_16_INFINITY) || defined (GFC_INTEGER_16_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_INTEGER_16_QUIET_NAN) + non_empty_p = 1; + if (*src >= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_INTEGER_16_QUIET_NAN) + result = non_empty_p ? GFC_INTEGER_16_QUIET_NAN : (-GFC_INTEGER_16_HUGE-1); +#else + result = (-GFC_INTEGER_16_HUGE-1); +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxval_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_i16); + +void +smaxval_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxval_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = (-GFC_INTEGER_16_HUGE-1); + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxval_i2.c b/libgfortran/generated/maxval_i2.c new file mode 100644 index 000000000..f87f3edf3 --- /dev/null +++ b/libgfortran/generated/maxval_i2.c @@ -0,0 +1,550 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2) + + +extern void maxval_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(maxval_i2); + +void +maxval_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_2 result; + src = base; + { + +#if defined (GFC_INTEGER_2_INFINITY) + result = -GFC_INTEGER_2_INFINITY; +#else + result = (-GFC_INTEGER_2_HUGE-1); +#endif + if (len <= 0) + *dest = (-GFC_INTEGER_2_HUGE-1); + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (*src >= result) + break; + } + if (unlikely (n >= len)) + result = GFC_INTEGER_2_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxval_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxval_i2); + +void +mmaxval_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_2 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_INTEGER_2_INFINITY) + result = -GFC_INTEGER_2_INFINITY; +#else + result = (-GFC_INTEGER_2_HUGE-1); +#endif +#if defined (GFC_INTEGER_2_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = (-GFC_INTEGER_2_HUGE-1); + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_INTEGER_2_INFINITY) || defined (GFC_INTEGER_2_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_INTEGER_2_QUIET_NAN) + non_empty_p = 1; + if (*src >= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_INTEGER_2_QUIET_NAN) + result = non_empty_p ? GFC_INTEGER_2_QUIET_NAN : (-GFC_INTEGER_2_HUGE-1); +#else + result = (-GFC_INTEGER_2_HUGE-1); +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxval_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_i2); + +void +smaxval_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxval_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = (-GFC_INTEGER_2_HUGE-1); + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxval_i4.c b/libgfortran/generated/maxval_i4.c new file mode 100644 index 000000000..51f2511b4 --- /dev/null +++ b/libgfortran/generated/maxval_i4.c @@ -0,0 +1,550 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void maxval_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(maxval_i4); + +void +maxval_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + +#if defined (GFC_INTEGER_4_INFINITY) + result = -GFC_INTEGER_4_INFINITY; +#else + result = (-GFC_INTEGER_4_HUGE-1); +#endif + if (len <= 0) + *dest = (-GFC_INTEGER_4_HUGE-1); + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (*src >= result) + break; + } + if (unlikely (n >= len)) + result = GFC_INTEGER_4_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxval_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxval_i4); + +void +mmaxval_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_INTEGER_4_INFINITY) + result = -GFC_INTEGER_4_INFINITY; +#else + result = (-GFC_INTEGER_4_HUGE-1); +#endif +#if defined (GFC_INTEGER_4_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = (-GFC_INTEGER_4_HUGE-1); + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_INTEGER_4_INFINITY) || defined (GFC_INTEGER_4_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_INTEGER_4_QUIET_NAN) + non_empty_p = 1; + if (*src >= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_INTEGER_4_QUIET_NAN) + result = non_empty_p ? GFC_INTEGER_4_QUIET_NAN : (-GFC_INTEGER_4_HUGE-1); +#else + result = (-GFC_INTEGER_4_HUGE-1); +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxval_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_i4); + +void +smaxval_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxval_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = (-GFC_INTEGER_4_HUGE-1); + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxval_i8.c b/libgfortran/generated/maxval_i8.c new file mode 100644 index 000000000..74aca03cf --- /dev/null +++ b/libgfortran/generated/maxval_i8.c @@ -0,0 +1,550 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void maxval_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(maxval_i8); + +void +maxval_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + +#if defined (GFC_INTEGER_8_INFINITY) + result = -GFC_INTEGER_8_INFINITY; +#else + result = (-GFC_INTEGER_8_HUGE-1); +#endif + if (len <= 0) + *dest = (-GFC_INTEGER_8_HUGE-1); + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (*src >= result) + break; + } + if (unlikely (n >= len)) + result = GFC_INTEGER_8_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxval_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxval_i8); + +void +mmaxval_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_INTEGER_8_INFINITY) + result = -GFC_INTEGER_8_INFINITY; +#else + result = (-GFC_INTEGER_8_HUGE-1); +#endif +#if defined (GFC_INTEGER_8_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = (-GFC_INTEGER_8_HUGE-1); + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_INTEGER_8_INFINITY) || defined (GFC_INTEGER_8_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_INTEGER_8_QUIET_NAN) + non_empty_p = 1; + if (*src >= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_INTEGER_8_QUIET_NAN) + result = non_empty_p ? GFC_INTEGER_8_QUIET_NAN : (-GFC_INTEGER_8_HUGE-1); +#else + result = (-GFC_INTEGER_8_HUGE-1); +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxval_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_i8); + +void +smaxval_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxval_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = (-GFC_INTEGER_8_HUGE-1); + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxval_r10.c b/libgfortran/generated/maxval_r10.c new file mode 100644 index 000000000..3eaaa4c47 --- /dev/null +++ b/libgfortran/generated/maxval_r10.c @@ -0,0 +1,550 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10) + + +extern void maxval_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(maxval_r10); + +void +maxval_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_REAL_10 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + GFC_REAL_10 result; + src = base; + { + +#if defined (GFC_REAL_10_INFINITY) + result = -GFC_REAL_10_INFINITY; +#else + result = -GFC_REAL_10_HUGE; +#endif + if (len <= 0) + *dest = -GFC_REAL_10_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_10_QUIET_NAN) + if (*src >= result) + break; + } + if (unlikely (n >= len)) + result = GFC_REAL_10_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxval_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxval_r10); + +void +mmaxval_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 * restrict dest; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_10 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_REAL_10_INFINITY) + result = -GFC_REAL_10_INFINITY; +#else + result = -GFC_REAL_10_HUGE; +#endif +#if defined (GFC_REAL_10_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = -GFC_REAL_10_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_REAL_10_INFINITY) || defined (GFC_REAL_10_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_REAL_10_QUIET_NAN) + non_empty_p = 1; + if (*src >= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_REAL_10_QUIET_NAN) + result = non_empty_p ? GFC_REAL_10_QUIET_NAN : -GFC_REAL_10_HUGE; +#else + result = -GFC_REAL_10_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxval_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_r10); + +void +smaxval_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxval_r10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = -GFC_REAL_10_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxval_r16.c b/libgfortran/generated/maxval_r16.c new file mode 100644 index 000000000..bc4cf27bb --- /dev/null +++ b/libgfortran/generated/maxval_r16.c @@ -0,0 +1,550 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16) + + +extern void maxval_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(maxval_r16); + +void +maxval_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_REAL_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict src; + GFC_REAL_16 result; + src = base; + { + +#if defined (GFC_REAL_16_INFINITY) + result = -GFC_REAL_16_INFINITY; +#else + result = -GFC_REAL_16_HUGE; +#endif + if (len <= 0) + *dest = -GFC_REAL_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_16_QUIET_NAN) + if (*src >= result) + break; + } + if (unlikely (n >= len)) + result = GFC_REAL_16_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxval_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxval_r16); + +void +mmaxval_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 * restrict dest; + const GFC_REAL_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_16 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_REAL_16_INFINITY) + result = -GFC_REAL_16_INFINITY; +#else + result = -GFC_REAL_16_HUGE; +#endif +#if defined (GFC_REAL_16_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = -GFC_REAL_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_REAL_16_INFINITY) || defined (GFC_REAL_16_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_REAL_16_QUIET_NAN) + non_empty_p = 1; + if (*src >= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_REAL_16_QUIET_NAN) + result = non_empty_p ? GFC_REAL_16_QUIET_NAN : -GFC_REAL_16_HUGE; +#else + result = -GFC_REAL_16_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxval_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_r16); + +void +smaxval_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxval_r16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = -GFC_REAL_16_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxval_r4.c b/libgfortran/generated/maxval_r4.c new file mode 100644 index 000000000..d7e25ee7a --- /dev/null +++ b/libgfortran/generated/maxval_r4.c @@ -0,0 +1,550 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4) + + +extern void maxval_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(maxval_r4); + +void +maxval_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_REAL_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_REAL_4 result; + src = base; + { + +#if defined (GFC_REAL_4_INFINITY) + result = -GFC_REAL_4_INFINITY; +#else + result = -GFC_REAL_4_HUGE; +#endif + if (len <= 0) + *dest = -GFC_REAL_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_4_QUIET_NAN) + if (*src >= result) + break; + } + if (unlikely (n >= len)) + result = GFC_REAL_4_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxval_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxval_r4); + +void +mmaxval_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_4 * restrict dest; + const GFC_REAL_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_4 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_REAL_4_INFINITY) + result = -GFC_REAL_4_INFINITY; +#else + result = -GFC_REAL_4_HUGE; +#endif +#if defined (GFC_REAL_4_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = -GFC_REAL_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_REAL_4_INFINITY) || defined (GFC_REAL_4_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_REAL_4_QUIET_NAN) + non_empty_p = 1; + if (*src >= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_REAL_4_QUIET_NAN) + result = non_empty_p ? GFC_REAL_4_QUIET_NAN : -GFC_REAL_4_HUGE; +#else + result = -GFC_REAL_4_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxval_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_r4); + +void +smaxval_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxval_r4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = -GFC_REAL_4_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/maxval_r8.c b/libgfortran/generated/maxval_r8.c new file mode 100644 index 000000000..21c08e9ef --- /dev/null +++ b/libgfortran/generated/maxval_r8.c @@ -0,0 +1,550 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8) + + +extern void maxval_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(maxval_r8); + +void +maxval_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_REAL_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_REAL_8 result; + src = base; + { + +#if defined (GFC_REAL_8_INFINITY) + result = -GFC_REAL_8_INFINITY; +#else + result = -GFC_REAL_8_HUGE; +#endif + if (len <= 0) + *dest = -GFC_REAL_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_8_QUIET_NAN) + if (*src >= result) + break; + } + if (unlikely (n >= len)) + result = GFC_REAL_8_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mmaxval_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mmaxval_r8); + +void +mmaxval_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_8 * restrict dest; + const GFC_REAL_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_8 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_REAL_8_INFINITY) + result = -GFC_REAL_8_INFINITY; +#else + result = -GFC_REAL_8_HUGE; +#endif +#if defined (GFC_REAL_8_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = -GFC_REAL_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_REAL_8_INFINITY) || defined (GFC_REAL_8_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_REAL_8_QUIET_NAN) + non_empty_p = 1; + if (*src >= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_REAL_8_QUIET_NAN) + result = non_empty_p ? GFC_REAL_8_QUIET_NAN : -GFC_REAL_8_HUGE; +#else + result = -GFC_REAL_8_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void smaxval_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(smaxval_r8); + +void +smaxval_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + maxval_r8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = -GFC_REAL_8_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc0_16_i1.c b/libgfortran/generated/minloc0_16_i1.c new file mode 100644 index 000000000..2fbd7609d --- /dev/null +++ b/libgfortran/generated/minloc0_16_i1.c @@ -0,0 +1,383 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc0_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array); +export_proto(minloc0_16_i1); + +void +minloc0_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_1 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_1 minval; +#if defined(GFC_INTEGER_1_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_1_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_16_i1 (gfc_array_i16 * const restrict, + gfc_array_i1 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_16_i1); + +void +mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_INTEGER_1 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_1 minval; + int fast = 0; + +#if defined(GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_1_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_16_i1 (gfc_array_i16 * const restrict, + gfc_array_i1 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_16_i1); + +void +sminloc0_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc0_16_i1 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc0_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array); +export_proto(minloc0_16_i16); + +void +minloc0_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_16 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_16_i16); + +void +mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_INTEGER_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_16 minval; + int fast = 0; + +#if defined(GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_16_i16); + +void +sminloc0_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc0_16_i16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc0_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array); +export_proto(minloc0_16_i2); + +void +minloc0_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_2 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_2 minval; +#if defined(GFC_INTEGER_2_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_2_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_16_i2 (gfc_array_i16 * const restrict, + gfc_array_i2 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_16_i2); + +void +mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_INTEGER_2 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_2 minval; + int fast = 0; + +#if defined(GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_2_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_16_i2 (gfc_array_i16 * const restrict, + gfc_array_i2 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_16_i2); + +void +sminloc0_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc0_16_i2 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc0_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array); +export_proto(minloc0_16_i4); + +void +minloc0_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_4 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_16_i4); + +void +mminloc0_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_INTEGER_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_4 minval; + int fast = 0; + +#if defined(GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_16_i4); + +void +sminloc0_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc0_16_i4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc0_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array); +export_proto(minloc0_16_i8); + +void +minloc0_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_8 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_16_i8); + +void +mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_INTEGER_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_8 minval; + int fast = 0; + +#if defined(GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_16_i8); + +void +sminloc0_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc0_16_i8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc0_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array); +export_proto(minloc0_16_r10); + +void +minloc0_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_10 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_10_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_10_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_16_r10); + +void +mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_REAL_10 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_10 minval; + int fast = 0; + +#if defined(GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_10_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_16_r10); + +void +sminloc0_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc0_16_r10 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc0_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array); +export_proto(minloc0_16_r16); + +void +minloc0_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_16 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_16_r16); + +void +mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_REAL_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_16 minval; + int fast = 0; + +#if defined(GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_16_r16); + +void +sminloc0_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc0_16_r16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc0_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array); +export_proto(minloc0_16_r4); + +void +minloc0_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_4 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_16_r4); + +void +mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_REAL_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_4 minval; + int fast = 0; + +#if defined(GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_16_r4); + +void +sminloc0_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc0_16_r4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc0_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array); +export_proto(minloc0_16_r8); + +void +minloc0_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_8 *base; + GFC_INTEGER_16 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_16_r8); + +void +mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_16 *dest; + const GFC_REAL_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_8 minval; + int fast = 0; + +#if defined(GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_16_r8); + +void +sminloc0_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_16 *dest; + + if (*mask) + { + minloc0_16_r8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc0_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array); +export_proto(minloc0_4_i1); + +void +minloc0_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_1 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_1 minval; +#if defined(GFC_INTEGER_1_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_1_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_4_i1 (gfc_array_i4 * const restrict, + gfc_array_i1 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_4_i1); + +void +mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_INTEGER_1 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_1 minval; + int fast = 0; + +#if defined(GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_1_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_4_i1 (gfc_array_i4 * const restrict, + gfc_array_i1 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_4_i1); + +void +sminloc0_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc0_4_i1 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc0_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array); +export_proto(minloc0_4_i16); + +void +minloc0_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_16 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_4_i16); + +void +mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_INTEGER_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_16 minval; + int fast = 0; + +#if defined(GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_4_i16); + +void +sminloc0_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc0_4_i16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc0_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array); +export_proto(minloc0_4_i2); + +void +minloc0_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_2 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_2 minval; +#if defined(GFC_INTEGER_2_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_2_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_4_i2 (gfc_array_i4 * const restrict, + gfc_array_i2 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_4_i2); + +void +mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_INTEGER_2 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_2 minval; + int fast = 0; + +#if defined(GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_2_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_4_i2 (gfc_array_i4 * const restrict, + gfc_array_i2 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_4_i2); + +void +sminloc0_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc0_4_i2 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc0_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array); +export_proto(minloc0_4_i4); + +void +minloc0_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_4 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_4_i4); + +void +mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_INTEGER_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_4 minval; + int fast = 0; + +#if defined(GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_4_i4); + +void +sminloc0_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc0_4_i4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc0_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array); +export_proto(minloc0_4_i8); + +void +minloc0_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_8 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_4_i8); + +void +mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_INTEGER_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_8 minval; + int fast = 0; + +#if defined(GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_4_i8); + +void +sminloc0_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc0_4_i8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc0_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array); +export_proto(minloc0_4_r10); + +void +minloc0_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_10 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_10_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_10_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_4_r10); + +void +mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_REAL_10 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_10 minval; + int fast = 0; + +#if defined(GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_10_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_4_r10); + +void +sminloc0_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc0_4_r10 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc0_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array); +export_proto(minloc0_4_r16); + +void +minloc0_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_16 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_4_r16); + +void +mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_REAL_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_16 minval; + int fast = 0; + +#if defined(GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_4_r16); + +void +sminloc0_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc0_4_r16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc0_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array); +export_proto(minloc0_4_r4); + +void +minloc0_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_4 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_4_r4); + +void +mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_REAL_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_4 minval; + int fast = 0; + +#if defined(GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_4_r4); + +void +sminloc0_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc0_4_r4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc0_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array); +export_proto(minloc0_4_r8); + +void +minloc0_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_8 *base; + GFC_INTEGER_4 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_4_r8); + +void +mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + const GFC_REAL_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_8 minval; + int fast = 0; + +#if defined(GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_4_r8); + +void +sminloc0_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_4 *dest; + + if (*mask) + { + minloc0_4_r8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc0_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array); +export_proto(minloc0_8_i1); + +void +minloc0_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_1 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_1 minval; +#if defined(GFC_INTEGER_1_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_1_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_8_i1 (gfc_array_i8 * const restrict, + gfc_array_i1 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_8_i1); + +void +mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_INTEGER_1 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_1 minval; + int fast = 0; + +#if defined(GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_1_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_8_i1 (gfc_array_i8 * const restrict, + gfc_array_i1 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_8_i1); + +void +sminloc0_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc0_8_i1 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc0_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array); +export_proto(minloc0_8_i16); + +void +minloc0_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_16 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_8_i16); + +void +mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_INTEGER_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_16 minval; + int fast = 0; + +#if defined(GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_8_i16); + +void +sminloc0_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc0_8_i16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc0_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array); +export_proto(minloc0_8_i2); + +void +minloc0_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_2 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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_2 minval; +#if defined(GFC_INTEGER_2_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_2_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_8_i2 (gfc_array_i8 * const restrict, + gfc_array_i2 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_8_i2); + +void +mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_INTEGER_2 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_2 minval; + int fast = 0; + +#if defined(GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_2_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_8_i2 (gfc_array_i8 * const restrict, + gfc_array_i2 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_8_i2); + +void +sminloc0_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc0_8_i2 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc0_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array); +export_proto(minloc0_8_i4); + +void +minloc0_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_4 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_8_i4); + +void +mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_INTEGER_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_4 minval; + int fast = 0; + +#if defined(GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_8_i4); + +void +sminloc0_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc0_8_i4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc0_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array); +export_proto(minloc0_8_i8); + +void +minloc0_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_INTEGER_8 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_INTEGER_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_INTEGER_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_8_i8); + +void +mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_INTEGER_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_INTEGER_8 minval; + int fast = 0; + +#if defined(GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_INTEGER_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_8_i8); + +void +sminloc0_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc0_8_i8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc0_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array); +export_proto(minloc0_8_r10); + +void +minloc0_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_10 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_10_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_10_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_8_r10); + +void +mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_REAL_10 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_10 minval; + int fast = 0; + +#if defined(GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_10_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_8_r10); + +void +sminloc0_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc0_8_r10 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc0_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array); +export_proto(minloc0_8_r16); + +void +minloc0_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_16 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_16_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_16_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_8_r16); + +void +mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_REAL_16 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_16 minval; + int fast = 0; + +#if defined(GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_16_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_8_r16); + +void +sminloc0_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc0_8_r16 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc0_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array); +export_proto(minloc0_8_r4); + +void +minloc0_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_4 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_4_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_4_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_8_r4); + +void +mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_REAL_4 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_4 minval; + int fast = 0; + +#if defined(GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_4_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_8_r4); + +void +sminloc0_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc0_8_r4 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc0_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array); +export_proto(minloc0_8_r8); + +void +minloc0_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const GFC_REAL_8 *base; + GFC_INTEGER_8 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; +#if defined(GFC_REAL_8_QUIET_NAN) + int fast = 0; +#endif + +#if defined(GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + +#if defined(GFC_REAL_8_QUIET_NAN) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void mminloc0_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, gfc_array_l1 * const restrict); +export_proto(mminloc0_8_r8); + +void +mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + const GFC_REAL_8 *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 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 (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { + + GFC_REAL_8 minval; + int fast = 0; + +#if defined(GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif + while (base) + { + do + { + /* Implementation start. */ + + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined(GFC_REAL_8_QUIET_NAN) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + 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. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +} + + +extern void sminloc0_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, GFC_LOGICAL_4 *); +export_proto(sminloc0_8_r8); + +void +sminloc0_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + GFC_INTEGER_8 *dest; + + if (*mask) + { + minloc0_8_r8 (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 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 (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc1_16_i1 (gfc_array_i16 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(minloc1_16_i1); + +void +minloc1_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_1 minval; +#if defined (GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_16_i1 (gfc_array_i16 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_16_i1); + +void +mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_1 minval; +#if defined (GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif +#if defined (GFC_INTEGER_1_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_16_i1 (gfc_array_i16 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_i1); + +void +sminloc1_16_i1 (gfc_array_i16 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_16_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_16_i16.c b/libgfortran/generated/minloc1_16_i16.c new file mode 100644 index 000000000..3a18e8c36 --- /dev/null +++ b/libgfortran/generated/minloc1_16_i16.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc1_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(minloc1_16_i16); + +void +minloc1_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_16 minval; +#if defined (GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_16_i16); + +void +mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 minval; +#if defined (GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif +#if defined (GFC_INTEGER_16_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_16_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_i16); + +void +sminloc1_16_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_16_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_16_i2.c b/libgfortran/generated/minloc1_16_i2.c new file mode 100644 index 000000000..bc13bee9e --- /dev/null +++ b/libgfortran/generated/minloc1_16_i2.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc1_16_i2 (gfc_array_i16 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(minloc1_16_i2); + +void +minloc1_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_2 minval; +#if defined (GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_16_i2 (gfc_array_i16 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_16_i2); + +void +mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_2 minval; +#if defined (GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif +#if defined (GFC_INTEGER_2_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_16_i2 (gfc_array_i16 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_i2); + +void +sminloc1_16_i2 (gfc_array_i16 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_16_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_16_i4.c b/libgfortran/generated/minloc1_16_i4.c new file mode 100644 index 000000000..84d131a7a --- /dev/null +++ b/libgfortran/generated/minloc1_16_i4.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc1_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(minloc1_16_i4); + +void +minloc1_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_4 minval; +#if defined (GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_16_i4); + +void +mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 minval; +#if defined (GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif +#if defined (GFC_INTEGER_4_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_16_i4 (gfc_array_i16 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_i4); + +void +sminloc1_16_i4 (gfc_array_i16 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_16_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_16_i8.c b/libgfortran/generated/minloc1_16_i8.c new file mode 100644 index 000000000..1f3e0549d --- /dev/null +++ b/libgfortran/generated/minloc1_16_i8.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc1_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(minloc1_16_i8); + +void +minloc1_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_INTEGER_8 minval; +#if defined (GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_16_i8); + +void +mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 minval; +#if defined (GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif +#if defined (GFC_INTEGER_8_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_16_i8 (gfc_array_i16 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_i8); + +void +sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_16_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_16_r10.c b/libgfortran/generated/minloc1_16_r10.c new file mode 100644 index 000000000..6bda151ae --- /dev/null +++ b/libgfortran/generated/minloc1_16_r10.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc1_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(minloc1_16_r10); + +void +minloc1_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_10 minval; +#if defined (GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_10_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_16_r10); + +void +mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 minval; +#if defined (GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif +#if defined (GFC_REAL_10_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_10_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_REAL_10_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_16_r10 (gfc_array_i16 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_r10); + +void +sminloc1_16_r10 (gfc_array_i16 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_16_r10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_16_r16.c b/libgfortran/generated/minloc1_16_r16.c new file mode 100644 index 000000000..c31cf4bcb --- /dev/null +++ b/libgfortran/generated/minloc1_16_r16.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc1_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(minloc1_16_r16); + +void +minloc1_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_16 minval; +#if defined (GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_16_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_16_r16); + +void +mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_REAL_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 minval; +#if defined (GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif +#if defined (GFC_REAL_16_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_REAL_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_16_r16 (gfc_array_i16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_r16); + +void +sminloc1_16_r16 (gfc_array_i16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_16_r16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_16_r4.c b/libgfortran/generated/minloc1_16_r4.c new file mode 100644 index 000000000..52ec2b078 --- /dev/null +++ b/libgfortran/generated/minloc1_16_r4.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc1_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(minloc1_16_r4); + +void +minloc1_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_4 minval; +#if defined (GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_4_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_16_r4); + +void +mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_REAL_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 minval; +#if defined (GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif +#if defined (GFC_REAL_4_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_REAL_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_16_r4 (gfc_array_i16 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_r4); + +void +sminloc1_16_r4 (gfc_array_i16 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_16_r4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_16_r8.c b/libgfortran/generated/minloc1_16_r8.c new file mode 100644 index 000000000..a53ed3452 --- /dev/null +++ b/libgfortran/generated/minloc1_16_r8.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16) + + +extern void minloc1_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(minloc1_16_r8); + +void +minloc1_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + GFC_REAL_8 minval; +#if defined (GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_8_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_16_r8); + +void +mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_REAL_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 minval; +#if defined (GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif +#if defined (GFC_REAL_8_QUIET_NAN) + GFC_INTEGER_16 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_16)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_16)n + 1; + break; + } + } + } +#if defined (GFC_REAL_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_16_r8 (gfc_array_i16 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_16_r8); + +void +sminloc1_16_r8 (gfc_array_i16 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_16_r8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_4_i1.c b/libgfortran/generated/minloc1_4_i1.c new file mode 100644 index 000000000..e8af36127 --- /dev/null +++ b/libgfortran/generated/minloc1_4_i1.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc1_4_i1 (gfc_array_i4 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(minloc1_4_i1); + +void +minloc1_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_1 minval; +#if defined (GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_4_i1 (gfc_array_i4 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_4_i1); + +void +mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_1 minval; +#if defined (GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif +#if defined (GFC_INTEGER_1_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_4_i1 (gfc_array_i4 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_i1); + +void +sminloc1_4_i1 (gfc_array_i4 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_4_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_4_i16.c b/libgfortran/generated/minloc1_4_i16.c new file mode 100644 index 000000000..8d3da2059 --- /dev/null +++ b/libgfortran/generated/minloc1_4_i16.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc1_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(minloc1_4_i16); + +void +minloc1_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_16 minval; +#if defined (GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_4_i16); + +void +mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 minval; +#if defined (GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif +#if defined (GFC_INTEGER_16_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_4_i16 (gfc_array_i4 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_i16); + +void +sminloc1_4_i16 (gfc_array_i4 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_4_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_4_i2.c b/libgfortran/generated/minloc1_4_i2.c new file mode 100644 index 000000000..e7f24491f --- /dev/null +++ b/libgfortran/generated/minloc1_4_i2.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc1_4_i2 (gfc_array_i4 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(minloc1_4_i2); + +void +minloc1_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_2 minval; +#if defined (GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_4_i2 (gfc_array_i4 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_4_i2); + +void +mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_2 minval; +#if defined (GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif +#if defined (GFC_INTEGER_2_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_4_i2 (gfc_array_i4 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_i2); + +void +sminloc1_4_i2 (gfc_array_i4 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_4_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_4_i4.c b/libgfortran/generated/minloc1_4_i4.c new file mode 100644 index 000000000..94d45c92d --- /dev/null +++ b/libgfortran/generated/minloc1_4_i4.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc1_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(minloc1_4_i4); + +void +minloc1_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_4 minval; +#if defined (GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_4_i4); + +void +mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 minval; +#if defined (GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif +#if defined (GFC_INTEGER_4_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_4_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_i4); + +void +sminloc1_4_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_4_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_4_i8.c b/libgfortran/generated/minloc1_4_i8.c new file mode 100644 index 000000000..fa07bcb87 --- /dev/null +++ b/libgfortran/generated/minloc1_4_i8.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc1_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(minloc1_4_i8); + +void +minloc1_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_8 minval; +#if defined (GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_4_i8); + +void +mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 minval; +#if defined (GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif +#if defined (GFC_INTEGER_8_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_4_i8 (gfc_array_i4 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_i8); + +void +sminloc1_4_i8 (gfc_array_i4 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_4_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_4_r10.c b/libgfortran/generated/minloc1_4_r10.c new file mode 100644 index 000000000..5cb23a6b6 --- /dev/null +++ b/libgfortran/generated/minloc1_4_r10.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc1_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(minloc1_4_r10); + +void +minloc1_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_10 minval; +#if defined (GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_10_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_4_r10); + +void +mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 minval; +#if defined (GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif +#if defined (GFC_REAL_10_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_10_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_REAL_10_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_4_r10 (gfc_array_i4 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_r10); + +void +sminloc1_4_r10 (gfc_array_i4 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_4_r10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_4_r16.c b/libgfortran/generated/minloc1_4_r16.c new file mode 100644 index 000000000..40854a12b --- /dev/null +++ b/libgfortran/generated/minloc1_4_r16.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc1_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(minloc1_4_r16); + +void +minloc1_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_16 minval; +#if defined (GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_16_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_4_r16); + +void +mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_REAL_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 minval; +#if defined (GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif +#if defined (GFC_REAL_16_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_REAL_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_4_r16 (gfc_array_i4 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_r16); + +void +sminloc1_4_r16 (gfc_array_i4 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_4_r16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_4_r4.c b/libgfortran/generated/minloc1_4_r4.c new file mode 100644 index 000000000..4231d180d --- /dev/null +++ b/libgfortran/generated/minloc1_4_r4.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc1_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(minloc1_4_r4); + +void +minloc1_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_4 minval; +#if defined (GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_4_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_4_r4); + +void +mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_REAL_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 minval; +#if defined (GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif +#if defined (GFC_REAL_4_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_REAL_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_4_r4 (gfc_array_i4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_r4); + +void +sminloc1_4_r4 (gfc_array_i4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_4_r4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_4_r8.c b/libgfortran/generated/minloc1_4_r8.c new file mode 100644 index 000000000..8e5e5ddc4 --- /dev/null +++ b/libgfortran/generated/minloc1_4_r8.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4) + + +extern void minloc1_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(minloc1_4_r8); + +void +minloc1_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_8 minval; +#if defined (GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_8_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_4_r8); + +void +mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_REAL_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 minval; +#if defined (GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif +#if defined (GFC_REAL_8_QUIET_NAN) + GFC_INTEGER_4 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_4)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + break; + } + } + } +#if defined (GFC_REAL_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_4_r8 (gfc_array_i4 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_4_r8); + +void +sminloc1_4_r8 (gfc_array_i4 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_4_r8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_8_i1.c b/libgfortran/generated/minloc1_8_i1.c new file mode 100644 index 000000000..9a54335c8 --- /dev/null +++ b/libgfortran/generated/minloc1_8_i1.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc1_8_i1 (gfc_array_i8 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(minloc1_8_i1); + +void +minloc1_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_1 minval; +#if defined (GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_8_i1 (gfc_array_i8 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_8_i1); + +void +mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_1 minval; +#if defined (GFC_INTEGER_1_INFINITY) + minval = GFC_INTEGER_1_INFINITY; +#else + minval = GFC_INTEGER_1_HUGE; +#endif +#if defined (GFC_INTEGER_1_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_8_i1 (gfc_array_i8 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_i1); + +void +sminloc1_8_i1 (gfc_array_i8 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_8_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_8_i16.c b/libgfortran/generated/minloc1_8_i16.c new file mode 100644 index 000000000..f0b477ebd --- /dev/null +++ b/libgfortran/generated/minloc1_8_i16.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc1_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(minloc1_8_i16); + +void +minloc1_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_16 minval; +#if defined (GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_8_i16); + +void +mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_16 minval; +#if defined (GFC_INTEGER_16_INFINITY) + minval = GFC_INTEGER_16_INFINITY; +#else + minval = GFC_INTEGER_16_HUGE; +#endif +#if defined (GFC_INTEGER_16_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_8_i16 (gfc_array_i8 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_i16); + +void +sminloc1_8_i16 (gfc_array_i8 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_8_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_8_i2.c b/libgfortran/generated/minloc1_8_i2.c new file mode 100644 index 000000000..9d3d14ee5 --- /dev/null +++ b/libgfortran/generated/minloc1_8_i2.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc1_8_i2 (gfc_array_i8 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(minloc1_8_i2); + +void +minloc1_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_2 minval; +#if defined (GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_8_i2 (gfc_array_i8 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_8_i2); + +void +mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_2 minval; +#if defined (GFC_INTEGER_2_INFINITY) + minval = GFC_INTEGER_2_INFINITY; +#else + minval = GFC_INTEGER_2_HUGE; +#endif +#if defined (GFC_INTEGER_2_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_8_i2 (gfc_array_i8 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_i2); + +void +sminloc1_8_i2 (gfc_array_i8 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_8_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_8_i4.c b/libgfortran/generated/minloc1_8_i4.c new file mode 100644 index 000000000..edac05ccd --- /dev/null +++ b/libgfortran/generated/minloc1_8_i4.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc1_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(minloc1_8_i4); + +void +minloc1_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_4 minval; +#if defined (GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_8_i4); + +void +mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 minval; +#if defined (GFC_INTEGER_4_INFINITY) + minval = GFC_INTEGER_4_INFINITY; +#else + minval = GFC_INTEGER_4_HUGE; +#endif +#if defined (GFC_INTEGER_4_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_8_i4 (gfc_array_i8 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_i4); + +void +sminloc1_8_i4 (gfc_array_i8 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_8_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_8_i8.c b/libgfortran/generated/minloc1_8_i8.c new file mode 100644 index 000000000..3c0f44127 --- /dev/null +++ b/libgfortran/generated/minloc1_8_i8.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc1_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(minloc1_8_i8); + +void +minloc1_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_8 minval; +#if defined (GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_8_i8); + +void +mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 minval; +#if defined (GFC_INTEGER_8_INFINITY) + minval = GFC_INTEGER_8_INFINITY; +#else + minval = GFC_INTEGER_8_HUGE; +#endif +#if defined (GFC_INTEGER_8_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_8_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_i8); + +void +sminloc1_8_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_8_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_8_r10.c b/libgfortran/generated/minloc1_8_r10.c new file mode 100644 index 000000000..a9239d28c --- /dev/null +++ b/libgfortran/generated/minloc1_8_r10.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc1_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(minloc1_8_r10); + +void +minloc1_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_10 minval; +#if defined (GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_10_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_8_r10); + +void +mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_10 minval; +#if defined (GFC_REAL_10_INFINITY) + minval = GFC_REAL_10_INFINITY; +#else + minval = GFC_REAL_10_HUGE; +#endif +#if defined (GFC_REAL_10_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_10_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_REAL_10_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_8_r10 (gfc_array_i8 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_r10); + +void +sminloc1_8_r10 (gfc_array_i8 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_8_r10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_8_r16.c b/libgfortran/generated/minloc1_8_r16.c new file mode 100644 index 000000000..953ada7ef --- /dev/null +++ b/libgfortran/generated/minloc1_8_r16.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc1_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(minloc1_8_r16); + +void +minloc1_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_16 minval; +#if defined (GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_16_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_8_r16); + +void +mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_REAL_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_16 minval; +#if defined (GFC_REAL_16_INFINITY) + minval = GFC_REAL_16_INFINITY; +#else + minval = GFC_REAL_16_HUGE; +#endif +#if defined (GFC_REAL_16_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_16_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_REAL_16_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_8_r16 (gfc_array_i8 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_r16); + +void +sminloc1_8_r16 (gfc_array_i8 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_8_r16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_8_r4.c b/libgfortran/generated/minloc1_8_r4.c new file mode 100644 index 000000000..388200016 --- /dev/null +++ b/libgfortran/generated/minloc1_8_r4.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc1_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(minloc1_8_r4); + +void +minloc1_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_4 minval; +#if defined (GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_4_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_8_r4); + +void +mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_REAL_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 minval; +#if defined (GFC_REAL_4_INFINITY) + minval = GFC_REAL_4_INFINITY; +#else + minval = GFC_REAL_4_HUGE; +#endif +#if defined (GFC_REAL_4_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_4_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_REAL_4_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_8_r4 (gfc_array_i8 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_r4); + +void +sminloc1_8_r4 (gfc_array_i8 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_8_r4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minloc1_8_r8.c b/libgfortran/generated/minloc1_8_r8.c new file mode 100644 index 000000000..c8d181277 --- /dev/null +++ b/libgfortran/generated/minloc1_8_r8.c @@ -0,0 +1,563 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void minloc1_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(minloc1_8_r8); + +void +minloc1_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_8 minval; +#if defined (GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_8_QUIET_NAN) + if (*src <= minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminloc1_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminloc1_8_r8); + +void +mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_REAL_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 minval; +#if defined (GFC_REAL_8_INFINITY) + minval = GFC_REAL_8_INFINITY; +#else + minval = GFC_REAL_8_HUGE; +#endif +#if defined (GFC_REAL_8_QUIET_NAN) + GFC_INTEGER_8 result2 = 0; +#endif + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + { +#if defined (GFC_REAL_8_QUIET_NAN) + if (!result2) + result2 = (GFC_INTEGER_8)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + break; + } + } + } +#if defined (GFC_REAL_8_QUIET_NAN) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminloc1_8_r8 (gfc_array_i8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminloc1_8_r8); + +void +sminloc1_8_r8 (gfc_array_i8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minloc1_8_r8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minval_i1.c b/libgfortran/generated/minval_i1.c new file mode 100644 index 000000000..d9ee1d754 --- /dev/null +++ b/libgfortran/generated/minval_i1.c @@ -0,0 +1,550 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1) + + +extern void minval_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(minval_i1); + +void +minval_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_1 result; + src = base; + { + +#if defined (GFC_INTEGER_1_INFINITY) + result = GFC_INTEGER_1_INFINITY; +#else + result = GFC_INTEGER_1_HUGE; +#endif + if (len <= 0) + *dest = GFC_INTEGER_1_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_1_QUIET_NAN) + if (*src <= result) + break; + } + if (unlikely (n >= len)) + result = GFC_INTEGER_1_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminval_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminval_i1); + +void +mminval_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_1 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_INTEGER_1_INFINITY) + result = GFC_INTEGER_1_INFINITY; +#else + result = GFC_INTEGER_1_HUGE; +#endif +#if defined (GFC_INTEGER_1_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = GFC_INTEGER_1_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_INTEGER_1_INFINITY) || defined (GFC_INTEGER_1_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_INTEGER_1_QUIET_NAN) + non_empty_p = 1; + if (*src <= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_INTEGER_1_QUIET_NAN) + result = non_empty_p ? GFC_INTEGER_1_QUIET_NAN : GFC_INTEGER_1_HUGE; +#else + result = GFC_INTEGER_1_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminval_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_i1); + +void +sminval_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minval_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = GFC_INTEGER_1_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minval_i16.c b/libgfortran/generated/minval_i16.c new file mode 100644 index 000000000..839454756 --- /dev/null +++ b/libgfortran/generated/minval_i16.c @@ -0,0 +1,550 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void minval_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(minval_i16); + +void +minval_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + +#if defined (GFC_INTEGER_16_INFINITY) + result = GFC_INTEGER_16_INFINITY; +#else + result = GFC_INTEGER_16_HUGE; +#endif + if (len <= 0) + *dest = GFC_INTEGER_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_16_QUIET_NAN) + if (*src <= result) + break; + } + if (unlikely (n >= len)) + result = GFC_INTEGER_16_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminval_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminval_i16); + +void +mminval_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_INTEGER_16_INFINITY) + result = GFC_INTEGER_16_INFINITY; +#else + result = GFC_INTEGER_16_HUGE; +#endif +#if defined (GFC_INTEGER_16_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = GFC_INTEGER_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_INTEGER_16_INFINITY) || defined (GFC_INTEGER_16_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_INTEGER_16_QUIET_NAN) + non_empty_p = 1; + if (*src <= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_INTEGER_16_QUIET_NAN) + result = non_empty_p ? GFC_INTEGER_16_QUIET_NAN : GFC_INTEGER_16_HUGE; +#else + result = GFC_INTEGER_16_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminval_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_i16); + +void +sminval_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minval_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = GFC_INTEGER_16_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minval_i2.c b/libgfortran/generated/minval_i2.c new file mode 100644 index 000000000..9cffe844d --- /dev/null +++ b/libgfortran/generated/minval_i2.c @@ -0,0 +1,550 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2) + + +extern void minval_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(minval_i2); + +void +minval_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_2 result; + src = base; + { + +#if defined (GFC_INTEGER_2_INFINITY) + result = GFC_INTEGER_2_INFINITY; +#else + result = GFC_INTEGER_2_HUGE; +#endif + if (len <= 0) + *dest = GFC_INTEGER_2_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_2_QUIET_NAN) + if (*src <= result) + break; + } + if (unlikely (n >= len)) + result = GFC_INTEGER_2_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminval_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminval_i2); + +void +mminval_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_2 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_INTEGER_2_INFINITY) + result = GFC_INTEGER_2_INFINITY; +#else + result = GFC_INTEGER_2_HUGE; +#endif +#if defined (GFC_INTEGER_2_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = GFC_INTEGER_2_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_INTEGER_2_INFINITY) || defined (GFC_INTEGER_2_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_INTEGER_2_QUIET_NAN) + non_empty_p = 1; + if (*src <= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_INTEGER_2_QUIET_NAN) + result = non_empty_p ? GFC_INTEGER_2_QUIET_NAN : GFC_INTEGER_2_HUGE; +#else + result = GFC_INTEGER_2_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminval_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_i2); + +void +sminval_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minval_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = GFC_INTEGER_2_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minval_i4.c b/libgfortran/generated/minval_i4.c new file mode 100644 index 000000000..993116a83 --- /dev/null +++ b/libgfortran/generated/minval_i4.c @@ -0,0 +1,550 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void minval_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(minval_i4); + +void +minval_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + +#if defined (GFC_INTEGER_4_INFINITY) + result = GFC_INTEGER_4_INFINITY; +#else + result = GFC_INTEGER_4_HUGE; +#endif + if (len <= 0) + *dest = GFC_INTEGER_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_4_QUIET_NAN) + if (*src <= result) + break; + } + if (unlikely (n >= len)) + result = GFC_INTEGER_4_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminval_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminval_i4); + +void +mminval_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_INTEGER_4_INFINITY) + result = GFC_INTEGER_4_INFINITY; +#else + result = GFC_INTEGER_4_HUGE; +#endif +#if defined (GFC_INTEGER_4_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = GFC_INTEGER_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_INTEGER_4_INFINITY) || defined (GFC_INTEGER_4_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_INTEGER_4_QUIET_NAN) + non_empty_p = 1; + if (*src <= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_INTEGER_4_QUIET_NAN) + result = non_empty_p ? GFC_INTEGER_4_QUIET_NAN : GFC_INTEGER_4_HUGE; +#else + result = GFC_INTEGER_4_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminval_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_i4); + +void +sminval_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minval_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = GFC_INTEGER_4_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minval_i8.c b/libgfortran/generated/minval_i8.c new file mode 100644 index 000000000..3a52b4b7e --- /dev/null +++ b/libgfortran/generated/minval_i8.c @@ -0,0 +1,550 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void minval_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(minval_i8); + +void +minval_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + +#if defined (GFC_INTEGER_8_INFINITY) + result = GFC_INTEGER_8_INFINITY; +#else + result = GFC_INTEGER_8_HUGE; +#endif + if (len <= 0) + *dest = GFC_INTEGER_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_INTEGER_8_QUIET_NAN) + if (*src <= result) + break; + } + if (unlikely (n >= len)) + result = GFC_INTEGER_8_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminval_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminval_i8); + +void +mminval_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_INTEGER_8_INFINITY) + result = GFC_INTEGER_8_INFINITY; +#else + result = GFC_INTEGER_8_HUGE; +#endif +#if defined (GFC_INTEGER_8_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = GFC_INTEGER_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_INTEGER_8_INFINITY) || defined (GFC_INTEGER_8_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_INTEGER_8_QUIET_NAN) + non_empty_p = 1; + if (*src <= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_INTEGER_8_QUIET_NAN) + result = non_empty_p ? GFC_INTEGER_8_QUIET_NAN : GFC_INTEGER_8_HUGE; +#else + result = GFC_INTEGER_8_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminval_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_i8); + +void +sminval_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minval_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = GFC_INTEGER_8_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minval_r10.c b/libgfortran/generated/minval_r10.c new file mode 100644 index 000000000..b490b3bee --- /dev/null +++ b/libgfortran/generated/minval_r10.c @@ -0,0 +1,550 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10) + + +extern void minval_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(minval_r10); + +void +minval_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_REAL_10 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + GFC_REAL_10 result; + src = base; + { + +#if defined (GFC_REAL_10_INFINITY) + result = GFC_REAL_10_INFINITY; +#else + result = GFC_REAL_10_HUGE; +#endif + if (len <= 0) + *dest = GFC_REAL_10_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_10_QUIET_NAN) + if (*src <= result) + break; + } + if (unlikely (n >= len)) + result = GFC_REAL_10_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminval_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminval_r10); + +void +mminval_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 * restrict dest; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_10 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_REAL_10_INFINITY) + result = GFC_REAL_10_INFINITY; +#else + result = GFC_REAL_10_HUGE; +#endif +#if defined (GFC_REAL_10_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = GFC_REAL_10_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_REAL_10_INFINITY) || defined (GFC_REAL_10_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_REAL_10_QUIET_NAN) + non_empty_p = 1; + if (*src <= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_REAL_10_QUIET_NAN) + result = non_empty_p ? GFC_REAL_10_QUIET_NAN : GFC_REAL_10_HUGE; +#else + result = GFC_REAL_10_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminval_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_r10); + +void +sminval_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minval_r10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = GFC_REAL_10_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minval_r16.c b/libgfortran/generated/minval_r16.c new file mode 100644 index 000000000..701191f40 --- /dev/null +++ b/libgfortran/generated/minval_r16.c @@ -0,0 +1,550 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16) + + +extern void minval_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(minval_r16); + +void +minval_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_REAL_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict src; + GFC_REAL_16 result; + src = base; + { + +#if defined (GFC_REAL_16_INFINITY) + result = GFC_REAL_16_INFINITY; +#else + result = GFC_REAL_16_HUGE; +#endif + if (len <= 0) + *dest = GFC_REAL_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_16_QUIET_NAN) + if (*src <= result) + break; + } + if (unlikely (n >= len)) + result = GFC_REAL_16_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminval_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminval_r16); + +void +mminval_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 * restrict dest; + const GFC_REAL_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_16 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_REAL_16_INFINITY) + result = GFC_REAL_16_INFINITY; +#else + result = GFC_REAL_16_HUGE; +#endif +#if defined (GFC_REAL_16_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = GFC_REAL_16_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_REAL_16_INFINITY) || defined (GFC_REAL_16_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_REAL_16_QUIET_NAN) + non_empty_p = 1; + if (*src <= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_REAL_16_QUIET_NAN) + result = non_empty_p ? GFC_REAL_16_QUIET_NAN : GFC_REAL_16_HUGE; +#else + result = GFC_REAL_16_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminval_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_r16); + +void +sminval_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minval_r16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = GFC_REAL_16_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minval_r4.c b/libgfortran/generated/minval_r4.c new file mode 100644 index 000000000..e69376590 --- /dev/null +++ b/libgfortran/generated/minval_r4.c @@ -0,0 +1,550 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4) + + +extern void minval_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(minval_r4); + +void +minval_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_REAL_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_REAL_4 result; + src = base; + { + +#if defined (GFC_REAL_4_INFINITY) + result = GFC_REAL_4_INFINITY; +#else + result = GFC_REAL_4_HUGE; +#endif + if (len <= 0) + *dest = GFC_REAL_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_4_QUIET_NAN) + if (*src <= result) + break; + } + if (unlikely (n >= len)) + result = GFC_REAL_4_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminval_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminval_r4); + +void +mminval_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_4 * restrict dest; + const GFC_REAL_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_4 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_REAL_4_INFINITY) + result = GFC_REAL_4_INFINITY; +#else + result = GFC_REAL_4_HUGE; +#endif +#if defined (GFC_REAL_4_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = GFC_REAL_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_REAL_4_INFINITY) || defined (GFC_REAL_4_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_REAL_4_QUIET_NAN) + non_empty_p = 1; + if (*src <= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_REAL_4_QUIET_NAN) + result = non_empty_p ? GFC_REAL_4_QUIET_NAN : GFC_REAL_4_HUGE; +#else + result = GFC_REAL_4_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminval_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_r4); + +void +sminval_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minval_r4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = GFC_REAL_4_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/minval_r8.c b/libgfortran/generated/minval_r8.c new file mode 100644 index 000000000..611ee5796 --- /dev/null +++ b/libgfortran/generated/minval_r8.c @@ -0,0 +1,550 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8) + + +extern void minval_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(minval_r8); + +void +minval_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_REAL_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_REAL_8 result; + src = base; + { + +#if defined (GFC_REAL_8_INFINITY) + result = GFC_REAL_8_INFINITY; +#else + result = GFC_REAL_8_HUGE; +#endif + if (len <= 0) + *dest = GFC_REAL_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + +#if defined (GFC_REAL_8_QUIET_NAN) + if (*src <= result) + break; + } + if (unlikely (n >= len)) + result = GFC_REAL_8_QUIET_NAN; + else for (; n < len; n++, src += delta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mminval_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mminval_r8); + +void +mminval_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_8 * restrict dest; + const GFC_REAL_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_8 result; + src = base; + msrc = mbase; + { + +#if defined (GFC_REAL_8_INFINITY) + result = GFC_REAL_8_INFINITY; +#else + result = GFC_REAL_8_HUGE; +#endif +#if defined (GFC_REAL_8_QUIET_NAN) + int non_empty_p = 0; +#endif + if (len <= 0) + *dest = GFC_REAL_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + +#if defined (GFC_REAL_8_INFINITY) || defined (GFC_REAL_8_QUIET_NAN) + if (*msrc) + { +#if defined (GFC_REAL_8_QUIET_NAN) + non_empty_p = 1; + if (*src <= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined (GFC_REAL_8_QUIET_NAN) + result = non_empty_p ? GFC_REAL_8_QUIET_NAN : GFC_REAL_8_HUGE; +#else + result = GFC_REAL_8_HUGE; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sminval_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sminval_r8); + +void +sminval_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + minval_r8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = GFC_REAL_8_HUGE; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/misc_specifics.F90 b/libgfortran/generated/misc_specifics.F90 new file mode 100644 index 000000000..2df9a23b4 --- /dev/null +++ b/libgfortran/generated/misc_specifics.F90 @@ -0,0 +1,206 @@ +! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated. + +#include "config.h" +#include "kinds.inc" + + + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_4) +elemental function _gfortran_specific__nint_4_4 (parm) + real (kind=4) , intent (in) :: parm + integer (kind=4) :: _gfortran_specific__nint_4_4 + _gfortran_specific__nint_4_4 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_4) +elemental function _gfortran_specific__nint_4_8 (parm) + real (kind=8) , intent (in) :: parm + integer (kind=4) :: _gfortran_specific__nint_4_8 + _gfortran_specific__nint_4_8 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_4) +elemental function _gfortran_specific__nint_4_10 (parm) + real (kind=10) , intent (in) :: parm + integer (kind=4) :: _gfortran_specific__nint_4_10 + _gfortran_specific__nint_4_10 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_4) +elemental function _gfortran_specific__nint_4_16 (parm) + real (kind=16) , intent (in) :: parm + integer (kind=4) :: _gfortran_specific__nint_4_16 + _gfortran_specific__nint_4_16 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) +elemental function _gfortran_specific__nint_8_4 (parm) + real (kind=4) , intent (in) :: parm + integer (kind=8) :: _gfortran_specific__nint_8_4 + _gfortran_specific__nint_8_4 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_8) +elemental function _gfortran_specific__nint_8_8 (parm) + real (kind=8) , intent (in) :: parm + integer (kind=8) :: _gfortran_specific__nint_8_8 + _gfortran_specific__nint_8_8 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) +elemental function _gfortran_specific__nint_8_10 (parm) + real (kind=10) , intent (in) :: parm + integer (kind=8) :: _gfortran_specific__nint_8_10 + _gfortran_specific__nint_8_10 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_8) +elemental function _gfortran_specific__nint_8_16 (parm) + real (kind=16) , intent (in) :: parm + integer (kind=8) :: _gfortran_specific__nint_8_16 + _gfortran_specific__nint_8_16 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_16) +elemental function _gfortran_specific__nint_16_4 (parm) + real (kind=4) , intent (in) :: parm + integer (kind=16) :: _gfortran_specific__nint_16_4 + _gfortran_specific__nint_16_4 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_INTEGER_16) +elemental function _gfortran_specific__nint_16_8 (parm) + real (kind=8) , intent (in) :: parm + integer (kind=16) :: _gfortran_specific__nint_16_8 + _gfortran_specific__nint_16_8 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_16) +elemental function _gfortran_specific__nint_16_10 (parm) + real (kind=10) , intent (in) :: parm + integer (kind=16) :: _gfortran_specific__nint_16_10 + _gfortran_specific__nint_16_10 = nint (parm) +end function +#endif + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_INTEGER_16) +elemental function _gfortran_specific__nint_16_16 (parm) + real (kind=16) , intent (in) :: parm + integer (kind=16) :: _gfortran_specific__nint_16_16 + _gfortran_specific__nint_16_16 = nint (parm) +end function +#endif + + + +#if defined (HAVE_GFC_INTEGER_4) +elemental function _gfortran_specific__char_1_i4 (parm) + integer (kind=4) , intent (in) :: parm + character (kind=1,len=1) :: _gfortran_specific__char_1_i4 + _gfortran_specific__char_1_i4 = char (parm, kind=1) +end function +#endif + +#if defined (HAVE_GFC_INTEGER_8) +elemental function _gfortran_specific__char_1_i8 (parm) + integer (kind=8) , intent (in) :: parm + character (kind=1,len=1) :: _gfortran_specific__char_1_i8 + _gfortran_specific__char_1_i8 = char (parm, kind=1) +end function +#endif + +#if defined (HAVE_GFC_INTEGER_16) +elemental function _gfortran_specific__char_1_i16 (parm) + integer (kind=16) , intent (in) :: parm + character (kind=1,len=1) :: _gfortran_specific__char_1_i16 + _gfortran_specific__char_1_i16 = char (parm, kind=1) +end function +#endif + + + +#if defined (HAVE_GFC_INTEGER_4) +elemental function _gfortran_specific__len_1_i4 (parm) + character (kind=1,len=*) , intent (in) :: parm + integer (kind=4) :: _gfortran_specific__len_1_i4 + _gfortran_specific__len_1_i4 = len (parm) +end function +#endif + +#if defined (HAVE_GFC_INTEGER_8) +elemental function _gfortran_specific__len_1_i8 (parm) + character (kind=1,len=*) , intent (in) :: parm + integer (kind=8) :: _gfortran_specific__len_1_i8 + _gfortran_specific__len_1_i8 = len (parm) +end function +#endif + +#if defined (HAVE_GFC_INTEGER_16) +elemental function _gfortran_specific__len_1_i16 (parm) + character (kind=1,len=*) , intent (in) :: parm + integer (kind=16) :: _gfortran_specific__len_1_i16 + _gfortran_specific__len_1_i16 = len (parm) +end function +#endif + + + +#if defined (HAVE_GFC_INTEGER_4) +elemental function _gfortran_specific__index_1_i4 (parm1, parm2) + character (kind=1,len=*) , intent (in) :: parm1, parm2 + integer (kind=4) :: _gfortran_specific__index_1_i4 + _gfortran_specific__index_1_i4 = index (parm1, parm2) +end function +#endif + +#if defined (HAVE_GFC_INTEGER_8) +elemental function _gfortran_specific__index_1_i8 (parm1, parm2) + character (kind=1,len=*) , intent (in) :: parm1, parm2 + integer (kind=8) :: _gfortran_specific__index_1_i8 + _gfortran_specific__index_1_i8 = index (parm1, parm2) +end function +#endif + +#if defined (HAVE_GFC_INTEGER_16) +elemental function _gfortran_specific__index_1_i16 (parm1, parm2) + character (kind=1,len=*) , intent (in) :: parm1, parm2 + integer (kind=16) :: _gfortran_specific__index_1_i16 + _gfortran_specific__index_1_i16 = index (parm1, parm2) +end function +#endif + diff --git a/libgfortran/generated/nearest_r10.c b/libgfortran/generated/nearest_r10.c new file mode 100644 index 000000000..2414bb35d --- /dev/null +++ b/libgfortran/generated/nearest_r10.c @@ -0,0 +1,51 @@ +/* Implementation of the NEAREST intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## l + +#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 = MATHFUNC(copysign) (MATHFUNC(__builtin_inf) (), dir); + if (FLT_EVAL_METHOD != 0) + { + /* ??? Work around glibc bug on x86. */ + volatile GFC_REAL_10 r = MATHFUNC(nextafter) (s, dir); + return r; + } + else + return MATHFUNC(nextafter) (s, dir); +} + +#endif diff --git a/libgfortran/generated/nearest_r16.c b/libgfortran/generated/nearest_r16.c new file mode 100644 index 000000000..1e8254f2c --- /dev/null +++ b/libgfortran/generated/nearest_r16.c @@ -0,0 +1,55 @@ +/* Implementation of the NEAREST intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define MATHFUNC(funcname) funcname ## q +#else +#define MATHFUNC(funcname) funcname ## l +#endif + +#if defined (HAVE_GFC_REAL_16) && (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_COPYSIGNL)) && (defined(GFC_REAL_16_IS_FLOAT128) || 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 = MATHFUNC(copysign) (MATHFUNC(__builtin_inf) (), dir); + if (FLT_EVAL_METHOD != 0) + { + /* ??? Work around glibc bug on x86. */ + volatile GFC_REAL_16 r = MATHFUNC(nextafter) (s, dir); + return r; + } + else + return MATHFUNC(nextafter) (s, dir); +} + +#endif diff --git a/libgfortran/generated/nearest_r4.c b/libgfortran/generated/nearest_r4.c new file mode 100644 index 000000000..b26faea50 --- /dev/null +++ b/libgfortran/generated/nearest_r4.c @@ -0,0 +1,51 @@ +/* Implementation of the NEAREST intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## f + +#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); + +GFC_REAL_4 +nearest_r4 (GFC_REAL_4 s, GFC_REAL_4 dir) +{ + dir = MATHFUNC(copysign) (MATHFUNC(__builtin_inf) (), dir); + if (FLT_EVAL_METHOD != 0) + { + /* ??? Work around glibc bug on x86. */ + volatile GFC_REAL_4 r = MATHFUNC(nextafter) (s, dir); + return r; + } + else + return MATHFUNC(nextafter) (s, dir); +} + +#endif diff --git a/libgfortran/generated/nearest_r8.c b/libgfortran/generated/nearest_r8.c new file mode 100644 index 000000000..81505e934 --- /dev/null +++ b/libgfortran/generated/nearest_r8.c @@ -0,0 +1,51 @@ +/* Implementation of the NEAREST intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname + +#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); + +GFC_REAL_8 +nearest_r8 (GFC_REAL_8 s, GFC_REAL_8 dir) +{ + dir = MATHFUNC(copysign) (MATHFUNC(__builtin_inf) (), dir); + if (FLT_EVAL_METHOD != 0) + { + /* ??? Work around glibc bug on x86. */ + volatile GFC_REAL_8 r = MATHFUNC(nextafter) (s, dir); + return r; + } + else + return MATHFUNC(nextafter) (s, dir); +} + +#endif diff --git a/libgfortran/generated/norm2_r10.c b/libgfortran/generated/norm2_r10.c new file mode 100644 index 000000000..404cb1c16 --- /dev/null +++ b/libgfortran/generated/norm2_r10.c @@ -0,0 +1,212 @@ +/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10) && defined (HAVE_SQRTL) && defined (HAVE_FABSL) + +#define MATHFUNC(funcname) funcname ## l +#define BUILTINMATHFUNC(funcname) MATHFUNC(funcname) + + +extern void norm2_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(norm2_r10); + +void +norm2_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_REAL_10 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " NORM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "NORM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict src; + GFC_REAL_10 result; + src = base; + { + + GFC_REAL_10 scale; + result = 0; + scale = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src != 0) + { + GFC_REAL_10 absX, val; + absX = MATHFUNC(fabs) (*src); + if (scale < absX) + { + val = scale / absX; + result = 1 + result * val * val; + scale = absX; + } + else + { + val = absX / scale; + result += val * val; + } + } + } + result = scale * MATHFUNC(sqrt) (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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/norm2_r16.c b/libgfortran/generated/norm2_r16.c new file mode 100644 index 000000000..100f2e76d --- /dev/null +++ b/libgfortran/generated/norm2_r16.c @@ -0,0 +1,220 @@ +/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16) && (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_SQRTL)) && (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_FABSL)) + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define MATHFUNC(funcname) funcname ## q +#else +#define MATHFUNC(funcname) funcname ## l +#endif +#if defined(GFC_REAL_16_IS_FLOAT128) +#define BUILTINMATHFUNC(funcname) funcname ## q +#else +#define BUILTINMATHFUNC(funcname) funcname ## l +#endif + + +extern void norm2_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(norm2_r16); + +void +norm2_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_REAL_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " NORM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "NORM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict src; + GFC_REAL_16 result; + src = base; + { + + GFC_REAL_16 scale; + result = 0; + scale = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src != 0) + { + GFC_REAL_16 absX, val; + absX = MATHFUNC(fabs) (*src); + if (scale < absX) + { + val = scale / absX; + result = 1 + result * val * val; + scale = absX; + } + else + { + val = absX / scale; + result += val * val; + } + } + } + result = scale * MATHFUNC(sqrt) (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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/norm2_r4.c b/libgfortran/generated/norm2_r4.c new file mode 100644 index 000000000..a86f76e0a --- /dev/null +++ b/libgfortran/generated/norm2_r4.c @@ -0,0 +1,212 @@ +/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4) && defined (HAVE_SQRTF) && defined (HAVE_FABSF) + +#define MATHFUNC(funcname) funcname ## f +#define BUILTINMATHFUNC(funcname) MATHFUNC(funcname) + + +extern void norm2_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(norm2_r4); + +void +norm2_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_REAL_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " NORM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "NORM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_REAL_4 result; + src = base; + { + + GFC_REAL_4 scale; + result = 0; + scale = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src != 0) + { + GFC_REAL_4 absX, val; + absX = MATHFUNC(fabs) (*src); + if (scale < absX) + { + val = scale / absX; + result = 1 + result * val * val; + scale = absX; + } + else + { + val = absX / scale; + result += val * val; + } + } + } + result = scale * MATHFUNC(sqrt) (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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/norm2_r8.c b/libgfortran/generated/norm2_r8.c new file mode 100644 index 000000000..14487e8b2 --- /dev/null +++ b/libgfortran/generated/norm2_r8.c @@ -0,0 +1,212 @@ +/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8) && defined (HAVE_SQRT) && defined (HAVE_FABS) + +#define MATHFUNC(funcname) funcname +#define BUILTINMATHFUNC(funcname) MATHFUNC(funcname) + + +extern void norm2_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(norm2_r8); + +void +norm2_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_REAL_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " NORM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "NORM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_REAL_8 result; + src = base; + { + + GFC_REAL_8 scale; + result = 0; + scale = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src != 0) + { + GFC_REAL_8 absX, val; + absX = MATHFUNC(fabs) (*src); + if (scale < absX) + { + val = scale / absX; + result = 1 + result * val * val; + scale = absX; + } + else + { + val = absX / scale; + result += val * val; + } + } + } + result = scale * MATHFUNC(sqrt) (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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/pack_c10.c b/libgfortran/generated/pack_c10.c new file mode 100644 index 000000000..cc66c538e --- /dev/null +++ b/libgfortran/generated/pack_c10.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_10) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_c10 (gfc_array_c10 *ret, const gfc_array_c10 *array, + const gfc_array_l1 *mask, const gfc_array_c10 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_COMPLEX_10 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_COMPLEX_10 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_c16.c b/libgfortran/generated/pack_c16.c new file mode 100644 index 000000000..9397262dd --- /dev/null +++ b/libgfortran/generated/pack_c16.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_16) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_c16 (gfc_array_c16 *ret, const gfc_array_c16 *array, + const gfc_array_l1 *mask, const gfc_array_c16 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_COMPLEX_16 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_COMPLEX_16 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_c4.c b/libgfortran/generated/pack_c4.c new file mode 100644 index 000000000..093bdcc9a --- /dev/null +++ b/libgfortran/generated/pack_c4.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_4) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_c4 (gfc_array_c4 *ret, const gfc_array_c4 *array, + const gfc_array_l1 *mask, const gfc_array_c4 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_COMPLEX_4 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_COMPLEX_4 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_c8.c b/libgfortran/generated/pack_c8.c new file mode 100644 index 000000000..7971e2ba1 --- /dev/null +++ b/libgfortran/generated/pack_c8.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_8) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_c8 (gfc_array_c8 *ret, const gfc_array_c8 *array, + const gfc_array_l1 *mask, const gfc_array_c8 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_COMPLEX_8 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_COMPLEX_8 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_i1.c b/libgfortran/generated/pack_i1.c new file mode 100644 index 000000000..3e4647dbd --- /dev/null +++ b/libgfortran/generated/pack_i1.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_i1 (gfc_array_i1 *ret, const gfc_array_i1 *array, + const gfc_array_l1 *mask, const gfc_array_i1 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_INTEGER_1 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_INTEGER_1 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_1) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_i16.c b/libgfortran/generated/pack_i16.c new file mode 100644 index 000000000..99d3491c3 --- /dev/null +++ b/libgfortran/generated/pack_i16.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_i16 (gfc_array_i16 *ret, const gfc_array_i16 *array, + const gfc_array_l1 *mask, const gfc_array_i16 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_INTEGER_16 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_INTEGER_16 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_i2.c b/libgfortran/generated/pack_i2.c new file mode 100644 index 000000000..e796d169f --- /dev/null +++ b/libgfortran/generated/pack_i2.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_i2 (gfc_array_i2 *ret, const gfc_array_i2 *array, + const gfc_array_l1 *mask, const gfc_array_i2 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_INTEGER_2 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_INTEGER_2 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_2) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_i4.c b/libgfortran/generated/pack_i4.c new file mode 100644 index 000000000..91ce99fe4 --- /dev/null +++ b/libgfortran/generated/pack_i4.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_i4 (gfc_array_i4 *ret, const gfc_array_i4 *array, + const gfc_array_l1 *mask, const gfc_array_i4 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_INTEGER_4 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_INTEGER_4 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_i8.c b/libgfortran/generated/pack_i8.c new file mode 100644 index 000000000..e49d8c29e --- /dev/null +++ b/libgfortran/generated/pack_i8.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_i8 (gfc_array_i8 *ret, const gfc_array_i8 *array, + const gfc_array_l1 *mask, const gfc_array_i8 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_INTEGER_8 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_INTEGER_8 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_r10.c b/libgfortran/generated/pack_r10.c new file mode 100644 index 000000000..f70c93264 --- /dev/null +++ b/libgfortran/generated/pack_r10.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_r10 (gfc_array_r10 *ret, const gfc_array_r10 *array, + const gfc_array_l1 *mask, const gfc_array_r10 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_REAL_10 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_REAL_10 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_REAL_10) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_r16.c b/libgfortran/generated/pack_r16.c new file mode 100644 index 000000000..ff2ad6e7e --- /dev/null +++ b/libgfortran/generated/pack_r16.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_r16 (gfc_array_r16 *ret, const gfc_array_r16 *array, + const gfc_array_l1 *mask, const gfc_array_r16 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_REAL_16 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_REAL_16 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_REAL_16) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_r4.c b/libgfortran/generated/pack_r4.c new file mode 100644 index 000000000..0c08b8c8c --- /dev/null +++ b/libgfortran/generated/pack_r4.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_r4 (gfc_array_r4 *ret, const gfc_array_r4 *array, + const gfc_array_l1 *mask, const gfc_array_r4 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_REAL_4 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_REAL_4 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_REAL_4) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/pack_r8.c b/libgfortran/generated/pack_r8.c new file mode 100644 index 000000000..2b307e29a --- /dev/null +++ b/libgfortran/generated/pack_r8.c @@ -0,0 +1,261 @@ +/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_r8 (gfc_array_r8 *ret, const gfc_array_r8 *array, + const gfc_array_l1 *mask, const gfc_array_r8 *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + GFC_REAL_8 * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const GFC_REAL_8 *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof (GFC_REAL_8) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/parity_l1.c b/libgfortran/generated/parity_l1.c new file mode 100644 index 000000000..4fef27744 --- /dev/null +++ b/libgfortran/generated/parity_l1.c @@ -0,0 +1,191 @@ +/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_1) && defined (HAVE_GFC_LOGICAL_1) + + +extern void parity_l1 (gfc_array_l1 * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(parity_l1); + +void +parity_l1 (gfc_array_l1 * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + GFC_LOGICAL_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PARITY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + GFC_LOGICAL_1 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/parity_l16.c b/libgfortran/generated/parity_l16.c new file mode 100644 index 000000000..45f445716 --- /dev/null +++ b/libgfortran/generated/parity_l16.c @@ -0,0 +1,191 @@ +/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_16) && defined (HAVE_GFC_LOGICAL_16) + + +extern void parity_l16 (gfc_array_l16 * const restrict, + gfc_array_l16 * const restrict, const index_type * const restrict); +export_proto(parity_l16); + +void +parity_l16 (gfc_array_l16 * const restrict retarray, + gfc_array_l16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_16 * restrict base; + GFC_LOGICAL_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PARITY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_16 * restrict src; + GFC_LOGICAL_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/parity_l2.c b/libgfortran/generated/parity_l2.c new file mode 100644 index 000000000..13e77bd52 --- /dev/null +++ b/libgfortran/generated/parity_l2.c @@ -0,0 +1,191 @@ +/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_2) && defined (HAVE_GFC_LOGICAL_2) + + +extern void parity_l2 (gfc_array_l2 * const restrict, + gfc_array_l2 * const restrict, const index_type * const restrict); +export_proto(parity_l2); + +void +parity_l2 (gfc_array_l2 * const restrict retarray, + gfc_array_l2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_2 * restrict base; + GFC_LOGICAL_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PARITY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_2 * restrict src; + GFC_LOGICAL_2 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/parity_l4.c b/libgfortran/generated/parity_l4.c new file mode 100644 index 000000000..5d7fbbef6 --- /dev/null +++ b/libgfortran/generated/parity_l4.c @@ -0,0 +1,191 @@ +/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_4) && defined (HAVE_GFC_LOGICAL_4) + + +extern void parity_l4 (gfc_array_l4 * const restrict, + gfc_array_l4 * const restrict, const index_type * const restrict); +export_proto(parity_l4); + +void +parity_l4 (gfc_array_l4 * const restrict retarray, + gfc_array_l4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_4 * restrict base; + GFC_LOGICAL_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PARITY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_4 * restrict src; + GFC_LOGICAL_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/parity_l8.c b/libgfortran/generated/parity_l8.c new file mode 100644 index 000000000..1d9ba82e0 --- /dev/null +++ b/libgfortran/generated/parity_l8.c @@ -0,0 +1,191 @@ +/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_LOGICAL_8) && defined (HAVE_GFC_LOGICAL_8) + + +extern void parity_l8 (gfc_array_l8 * const restrict, + gfc_array_l8 * const restrict, const index_type * const restrict); +export_proto(parity_l8); + +void +parity_l8 (gfc_array_l8 * const restrict retarray, + gfc_array_l8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_8 * restrict base; + GFC_LOGICAL_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_LOGICAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PARITY intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PARITY"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_8 * restrict src; + GFC_LOGICAL_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/pow_c10_i16.c b/libgfortran/generated/pow_c10_i16.c new file mode 100644 index 000000000..48b2fd8fa --- /dev/null +++ b/libgfortran/generated/pow_c10_i16.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..2869f1d2d --- /dev/null +++ b/libgfortran/generated/pow_c10_i4.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_4 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..32ff9d454 --- /dev/null +++ b/libgfortran/generated/pow_c10_i8.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_8 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..668f85eda --- /dev/null +++ b/libgfortran/generated/pow_c16_i16.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..2d5be146c --- /dev/null +++ b/libgfortran/generated/pow_c16_i4.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_4 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..e599cf08b --- /dev/null +++ b/libgfortran/generated/pow_c16_i8.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_8 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..3f6ff8d87 --- /dev/null +++ b/libgfortran/generated/pow_c4_i16.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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_i4.c b/libgfortran/generated/pow_c4_i4.c new file mode 100644 index 000000000..b5cc430c6 --- /dev/null +++ b/libgfortran/generated/pow_c4_i4.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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_4) + +GFC_COMPLEX_4 pow_c4_i4 (GFC_COMPLEX_4 a, GFC_INTEGER_4 b); +export_proto(pow_c4_i4); + +GFC_COMPLEX_4 +pow_c4_i4 (GFC_COMPLEX_4 a, GFC_INTEGER_4 b) +{ + GFC_COMPLEX_4 pow, x; + GFC_INTEGER_4 n; + GFC_UINTEGER_4 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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_i8.c b/libgfortran/generated/pow_c4_i8.c new file mode 100644 index 000000000..0bd0da7ce --- /dev/null +++ b/libgfortran/generated/pow_c4_i8.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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_8) + +GFC_COMPLEX_4 pow_c4_i8 (GFC_COMPLEX_4 a, GFC_INTEGER_8 b); +export_proto(pow_c4_i8); + +GFC_COMPLEX_4 +pow_c4_i8 (GFC_COMPLEX_4 a, GFC_INTEGER_8 b) +{ + GFC_COMPLEX_4 pow, x; + GFC_INTEGER_8 n; + GFC_UINTEGER_8 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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_c8_i16.c b/libgfortran/generated/pow_c8_i16.c new file mode 100644 index 000000000..8ac146548 --- /dev/null +++ b/libgfortran/generated/pow_c8_i16.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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_c8_i4.c b/libgfortran/generated/pow_c8_i4.c new file mode 100644 index 000000000..d788c1bd6 --- /dev/null +++ b/libgfortran/generated/pow_c8_i4.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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_4) + +GFC_COMPLEX_8 pow_c8_i4 (GFC_COMPLEX_8 a, GFC_INTEGER_4 b); +export_proto(pow_c8_i4); + +GFC_COMPLEX_8 +pow_c8_i4 (GFC_COMPLEX_8 a, GFC_INTEGER_4 b) +{ + GFC_COMPLEX_8 pow, x; + GFC_INTEGER_4 n; + GFC_UINTEGER_4 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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_c8_i8.c b/libgfortran/generated/pow_c8_i8.c new file mode 100644 index 000000000..805146765 --- /dev/null +++ b/libgfortran/generated/pow_c8_i8.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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_8) + +GFC_COMPLEX_8 pow_c8_i8 (GFC_COMPLEX_8 a, GFC_INTEGER_8 b); +export_proto(pow_c8_i8); + +GFC_COMPLEX_8 +pow_c8_i8 (GFC_COMPLEX_8 a, GFC_INTEGER_8 b) +{ + GFC_COMPLEX_8 pow, x; + GFC_INTEGER_8 n; + GFC_UINTEGER_8 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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_i16.c b/libgfortran/generated/pow_i16_i16.c new file mode 100644 index 000000000..62a88b11b --- /dev/null +++ b/libgfortran/generated/pow_i16_i16.c @@ -0,0 +1,77 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 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; + } + else + { + 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 index 000000000..2d4c87ca7 --- /dev/null +++ b/libgfortran/generated/pow_i16_i4.c @@ -0,0 +1,77 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_4 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; + } + else + { + 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 index 000000000..3c8401c6f --- /dev/null +++ b/libgfortran/generated/pow_i16_i8.c @@ -0,0 +1,77 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_8 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; + } + else + { + 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 index 000000000..c6a92f0a4 --- /dev/null +++ b/libgfortran/generated/pow_i4_i16.c @@ -0,0 +1,77 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 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; + } + else + { + 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_i4.c b/libgfortran/generated/pow_i4_i4.c new file mode 100644 index 000000000..b8ffd7255 --- /dev/null +++ b/libgfortran/generated/pow_i4_i4.c @@ -0,0 +1,77 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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_4) + +GFC_INTEGER_4 pow_i4_i4 (GFC_INTEGER_4 a, GFC_INTEGER_4 b); +export_proto(pow_i4_i4); + +GFC_INTEGER_4 +pow_i4_i4 (GFC_INTEGER_4 a, GFC_INTEGER_4 b) +{ + GFC_INTEGER_4 pow, x; + GFC_INTEGER_4 n; + GFC_UINTEGER_4 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; + } + else + { + 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_i8.c b/libgfortran/generated/pow_i4_i8.c new file mode 100644 index 000000000..76ac564ec --- /dev/null +++ b/libgfortran/generated/pow_i4_i8.c @@ -0,0 +1,77 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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_8) + +GFC_INTEGER_4 pow_i4_i8 (GFC_INTEGER_4 a, GFC_INTEGER_8 b); +export_proto(pow_i4_i8); + +GFC_INTEGER_4 +pow_i4_i8 (GFC_INTEGER_4 a, GFC_INTEGER_8 b) +{ + GFC_INTEGER_4 pow, x; + GFC_INTEGER_8 n; + GFC_UINTEGER_8 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; + } + else + { + 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_i8_i16.c b/libgfortran/generated/pow_i8_i16.c new file mode 100644 index 000000000..66a50b631 --- /dev/null +++ b/libgfortran/generated/pow_i8_i16.c @@ -0,0 +1,77 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 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; + } + else + { + 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_i8_i4.c b/libgfortran/generated/pow_i8_i4.c new file mode 100644 index 000000000..8b8594653 --- /dev/null +++ b/libgfortran/generated/pow_i8_i4.c @@ -0,0 +1,77 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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_4) + +GFC_INTEGER_8 pow_i8_i4 (GFC_INTEGER_8 a, GFC_INTEGER_4 b); +export_proto(pow_i8_i4); + +GFC_INTEGER_8 +pow_i8_i4 (GFC_INTEGER_8 a, GFC_INTEGER_4 b) +{ + GFC_INTEGER_8 pow, x; + GFC_INTEGER_4 n; + GFC_UINTEGER_4 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; + } + else + { + 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_i8_i8.c b/libgfortran/generated/pow_i8_i8.c new file mode 100644 index 000000000..bc5aa0dd8 --- /dev/null +++ b/libgfortran/generated/pow_i8_i8.c @@ -0,0 +1,77 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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_8) + +GFC_INTEGER_8 pow_i8_i8 (GFC_INTEGER_8 a, GFC_INTEGER_8 b); +export_proto(pow_i8_i8); + +GFC_INTEGER_8 +pow_i8_i8 (GFC_INTEGER_8 a, GFC_INTEGER_8 b) +{ + GFC_INTEGER_8 pow, x; + GFC_INTEGER_8 n; + GFC_UINTEGER_8 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; + } + else + { + 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_i16.c b/libgfortran/generated/pow_r10_i16.c new file mode 100644 index 000000000..d587c4767 --- /dev/null +++ b/libgfortran/generated/pow_r10_i16.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..d2f66e019 --- /dev/null +++ b/libgfortran/generated/pow_r10_i8.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_8 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..0e80dd787 --- /dev/null +++ b/libgfortran/generated/pow_r16_i16.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..bba2a8445 --- /dev/null +++ b/libgfortran/generated/pow_r16_i4.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_4 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..16ea271e8 --- /dev/null +++ b/libgfortran/generated/pow_r16_i8.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_8 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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 index 000000000..3ba8d3e30 --- /dev/null +++ b/libgfortran/generated/pow_r4_i16.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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_i8.c b/libgfortran/generated/pow_r4_i8.c new file mode 100644 index 000000000..799adbaa8 --- /dev/null +++ b/libgfortran/generated/pow_r4_i8.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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_8) + +GFC_REAL_4 pow_r4_i8 (GFC_REAL_4 a, GFC_INTEGER_8 b); +export_proto(pow_r4_i8); + +GFC_REAL_4 +pow_r4_i8 (GFC_REAL_4 a, GFC_INTEGER_8 b) +{ + GFC_REAL_4 pow, x; + GFC_INTEGER_8 n; + GFC_UINTEGER_8 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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_r8_i16.c b/libgfortran/generated/pow_r8_i16.c new file mode 100644 index 000000000..4c7dcb7f0 --- /dev/null +++ b/libgfortran/generated/pow_r8_i16.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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; + GFC_UINTEGER_16 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + 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_r8_i8.c b/libgfortran/generated/pow_r8_i8.c new file mode 100644 index 000000000..1a6a7460e --- /dev/null +++ b/libgfortran/generated/pow_r8_i8.c @@ -0,0 +1,75 @@ +/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#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_8) + +GFC_REAL_8 pow_r8_i8 (GFC_REAL_8 a, GFC_INTEGER_8 b); +export_proto(pow_r8_i8); + +GFC_REAL_8 +pow_r8_i8 (GFC_REAL_8 a, GFC_INTEGER_8 b) +{ + GFC_REAL_8 pow, x; + GFC_INTEGER_8 n; + GFC_UINTEGER_8 u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { + + u = -n; + x = pow / x; + } + else + { + u = n; + } + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; +} + +#endif diff --git a/libgfortran/generated/product_c10.c b/libgfortran/generated/product_c10.c new file mode 100644 index 000000000..140aa305f --- /dev/null +++ b/libgfortran/generated/product_c10.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_COMPLEX_10) + + +extern void product_c10 (gfc_array_c10 * const restrict, + gfc_array_c10 * const restrict, const index_type * const restrict); +export_proto(product_c10); + +void +product_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_COMPLEX_10 * restrict base; + GFC_COMPLEX_10 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_COMPLEX_10 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_c10 (gfc_array_c10 * const restrict, + gfc_array_c10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_c10); + +void +mproduct_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_10 * restrict dest; + const GFC_COMPLEX_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_COMPLEX_10 * restrict src; + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_c10 (gfc_array_c10 * const restrict, + gfc_array_c10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_c10); + +void +sproduct_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_10 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_c10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_c16.c b/libgfortran/generated/product_c16.c new file mode 100644 index 000000000..d59510248 --- /dev/null +++ b/libgfortran/generated/product_c16.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_COMPLEX_16) + + +extern void product_c16 (gfc_array_c16 * const restrict, + gfc_array_c16 * const restrict, const index_type * const restrict); +export_proto(product_c16); + +void +product_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_COMPLEX_16 * restrict base; + GFC_COMPLEX_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_COMPLEX_16 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_c16 (gfc_array_c16 * const restrict, + gfc_array_c16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_c16); + +void +mproduct_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_16 * restrict dest; + const GFC_COMPLEX_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_COMPLEX_16 * restrict src; + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_c16 (gfc_array_c16 * const restrict, + gfc_array_c16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_c16); + +void +sproduct_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_c16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_c4.c b/libgfortran/generated/product_c4.c new file mode 100644 index 000000000..34c1bde26 --- /dev/null +++ b/libgfortran/generated/product_c4.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_COMPLEX_4) + + +extern void product_c4 (gfc_array_c4 * const restrict, + gfc_array_c4 * const restrict, const index_type * const restrict); +export_proto(product_c4); + +void +product_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_COMPLEX_4 * restrict base; + GFC_COMPLEX_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_COMPLEX_4 * restrict src; + GFC_COMPLEX_4 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_c4 (gfc_array_c4 * const restrict, + gfc_array_c4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_c4); + +void +mproduct_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_4 * restrict dest; + const GFC_COMPLEX_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_COMPLEX_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_COMPLEX_4 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_c4 (gfc_array_c4 * const restrict, + gfc_array_c4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_c4); + +void +sproduct_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_c4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_c8.c b/libgfortran/generated/product_c8.c new file mode 100644 index 000000000..6e3487489 --- /dev/null +++ b/libgfortran/generated/product_c8.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_COMPLEX_8) + + +extern void product_c8 (gfc_array_c8 * const restrict, + gfc_array_c8 * const restrict, const index_type * const restrict); +export_proto(product_c8); + +void +product_c8 (gfc_array_c8 * const restrict retarray, + gfc_array_c8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_COMPLEX_8 * restrict base; + GFC_COMPLEX_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_COMPLEX_8 * restrict src; + GFC_COMPLEX_8 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_c8 (gfc_array_c8 * const restrict, + gfc_array_c8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_c8); + +void +mproduct_c8 (gfc_array_c8 * const restrict retarray, + gfc_array_c8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_8 * restrict dest; + const GFC_COMPLEX_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_COMPLEX_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_COMPLEX_8 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_c8 (gfc_array_c8 * const restrict, + gfc_array_c8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_c8); + +void +sproduct_c8 (gfc_array_c8 * const restrict retarray, + gfc_array_c8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_c8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_i1.c b/libgfortran/generated/product_i1.c new file mode 100644 index 000000000..2e0428718 --- /dev/null +++ b/libgfortran/generated/product_i1.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1) + + +extern void product_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(product_i1); + +void +product_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_1 result; + src = base; + { + + result = 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_i1); + +void +mproduct_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_1 result; + src = base; + msrc = mbase; + { + + result = 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_i1); + +void +sproduct_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_i16.c b/libgfortran/generated/product_i16.c new file mode 100644 index 000000000..e487ddfed --- /dev/null +++ b/libgfortran/generated/product_i16.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void product_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(product_i16); + +void +product_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + result = 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_i16); + +void +mproduct_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + result = 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_i16); + +void +sproduct_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_i2.c b/libgfortran/generated/product_i2.c new file mode 100644 index 000000000..b4b0a4ce7 --- /dev/null +++ b/libgfortran/generated/product_i2.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2) + + +extern void product_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(product_i2); + +void +product_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_2 result; + src = base; + { + + result = 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_i2); + +void +mproduct_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_2 result; + src = base; + msrc = mbase; + { + + result = 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_i2); + +void +sproduct_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_i4.c b/libgfortran/generated/product_i4.c new file mode 100644 index 000000000..a0164a161 --- /dev/null +++ b/libgfortran/generated/product_i4.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void product_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(product_i4); + +void +product_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + result = 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_i4); + +void +mproduct_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + result = 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_i4); + +void +sproduct_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_i8.c b/libgfortran/generated/product_i8.c new file mode 100644 index 000000000..64c648774 --- /dev/null +++ b/libgfortran/generated/product_i8.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void product_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(product_i8); + +void +product_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + result = 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_i8); + +void +mproduct_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + result = 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_i8); + +void +sproduct_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_r10.c b/libgfortran/generated/product_r10.c new file mode 100644 index 000000000..71a70da96 --- /dev/null +++ b/libgfortran/generated/product_r10.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10) + + +extern void product_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(product_r10); + +void +product_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_REAL_10 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_r10); + +void +mproduct_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 * restrict dest; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_r10); + +void +sproduct_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_r10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_r16.c b/libgfortran/generated/product_r16.c new file mode 100644 index 000000000..0028ba1f8 --- /dev/null +++ b/libgfortran/generated/product_r16.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16) + + +extern void product_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(product_r16); + +void +product_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_REAL_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_r16); + +void +mproduct_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 * restrict dest; + const GFC_REAL_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_16 * restrict src; + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_r16); + +void +sproduct_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_r16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_r4.c b/libgfortran/generated/product_r4.c new file mode 100644 index 000000000..492980e67 --- /dev/null +++ b/libgfortran/generated/product_r4.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4) + + +extern void product_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(product_r4); + +void +product_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_REAL_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_REAL_4 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_r4); + +void +mproduct_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_4 * restrict dest; + const GFC_REAL_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_4 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_r4); + +void +sproduct_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_r4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/product_r8.c b/libgfortran/generated/product_r8.c new file mode 100644 index 000000000..cf05af1fa --- /dev/null +++ b/libgfortran/generated/product_r8.c @@ -0,0 +1,508 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8) + + +extern void product_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(product_r8); + +void +product_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_REAL_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_REAL_8 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void mproduct_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(mproduct_r8); + +void +mproduct_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_8 * restrict dest; + const GFC_REAL_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_8 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void sproduct_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(sproduct_r8); + +void +sproduct_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + product_r8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 1; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/reshape_c10.c b/libgfortran/generated/reshape_c10.c new file mode 100644 index 000000000..34eff9086 --- /dev/null +++ b/libgfortran/generated/reshape_c10.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_10) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_c10 (gfc_array_c10 * const restrict, + gfc_array_c10 * const restrict, + shape_type * const restrict, + gfc_array_c10 * const restrict, + shape_type * const restrict); +export_proto(reshape_c10); + +void +reshape_c10 (gfc_array_c10 * const restrict ret, + gfc_array_c10 * const restrict source, + shape_type * const restrict shape, + gfc_array_c10 * const restrict pad, + shape_type * const restrict 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; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, 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; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + 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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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 index 000000000..569b76ce4 --- /dev/null +++ b/libgfortran/generated/reshape_c16.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_16) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_c16 (gfc_array_c16 * const restrict, + gfc_array_c16 * const restrict, + shape_type * const restrict, + gfc_array_c16 * const restrict, + shape_type * const restrict); +export_proto(reshape_c16); + +void +reshape_c16 (gfc_array_c16 * const restrict ret, + gfc_array_c16 * const restrict source, + shape_type * const restrict shape, + gfc_array_c16 * const restrict pad, + shape_type * const restrict 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; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, 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; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + 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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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_c4.c b/libgfortran/generated/reshape_c4.c new file mode 100644 index 000000000..c8b7355de --- /dev/null +++ b/libgfortran/generated/reshape_c4.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_4) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_c4 (gfc_array_c4 * const restrict, + gfc_array_c4 * const restrict, + shape_type * const restrict, + gfc_array_c4 * const restrict, + shape_type * const restrict); +export_proto(reshape_c4); + +void +reshape_c4 (gfc_array_c4 * const restrict ret, + gfc_array_c4 * const restrict source, + shape_type * const restrict shape, + gfc_array_c4 * const restrict pad, + shape_type * const restrict 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_4 *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_4 *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_4 *pptr; + + const GFC_COMPLEX_4 *src; + int n; + int dim; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_4)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_COMPLEX_4); + ssize *= sizeof (GFC_COMPLEX_4); + psize *= sizeof (GFC_COMPLEX_4); + 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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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_c8.c b/libgfortran/generated/reshape_c8.c new file mode 100644 index 000000000..1a390b450 --- /dev/null +++ b/libgfortran/generated/reshape_c8.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_8) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_c8 (gfc_array_c8 * const restrict, + gfc_array_c8 * const restrict, + shape_type * const restrict, + gfc_array_c8 * const restrict, + shape_type * const restrict); +export_proto(reshape_c8); + +void +reshape_c8 (gfc_array_c8 * const restrict ret, + gfc_array_c8 * const restrict source, + shape_type * const restrict shape, + gfc_array_c8 * const restrict pad, + shape_type * const restrict 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_8 *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_8 *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_8 *pptr; + + const GFC_COMPLEX_8 *src; + int n; + int dim; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_COMPLEX_8)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_COMPLEX_8); + ssize *= sizeof (GFC_COMPLEX_8); + psize *= sizeof (GFC_COMPLEX_8); + 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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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_i16.c b/libgfortran/generated/reshape_i16.c new file mode 100644 index 000000000..4f69ce0d2 --- /dev/null +++ b/libgfortran/generated/reshape_i16.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, + shape_type * const restrict, + gfc_array_i16 * const restrict, + shape_type * const restrict); +export_proto(reshape_16); + +void +reshape_16 (gfc_array_i16 * const restrict ret, + gfc_array_i16 * const restrict source, + shape_type * const restrict shape, + gfc_array_i16 * const restrict pad, + shape_type * const restrict 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; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, 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; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + 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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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_i4.c b/libgfortran/generated/reshape_i4.c new file mode 100644 index 000000000..53016bdf5 --- /dev/null +++ b/libgfortran/generated/reshape_i4.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, + shape_type * const restrict, + gfc_array_i4 * const restrict, + shape_type * const restrict); +export_proto(reshape_4); + +void +reshape_4 (gfc_array_i4 * const restrict ret, + gfc_array_i4 * const restrict source, + shape_type * const restrict shape, + gfc_array_i4 * const restrict pad, + shape_type * const restrict 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_4 *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_4 *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_4 *pptr; + + const GFC_INTEGER_4 *src; + int n; + int dim; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_4)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_INTEGER_4); + ssize *= sizeof (GFC_INTEGER_4); + psize *= sizeof (GFC_INTEGER_4); + 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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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_i8.c b/libgfortran/generated/reshape_i8.c new file mode 100644 index 000000000..34620cf6d --- /dev/null +++ b/libgfortran/generated/reshape_i8.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, + shape_type * const restrict, + gfc_array_i8 * const restrict, + shape_type * const restrict); +export_proto(reshape_8); + +void +reshape_8 (gfc_array_i8 * const restrict ret, + gfc_array_i8 * const restrict source, + shape_type * const restrict shape, + gfc_array_i8 * const restrict pad, + shape_type * const restrict 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_8 *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_8 *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_8 *pptr; + + const GFC_INTEGER_8 *src; + int n; + int dim; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_INTEGER_8)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_INTEGER_8); + ssize *= sizeof (GFC_INTEGER_8); + psize *= sizeof (GFC_INTEGER_8); + 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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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_r10.c b/libgfortran/generated/reshape_r10.c new file mode 100644 index 000000000..3bf319aa4 --- /dev/null +++ b/libgfortran/generated/reshape_r10.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_10) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, + shape_type * const restrict, + gfc_array_r10 * const restrict, + shape_type * const restrict); +export_proto(reshape_r10); + +void +reshape_r10 (gfc_array_r10 * const restrict ret, + gfc_array_r10 * const restrict source, + shape_type * const restrict shape, + gfc_array_r10 * const restrict pad, + shape_type * const restrict 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_REAL_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_REAL_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_REAL_10 *pptr; + + const GFC_REAL_10 *src; + int n; + int dim; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_10)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_REAL_10); + ssize *= sizeof (GFC_REAL_10); + psize *= sizeof (GFC_REAL_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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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_r16.c b/libgfortran/generated/reshape_r16.c new file mode 100644 index 000000000..6794b5060 --- /dev/null +++ b/libgfortran/generated/reshape_r16.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_16) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, + shape_type * const restrict, + gfc_array_r16 * const restrict, + shape_type * const restrict); +export_proto(reshape_r16); + +void +reshape_r16 (gfc_array_r16 * const restrict ret, + gfc_array_r16 * const restrict source, + shape_type * const restrict shape, + gfc_array_r16 * const restrict pad, + shape_type * const restrict 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_REAL_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_REAL_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_REAL_16 *pptr; + + const GFC_REAL_16 *src; + int n; + int dim; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_16)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_REAL_16); + ssize *= sizeof (GFC_REAL_16); + psize *= sizeof (GFC_REAL_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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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_r4.c b/libgfortran/generated/reshape_r4.c new file mode 100644 index 000000000..e7bfbfbf5 --- /dev/null +++ b/libgfortran/generated/reshape_r4.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_4) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, + shape_type * const restrict, + gfc_array_r4 * const restrict, + shape_type * const restrict); +export_proto(reshape_r4); + +void +reshape_r4 (gfc_array_r4 * const restrict ret, + gfc_array_r4 * const restrict source, + shape_type * const restrict shape, + gfc_array_r4 * const restrict pad, + shape_type * const restrict 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_REAL_4 *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_REAL_4 *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_REAL_4 *pptr; + + const GFC_REAL_4 *src; + int n; + int dim; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_4)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_REAL_4); + ssize *= sizeof (GFC_REAL_4); + psize *= sizeof (GFC_REAL_4); + 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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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_r8.c b/libgfortran/generated/reshape_r8.c new file mode 100644 index 000000000..d0441c0fe --- /dev/null +++ b/libgfortran/generated/reshape_r8.c @@ -0,0 +1,352 @@ +/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_8) + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + + +extern void reshape_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, + shape_type * const restrict, + gfc_array_r8 * const restrict, + shape_type * const restrict); +export_proto(reshape_r8); + +void +reshape_r8 (gfc_array_r8 * const restrict ret, + gfc_array_r8 * const restrict source, + shape_type * const restrict shape, + gfc_array_r8 * const restrict pad, + shape_type * const restrict 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_REAL_8 *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_REAL_8 *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_REAL_8 *pptr; + + const GFC_REAL_8 *src; + int n; + int dim; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_8)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof (GFC_REAL_8); + ssize *= sizeof (GFC_REAL_8); + psize *= sizeof (GFC_REAL_8); + 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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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/rrspacing_r10.c b/libgfortran/generated/rrspacing_r10.c new file mode 100644 index 000000000..78e17d104 --- /dev/null +++ b/libgfortran/generated/rrspacing_r10.c @@ -0,0 +1,54 @@ +/* Implementation of the RRSPACING intrinsic + Copyright 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Steven G. Kargl + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## l + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_FABSL) && defined (HAVE_FREXPL) + +extern GFC_REAL_10 rrspacing_r10 (GFC_REAL_10 s, int p); +export_proto(rrspacing_r10); + +GFC_REAL_10 +rrspacing_r10 (GFC_REAL_10 s, int p) +{ + int e; + GFC_REAL_10 x; + x = MATHFUNC(fabs) (s); + if (x == 0.) + return 0.; + MATHFUNC(frexp) (s, &e); +#if defined (HAVE_LDEXPL) + return MATHFUNC(ldexp) (x, p - e); +#else + return MATHFUNC(scalbn) (x, p - e); +#endif + +} + +#endif diff --git a/libgfortran/generated/rrspacing_r16.c b/libgfortran/generated/rrspacing_r16.c new file mode 100644 index 000000000..470541e72 --- /dev/null +++ b/libgfortran/generated/rrspacing_r16.c @@ -0,0 +1,58 @@ +/* Implementation of the RRSPACING intrinsic + Copyright 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Steven G. Kargl + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define MATHFUNC(funcname) funcname ## q +#else +#define MATHFUNC(funcname) funcname ## l +#endif + +#if defined (HAVE_GFC_REAL_16) && (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_FABSL)) && (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_FREXPL)) + +extern GFC_REAL_16 rrspacing_r16 (GFC_REAL_16 s, int p); +export_proto(rrspacing_r16); + +GFC_REAL_16 +rrspacing_r16 (GFC_REAL_16 s, int p) +{ + int e; + GFC_REAL_16 x; + x = MATHFUNC(fabs) (s); + if (x == 0.) + return 0.; + MATHFUNC(frexp) (s, &e); +#if (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_LDEXPL)) + return MATHFUNC(ldexp) (x, p - e); +#else + return MATHFUNC(scalbn) (x, p - e); +#endif + +} + +#endif diff --git a/libgfortran/generated/rrspacing_r4.c b/libgfortran/generated/rrspacing_r4.c new file mode 100644 index 000000000..3c5243dbc --- /dev/null +++ b/libgfortran/generated/rrspacing_r4.c @@ -0,0 +1,54 @@ +/* Implementation of the RRSPACING intrinsic + Copyright 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Steven G. Kargl + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## f + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_FABSF) && defined (HAVE_FREXPF) + +extern GFC_REAL_4 rrspacing_r4 (GFC_REAL_4 s, int p); +export_proto(rrspacing_r4); + +GFC_REAL_4 +rrspacing_r4 (GFC_REAL_4 s, int p) +{ + int e; + GFC_REAL_4 x; + x = MATHFUNC(fabs) (s); + if (x == 0.) + return 0.; + MATHFUNC(frexp) (s, &e); +#if defined (HAVE_LDEXPF) + return MATHFUNC(ldexp) (x, p - e); +#else + return MATHFUNC(scalbn) (x, p - e); +#endif + +} + +#endif diff --git a/libgfortran/generated/rrspacing_r8.c b/libgfortran/generated/rrspacing_r8.c new file mode 100644 index 000000000..1e4c99a52 --- /dev/null +++ b/libgfortran/generated/rrspacing_r8.c @@ -0,0 +1,54 @@ +/* Implementation of the RRSPACING intrinsic + Copyright 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Steven G. Kargl + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_FABS) && defined (HAVE_FREXP) + +extern GFC_REAL_8 rrspacing_r8 (GFC_REAL_8 s, int p); +export_proto(rrspacing_r8); + +GFC_REAL_8 +rrspacing_r8 (GFC_REAL_8 s, int p) +{ + int e; + GFC_REAL_8 x; + x = MATHFUNC(fabs) (s); + if (x == 0.) + return 0.; + MATHFUNC(frexp) (s, &e); +#if defined (HAVE_LDEXP) + return MATHFUNC(ldexp) (x, p - e); +#else + return MATHFUNC(scalbn) (x, p - e); +#endif + +} + +#endif diff --git a/libgfortran/generated/set_exponent_r10.c b/libgfortran/generated/set_exponent_r10.c new file mode 100644 index 000000000..523b6028c --- /dev/null +++ b/libgfortran/generated/set_exponent_r10.c @@ -0,0 +1,44 @@ +/* Implementation of the SET_EXPONENT intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## l + +#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 MATHFUNC(scalbn) (MATHFUNC(frexp) (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 index 000000000..f9a7f3737 --- /dev/null +++ b/libgfortran/generated/set_exponent_r16.c @@ -0,0 +1,48 @@ +/* Implementation of the SET_EXPONENT intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define MATHFUNC(funcname) funcname ## q +#else +#define MATHFUNC(funcname) funcname ## l +#endif + +#if defined (HAVE_GFC_REAL_16) && (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_SCALBNL)) && (defined(GFC_REAL_16_IS_FLOAT128) || 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 MATHFUNC(scalbn) (MATHFUNC(frexp) (s, &dummy_exp), i); +} + +#endif diff --git a/libgfortran/generated/set_exponent_r4.c b/libgfortran/generated/set_exponent_r4.c new file mode 100644 index 000000000..4554a408b --- /dev/null +++ b/libgfortran/generated/set_exponent_r4.c @@ -0,0 +1,44 @@ +/* Implementation of the SET_EXPONENT intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## f + +#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); + +GFC_REAL_4 +set_exponent_r4 (GFC_REAL_4 s, GFC_INTEGER_4 i) +{ + int dummy_exp; + return MATHFUNC(scalbn) (MATHFUNC(frexp) (s, &dummy_exp), i); +} + +#endif diff --git a/libgfortran/generated/set_exponent_r8.c b/libgfortran/generated/set_exponent_r8.c new file mode 100644 index 000000000..cb291d6d6 --- /dev/null +++ b/libgfortran/generated/set_exponent_r8.c @@ -0,0 +1,44 @@ +/* Implementation of the SET_EXPONENT intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname + +#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); + +GFC_REAL_8 +set_exponent_r8 (GFC_REAL_8 s, GFC_INTEGER_4 i) +{ + int dummy_exp; + return MATHFUNC(scalbn) (MATHFUNC(frexp) (s, &dummy_exp), i); +} + +#endif diff --git a/libgfortran/generated/shape_i16.c b/libgfortran/generated/shape_i16.c new file mode 100644 index 000000000..802e00aef --- /dev/null +++ b/libgfortran/generated/shape_i16.c @@ -0,0 +1,67 @@ +/* Implementation of the SHAPE intrinsic + Copyright 2002, 2006, 2007, 2009, 2010 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +extern void shape_16 (gfc_array_i16 * const restrict ret, + const gfc_array_i16 * const restrict array); +export_proto(shape_16); + +void +shape_16 (gfc_array_i16 * const restrict ret, + const gfc_array_i16 * const restrict array) +{ + int n; + index_type stride; + index_type extent; + int rank; + + rank = GFC_DESCRIPTOR_RANK (array); + + if (ret->data == NULL) + { + GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + ret->offset = 0; + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); + } + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) + return; + + for (n = 0; n < rank; n++) + { + extent = GFC_DESCRIPTOR_EXTENT(array,n); + ret->data[n * stride] = extent > 0 ? extent : 0 ; + } +} + +#endif diff --git a/libgfortran/generated/shape_i4.c b/libgfortran/generated/shape_i4.c new file mode 100644 index 000000000..fa2d4ebe2 --- /dev/null +++ b/libgfortran/generated/shape_i4.c @@ -0,0 +1,67 @@ +/* Implementation of the SHAPE intrinsic + Copyright 2002, 2006, 2007, 2009, 2010 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +extern void shape_4 (gfc_array_i4 * const restrict ret, + const gfc_array_i4 * const restrict array); +export_proto(shape_4); + +void +shape_4 (gfc_array_i4 * const restrict ret, + const gfc_array_i4 * const restrict array) +{ + int n; + index_type stride; + index_type extent; + int rank; + + rank = GFC_DESCRIPTOR_RANK (array); + + if (ret->data == NULL) + { + GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + ret->offset = 0; + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) + return; + + for (n = 0; n < rank; n++) + { + extent = GFC_DESCRIPTOR_EXTENT(array,n); + ret->data[n * stride] = extent > 0 ? extent : 0 ; + } +} + +#endif diff --git a/libgfortran/generated/shape_i8.c b/libgfortran/generated/shape_i8.c new file mode 100644 index 000000000..d6664de43 --- /dev/null +++ b/libgfortran/generated/shape_i8.c @@ -0,0 +1,67 @@ +/* Implementation of the SHAPE intrinsic + Copyright 2002, 2006, 2007, 2009, 2010 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +extern void shape_8 (gfc_array_i8 * const restrict ret, + const gfc_array_i8 * const restrict array); +export_proto(shape_8); + +void +shape_8 (gfc_array_i8 * const restrict ret, + const gfc_array_i8 * const restrict array) +{ + int n; + index_type stride; + index_type extent; + int rank; + + rank = GFC_DESCRIPTOR_RANK (array); + + if (ret->data == NULL) + { + GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + ret->offset = 0; + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) + return; + + for (n = 0; n < rank; n++) + { + extent = GFC_DESCRIPTOR_EXTENT(array,n); + ret->data[n * stride] = extent > 0 ? extent : 0 ; + } +} + +#endif diff --git a/libgfortran/generated/spacing_r10.c b/libgfortran/generated/spacing_r10.c new file mode 100644 index 000000000..6905557ad --- /dev/null +++ b/libgfortran/generated/spacing_r10.c @@ -0,0 +1,53 @@ +/* Implementation of the SPACING intrinsic + Copyright 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Steven G. Kargl + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## l + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_FREXPL) + +extern GFC_REAL_10 spacing_r10 (GFC_REAL_10 s, int p, int emin, GFC_REAL_10 tiny); +export_proto(spacing_r10); + +GFC_REAL_10 +spacing_r10 (GFC_REAL_10 s, int p, int emin, GFC_REAL_10 tiny) +{ + int e; + if (s == 0.) + return tiny; + MATHFUNC(frexp) (s, &e); + e = e - p; + e = e > emin ? e : emin; +#if defined (HAVE_LDEXPL) + return MATHFUNC(ldexp) (1., e); +#else + return MATHFUNC(scalbn) (1., e); +#endif +} + +#endif diff --git a/libgfortran/generated/spacing_r16.c b/libgfortran/generated/spacing_r16.c new file mode 100644 index 000000000..f58fa9640 --- /dev/null +++ b/libgfortran/generated/spacing_r16.c @@ -0,0 +1,57 @@ +/* Implementation of the SPACING intrinsic + Copyright 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Steven G. Kargl + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define MATHFUNC(funcname) funcname ## q +#else +#define MATHFUNC(funcname) funcname ## l +#endif + +#if defined (HAVE_GFC_REAL_16) && (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_FREXPL)) + +extern GFC_REAL_16 spacing_r16 (GFC_REAL_16 s, int p, int emin, GFC_REAL_16 tiny); +export_proto(spacing_r16); + +GFC_REAL_16 +spacing_r16 (GFC_REAL_16 s, int p, int emin, GFC_REAL_16 tiny) +{ + int e; + if (s == 0.) + return tiny; + MATHFUNC(frexp) (s, &e); + e = e - p; + e = e > emin ? e : emin; +#if (defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_LDEXPL)) + return MATHFUNC(ldexp) (1., e); +#else + return MATHFUNC(scalbn) (1., e); +#endif +} + +#endif diff --git a/libgfortran/generated/spacing_r4.c b/libgfortran/generated/spacing_r4.c new file mode 100644 index 000000000..44cf577bd --- /dev/null +++ b/libgfortran/generated/spacing_r4.c @@ -0,0 +1,53 @@ +/* Implementation of the SPACING intrinsic + Copyright 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Steven G. Kargl + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname ## f + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_FREXPF) + +extern GFC_REAL_4 spacing_r4 (GFC_REAL_4 s, int p, int emin, GFC_REAL_4 tiny); +export_proto(spacing_r4); + +GFC_REAL_4 +spacing_r4 (GFC_REAL_4 s, int p, int emin, GFC_REAL_4 tiny) +{ + int e; + if (s == 0.) + return tiny; + MATHFUNC(frexp) (s, &e); + e = e - p; + e = e > emin ? e : emin; +#if defined (HAVE_LDEXPF) + return MATHFUNC(ldexp) (1., e); +#else + return MATHFUNC(scalbn) (1., e); +#endif +} + +#endif diff --git a/libgfortran/generated/spacing_r8.c b/libgfortran/generated/spacing_r8.c new file mode 100644 index 000000000..4329adaa5 --- /dev/null +++ b/libgfortran/generated/spacing_r8.c @@ -0,0 +1,53 @@ +/* Implementation of the SPACING intrinsic + Copyright 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Steven G. Kargl + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + + +#define MATHFUNC(funcname) funcname + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_FREXP) + +extern GFC_REAL_8 spacing_r8 (GFC_REAL_8 s, int p, int emin, GFC_REAL_8 tiny); +export_proto(spacing_r8); + +GFC_REAL_8 +spacing_r8 (GFC_REAL_8 s, int p, int emin, GFC_REAL_8 tiny) +{ + int e; + if (s == 0.) + return tiny; + MATHFUNC(frexp) (s, &e); + e = e - p; + e = e > emin ? e : emin; +#if defined (HAVE_LDEXP) + return MATHFUNC(ldexp) (1., e); +#else + return MATHFUNC(scalbn) (1., e); +#endif +} + +#endif diff --git a/libgfortran/generated/spread_c10.c b/libgfortran/generated/spread_c10.c new file mode 100644 index 000000000..77a838f01 --- /dev/null +++ b/libgfortran/generated/spread_c10.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_10) + +void +spread_c10 (gfc_array_c10 *ret, const gfc_array_c10 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_COMPLEX_10 *rptr; + GFC_COMPLEX_10 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_COMPLEX_10 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_COMPLEX_10)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_c10 (gfc_array_c10 *ret, const GFC_COMPLEX_10 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_COMPLEX_10 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_10)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_c16.c b/libgfortran/generated/spread_c16.c new file mode 100644 index 000000000..1276e4dfb --- /dev/null +++ b/libgfortran/generated/spread_c16.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_16) + +void +spread_c16 (gfc_array_c16 *ret, const gfc_array_c16 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_COMPLEX_16 *rptr; + GFC_COMPLEX_16 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_COMPLEX_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_COMPLEX_16)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_c16 (gfc_array_c16 *ret, const GFC_COMPLEX_16 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_COMPLEX_16 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_16)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_c4.c b/libgfortran/generated/spread_c4.c new file mode 100644 index 000000000..5224e8477 --- /dev/null +++ b/libgfortran/generated/spread_c4.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_4) + +void +spread_c4 (gfc_array_c4 *ret, const gfc_array_c4 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_COMPLEX_4 *rptr; + GFC_COMPLEX_4 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_COMPLEX_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_COMPLEX_4)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_c4 (gfc_array_c4 *ret, const GFC_COMPLEX_4 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_COMPLEX_4 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_4)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_c8.c b/libgfortran/generated/spread_c8.c new file mode 100644 index 000000000..96ecb3afb --- /dev/null +++ b/libgfortran/generated/spread_c8.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_8) + +void +spread_c8 (gfc_array_c8 *ret, const gfc_array_c8 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_COMPLEX_8 *rptr; + GFC_COMPLEX_8 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_COMPLEX_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_COMPLEX_8)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_c8 (gfc_array_c8 *ret, const GFC_COMPLEX_8 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_COMPLEX_8 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_COMPLEX_8)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_i1.c b/libgfortran/generated/spread_i1.c new file mode 100644 index 000000000..e002c1462 --- /dev/null +++ b/libgfortran/generated/spread_i1.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) + +void +spread_i1 (gfc_array_i1 *ret, const gfc_array_i1 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_INTEGER_1 *rptr; + GFC_INTEGER_1 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_INTEGER_1 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_INTEGER_1)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_i1 (gfc_array_i1 *ret, const GFC_INTEGER_1 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_INTEGER_1 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_1)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_i16.c b/libgfortran/generated/spread_i16.c new file mode 100644 index 000000000..bdefdac32 --- /dev/null +++ b/libgfortran/generated/spread_i16.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +void +spread_i16 (gfc_array_i16 *ret, const gfc_array_i16 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_INTEGER_16 *rptr; + GFC_INTEGER_16 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_INTEGER_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_INTEGER_16)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_i16 (gfc_array_i16 *ret, const GFC_INTEGER_16 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_INTEGER_16 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_16)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_i2.c b/libgfortran/generated/spread_i2.c new file mode 100644 index 000000000..8482cfde8 --- /dev/null +++ b/libgfortran/generated/spread_i2.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) + +void +spread_i2 (gfc_array_i2 *ret, const gfc_array_i2 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_INTEGER_2 *rptr; + GFC_INTEGER_2 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_INTEGER_2 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_INTEGER_2)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_i2 (gfc_array_i2 *ret, const GFC_INTEGER_2 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_INTEGER_2 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_2)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_i4.c b/libgfortran/generated/spread_i4.c new file mode 100644 index 000000000..6eff6326b --- /dev/null +++ b/libgfortran/generated/spread_i4.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +void +spread_i4 (gfc_array_i4 *ret, const gfc_array_i4 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_INTEGER_4 *rptr; + GFC_INTEGER_4 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_INTEGER_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_INTEGER_4)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_i4 (gfc_array_i4 *ret, const GFC_INTEGER_4 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_INTEGER_4 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_4)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_i8.c b/libgfortran/generated/spread_i8.c new file mode 100644 index 000000000..293126363 --- /dev/null +++ b/libgfortran/generated/spread_i8.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +void +spread_i8 (gfc_array_i8 *ret, const gfc_array_i8 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_INTEGER_8 *rptr; + GFC_INTEGER_8 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_INTEGER_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_INTEGER_8)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_i8 (gfc_array_i8 *ret, const GFC_INTEGER_8 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_INTEGER_8 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_INTEGER_8)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_r10.c b/libgfortran/generated/spread_r10.c new file mode 100644 index 000000000..3c3f197b4 --- /dev/null +++ b/libgfortran/generated/spread_r10.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) + +void +spread_r10 (gfc_array_r10 *ret, const gfc_array_r10 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_REAL_10 *rptr; + GFC_REAL_10 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_REAL_10 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_REAL_10)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_r10 (gfc_array_r10 *ret, const GFC_REAL_10 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_REAL_10 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_10)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_r16.c b/libgfortran/generated/spread_r16.c new file mode 100644 index 000000000..131626096 --- /dev/null +++ b/libgfortran/generated/spread_r16.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) + +void +spread_r16 (gfc_array_r16 *ret, const gfc_array_r16 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_REAL_16 *rptr; + GFC_REAL_16 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_REAL_16 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_REAL_16)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_r16 (gfc_array_r16 *ret, const GFC_REAL_16 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_REAL_16 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_16)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_r4.c b/libgfortran/generated/spread_r4.c new file mode 100644 index 000000000..cc0f1197b --- /dev/null +++ b/libgfortran/generated/spread_r4.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) + +void +spread_r4 (gfc_array_r4 *ret, const gfc_array_r4 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_REAL_4 *rptr; + GFC_REAL_4 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_REAL_4 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_REAL_4)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_r4 (gfc_array_r4 *ret, const GFC_REAL_4 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_REAL_4 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_4)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/spread_r8.c b/libgfortran/generated/spread_r8.c new file mode 100644 index 000000000..f38ef3885 --- /dev/null +++ b/libgfortran/generated/spread_r8.c @@ -0,0 +1,271 @@ +/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) + +void +spread_r8 (gfc_array_r8 *ret, const gfc_array_r8 *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + GFC_REAL_8 *rptr; + GFC_REAL_8 * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const GFC_REAL_8 *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof(GFC_REAL_8)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_r8 (gfc_array_r8 *ret, const GFC_REAL_8 *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + GFC_REAL_8 * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof (GFC_REAL_8)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif + diff --git a/libgfortran/generated/sum_c10.c b/libgfortran/generated/sum_c10.c new file mode 100644 index 000000000..b982bfea0 --- /dev/null +++ b/libgfortran/generated/sum_c10.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_10) && defined (HAVE_GFC_COMPLEX_10) + + +extern void sum_c10 (gfc_array_c10 * const restrict, + gfc_array_c10 * const restrict, const index_type * const restrict); +export_proto(sum_c10); + +void +sum_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_COMPLEX_10 * restrict base; + GFC_COMPLEX_10 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_COMPLEX_10 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_c10 (gfc_array_c10 * const restrict, + gfc_array_c10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_c10); + +void +msum_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_10 * restrict dest; + const GFC_COMPLEX_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_COMPLEX_10 * restrict src; + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_c10 (gfc_array_c10 * const restrict, + gfc_array_c10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_c10); + +void +ssum_c10 (gfc_array_c10 * const restrict retarray, + gfc_array_c10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_10 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_c10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_c16.c b/libgfortran/generated/sum_c16.c new file mode 100644 index 000000000..0bf2b69d7 --- /dev/null +++ b/libgfortran/generated/sum_c16.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_16) && defined (HAVE_GFC_COMPLEX_16) + + +extern void sum_c16 (gfc_array_c16 * const restrict, + gfc_array_c16 * const restrict, const index_type * const restrict); +export_proto(sum_c16); + +void +sum_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_COMPLEX_16 * restrict base; + GFC_COMPLEX_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_COMPLEX_16 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_c16 (gfc_array_c16 * const restrict, + gfc_array_c16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_c16); + +void +msum_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_16 * restrict dest; + const GFC_COMPLEX_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_COMPLEX_16 * restrict src; + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_c16 (gfc_array_c16 * const restrict, + gfc_array_c16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_c16); + +void +ssum_c16 (gfc_array_c16 * const restrict retarray, + gfc_array_c16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_c16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c new file mode 100644 index 000000000..a34e63cdd --- /dev/null +++ b/libgfortran/generated/sum_c4.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_4) && defined (HAVE_GFC_COMPLEX_4) + + +extern void sum_c4 (gfc_array_c4 * const restrict, + gfc_array_c4 * const restrict, const index_type * const restrict); +export_proto(sum_c4); + +void +sum_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_COMPLEX_4 * restrict base; + GFC_COMPLEX_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_COMPLEX_4 * restrict src; + GFC_COMPLEX_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_c4 (gfc_array_c4 * const restrict, + gfc_array_c4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_c4); + +void +msum_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_4 * restrict dest; + const GFC_COMPLEX_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_COMPLEX_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_COMPLEX_4 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_c4 (gfc_array_c4 * const restrict, + gfc_array_c4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_c4); + +void +ssum_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_c4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_c8.c b/libgfortran/generated/sum_c8.c new file mode 100644 index 000000000..42dea7b28 --- /dev/null +++ b/libgfortran/generated/sum_c8.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_8) && defined (HAVE_GFC_COMPLEX_8) + + +extern void sum_c8 (gfc_array_c8 * const restrict, + gfc_array_c8 * const restrict, const index_type * const restrict); +export_proto(sum_c8); + +void +sum_c8 (gfc_array_c8 * const restrict retarray, + gfc_array_c8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_COMPLEX_8 * restrict base; + GFC_COMPLEX_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_COMPLEX_8 * restrict src; + GFC_COMPLEX_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_c8 (gfc_array_c8 * const restrict, + gfc_array_c8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_c8); + +void +msum_c8 (gfc_array_c8 * const restrict retarray, + gfc_array_c8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_8 * restrict dest; + const GFC_COMPLEX_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_COMPLEX_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_COMPLEX_8 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_c8 (gfc_array_c8 * const restrict, + gfc_array_c8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_c8); + +void +ssum_c8 (gfc_array_c8 * const restrict retarray, + gfc_array_c8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_COMPLEX_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_c8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_COMPLEX_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_i1.c b/libgfortran/generated/sum_i1.c new file mode 100644 index 000000000..4eb6d6420 --- /dev/null +++ b/libgfortran/generated/sum_i1.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1) + + +extern void sum_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict); +export_proto(sum_i1); + +void +sum_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_1 * restrict base; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_1 * restrict src; + GFC_INTEGER_1 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_i1); + +void +msum_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + const GFC_INTEGER_1 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_1 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_1 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_i1 (gfc_array_i1 * const restrict, + gfc_array_i1 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_i1); + +void +ssum_i1 (gfc_array_i1 * const restrict retarray, + gfc_array_i1 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_1 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_i1 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_i16.c b/libgfortran/generated/sum_i16.c new file mode 100644 index 000000000..8e2c7b3ae --- /dev/null +++ b/libgfortran/generated/sum_i16.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) + + +extern void sum_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict); +export_proto(sum_i16); + +void +sum_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_16 * restrict base; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_16 * restrict src; + GFC_INTEGER_16 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_i16); + +void +msum_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + const GFC_INTEGER_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_16 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_16 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_i16 (gfc_array_i16 * const restrict, + gfc_array_i16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_i16); + +void +ssum_i16 (gfc_array_i16 * const restrict retarray, + gfc_array_i16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_i16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_i2.c b/libgfortran/generated/sum_i2.c new file mode 100644 index 000000000..12ef64d35 --- /dev/null +++ b/libgfortran/generated/sum_i2.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) && defined (HAVE_GFC_INTEGER_2) + + +extern void sum_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict); +export_proto(sum_i2); + +void +sum_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_2 * restrict base; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_2 * restrict src; + GFC_INTEGER_2 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_i2); + +void +msum_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + const GFC_INTEGER_2 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_2 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_2 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_i2 (gfc_array_i2 * const restrict, + gfc_array_i2 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_i2); + +void +ssum_i2 (gfc_array_i2 * const restrict retarray, + gfc_array_i2 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_2 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_i2 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_2) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_i4.c b/libgfortran/generated/sum_i4.c new file mode 100644 index 000000000..645ef436b --- /dev/null +++ b/libgfortran/generated/sum_i4.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) + + +extern void sum_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict); +export_proto(sum_i4); + +void +sum_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_4 * restrict base; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_4 * restrict src; + GFC_INTEGER_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_i4); + +void +msum_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + const GFC_INTEGER_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_i4 (gfc_array_i4 * const restrict, + gfc_array_i4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_i4); + +void +ssum_i4 (gfc_array_i4 * const restrict retarray, + gfc_array_i4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_i4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_i8.c b/libgfortran/generated/sum_i8.c new file mode 100644 index 000000000..adb29b51c --- /dev/null +++ b/libgfortran/generated/sum_i8.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) + + +extern void sum_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict); +export_proto(sum_i8); + +void +sum_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_INTEGER_8 * restrict base; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_INTEGER_8 * restrict src; + GFC_INTEGER_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_i8); + +void +msum_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + const GFC_INTEGER_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_INTEGER_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_i8 (gfc_array_i8 * const restrict, + gfc_array_i8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_i8); + +void +ssum_i8 (gfc_array_i8 * const restrict retarray, + gfc_array_i8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_INTEGER_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_i8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_r10.c b/libgfortran/generated/sum_r10.c new file mode 100644 index 000000000..9f588a5da --- /dev/null +++ b/libgfortran/generated/sum_r10.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_REAL_10) + + +extern void sum_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict); +export_proto(sum_r10); + +void +sum_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_10 * restrict base; + GFC_REAL_10 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_10 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_r10); + +void +msum_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 * restrict dest; + const GFC_REAL_10 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_10 * restrict src; + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_r10 (gfc_array_r10 * const restrict, + gfc_array_r10 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_r10); + +void +ssum_r10 (gfc_array_r10 * const restrict retarray, + gfc_array_r10 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_10 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_r10 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_10) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_r16.c b/libgfortran/generated/sum_r16.c new file mode 100644 index 000000000..292e66f71 --- /dev/null +++ b/libgfortran/generated/sum_r16.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_16) && defined (HAVE_GFC_REAL_16) + + +extern void sum_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict); +export_proto(sum_r16); + +void +sum_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_16 * restrict base; + GFC_REAL_16 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_16 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_r16); + +void +msum_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 * restrict dest; + const GFC_REAL_16 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_16 * restrict src; + const GFC_LOGICAL_1 * restrict 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 probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_r16 (gfc_array_r16 * const restrict, + gfc_array_r16 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_r16); + +void +ssum_r16 (gfc_array_r16 * const restrict retarray, + gfc_array_r16 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_16 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_r16 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_16) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_r4.c b/libgfortran/generated/sum_r4.c new file mode 100644 index 000000000..8fd563fc9 --- /dev/null +++ b/libgfortran/generated/sum_r4.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_REAL_4) + + +extern void sum_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict); +export_proto(sum_r4); + +void +sum_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_4 * restrict base; + GFC_REAL_4 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_4 * restrict src; + GFC_REAL_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_r4); + +void +msum_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_4 * restrict dest; + const GFC_REAL_4 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_4 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_4 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_r4 (gfc_array_r4 * const restrict, + gfc_array_r4 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_r4); + +void +ssum_r4 (gfc_array_r4 * const restrict retarray, + gfc_array_r4 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_4 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_r4 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_4) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/sum_r8.c b/libgfortran/generated/sum_r8.c new file mode 100644 index 000000000..e58398060 --- /dev/null +++ b/libgfortran/generated/sum_r8.c @@ -0,0 +1,508 @@ +/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +#if defined (HAVE_GFC_REAL_8) && defined (HAVE_GFC_REAL_8) + + +extern void sum_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict); +export_proto(sum_r8); + +void +sum_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_REAL_8 * restrict base; + GFC_REAL_8 * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_REAL_8 * restrict src; + GFC_REAL_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void msum_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(msum_r8); + +void +msum_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_8 * restrict dest; + const GFC_REAL_8 * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const GFC_REAL_8 * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + GFC_REAL_8 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + + +extern void ssum_r8 (gfc_array_r8 * const restrict, + gfc_array_r8 * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(ssum_r8); + +void +ssum_r8 (gfc_array_r8 * const restrict retarray, + gfc_array_r8 * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + GFC_REAL_8 * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + sum_r8 (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (GFC_REAL_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = 0; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +} + +#endif diff --git a/libgfortran/generated/transpose_c10.c b/libgfortran/generated/transpose_c10.c new file mode 100644 index 000000000..e740d12a7 --- /dev/null +++ b/libgfortran/generated/transpose_c10.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_COMPLEX_10) + +extern void transpose_c10 (gfc_array_c10 * const restrict ret, + gfc_array_c10 * const restrict source); +export_proto(transpose_c10); + +void +transpose_c10 (gfc_array_c10 * const restrict ret, + gfc_array_c10 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_COMPLEX_10 * restrict 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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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 index 000000000..31115bdfd --- /dev/null +++ b/libgfortran/generated/transpose_c16.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_COMPLEX_16) + +extern void transpose_c16 (gfc_array_c16 * const restrict ret, + gfc_array_c16 * const restrict source); +export_proto(transpose_c16); + +void +transpose_c16 (gfc_array_c16 * const restrict ret, + gfc_array_c16 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_COMPLEX_16 * restrict 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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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_c4.c b/libgfortran/generated/transpose_c4.c new file mode 100644 index 000000000..a63f62c95 --- /dev/null +++ b/libgfortran/generated/transpose_c4.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_COMPLEX_4) + +extern void transpose_c4 (gfc_array_c4 * const restrict ret, + gfc_array_c4 * const restrict source); +export_proto(transpose_c4); + +void +transpose_c4 (gfc_array_c4 * const restrict ret, + gfc_array_c4 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_COMPLEX_4 * restrict rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_COMPLEX_4 *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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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_c8.c b/libgfortran/generated/transpose_c8.c new file mode 100644 index 000000000..832239403 --- /dev/null +++ b/libgfortran/generated/transpose_c8.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_COMPLEX_8) + +extern void transpose_c8 (gfc_array_c8 * const restrict ret, + gfc_array_c8 * const restrict source); +export_proto(transpose_c8); + +void +transpose_c8 (gfc_array_c8 * const restrict ret, + gfc_array_c8 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_COMPLEX_8 * restrict rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_COMPLEX_8 *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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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_i16.c b/libgfortran/generated/transpose_i16.c new file mode 100644 index 000000000..f8cfd823f --- /dev/null +++ b/libgfortran/generated/transpose_i16.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +extern void transpose_i16 (gfc_array_i16 * const restrict ret, + gfc_array_i16 * const restrict source); +export_proto(transpose_i16); + +void +transpose_i16 (gfc_array_i16 * const restrict ret, + gfc_array_i16 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_INTEGER_16 * restrict 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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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_i4.c b/libgfortran/generated/transpose_i4.c new file mode 100644 index 000000000..9b15e4702 --- /dev/null +++ b/libgfortran/generated/transpose_i4.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +extern void transpose_i4 (gfc_array_i4 * const restrict ret, + gfc_array_i4 * const restrict source); +export_proto(transpose_i4); + +void +transpose_i4 (gfc_array_i4 * const restrict ret, + gfc_array_i4 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_INTEGER_4 * restrict rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_INTEGER_4 *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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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_i8.c b/libgfortran/generated/transpose_i8.c new file mode 100644 index 000000000..ddf772b0e --- /dev/null +++ b/libgfortran/generated/transpose_i8.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +extern void transpose_i8 (gfc_array_i8 * const restrict ret, + gfc_array_i8 * const restrict source); +export_proto(transpose_i8); + +void +transpose_i8 (gfc_array_i8 * const restrict ret, + gfc_array_i8 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_INTEGER_8 * restrict rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_INTEGER_8 *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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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_r10.c b/libgfortran/generated/transpose_r10.c new file mode 100644 index 000000000..2b2e02d1c --- /dev/null +++ b/libgfortran/generated/transpose_r10.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_REAL_10) + +extern void transpose_r10 (gfc_array_r10 * const restrict ret, + gfc_array_r10 * const restrict source); +export_proto(transpose_r10); + +void +transpose_r10 (gfc_array_r10 * const restrict ret, + gfc_array_r10 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_REAL_10 * restrict rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_REAL_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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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_r16.c b/libgfortran/generated/transpose_r16.c new file mode 100644 index 000000000..4d2e40660 --- /dev/null +++ b/libgfortran/generated/transpose_r16.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_REAL_16) + +extern void transpose_r16 (gfc_array_r16 * const restrict ret, + gfc_array_r16 * const restrict source); +export_proto(transpose_r16); + +void +transpose_r16 (gfc_array_r16 * const restrict ret, + gfc_array_r16 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_REAL_16 * restrict rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_REAL_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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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_r4.c b/libgfortran/generated/transpose_r4.c new file mode 100644 index 000000000..1748c1d05 --- /dev/null +++ b/libgfortran/generated/transpose_r4.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_REAL_4) + +extern void transpose_r4 (gfc_array_r4 * const restrict ret, + gfc_array_r4 * const restrict source); +export_proto(transpose_r4); + +void +transpose_r4 (gfc_array_r4 * const restrict ret, + gfc_array_r4 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_REAL_4 * restrict rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_REAL_4 *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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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_r8.c b/libgfortran/generated/transpose_r8.c new file mode 100644 index 000000000..09054b613 --- /dev/null +++ b/libgfortran/generated/transpose_r8.c @@ -0,0 +1,114 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +#if defined (HAVE_GFC_REAL_8) + +extern void transpose_r8 (gfc_array_r8 * const restrict ret, + gfc_array_r8 * const restrict source); +export_proto(transpose_r8); + +void +transpose_r8 (gfc_array_r8 * const restrict ret, + gfc_array_r8 * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_REAL_8 * restrict rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_REAL_8 *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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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/unpack_c10.c b/libgfortran/generated/unpack_c10.c new file mode 100644 index 000000000..9b89a5bea --- /dev/null +++ b/libgfortran/generated/unpack_c10.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_10) + +void +unpack0_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, + const gfc_array_l1 *mask, const GFC_COMPLEX_10 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_10 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_10 *vptr; + /* Value for field, this is constant. */ + const GFC_COMPLEX_10 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_10)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_c10 (gfc_array_c10 *ret, const gfc_array_c10 *vector, + const gfc_array_l1 *mask, const gfc_array_c10 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_10 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_10 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_COMPLEX_10 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_10)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_c16.c b/libgfortran/generated/unpack_c16.c new file mode 100644 index 000000000..2d9931f02 --- /dev/null +++ b/libgfortran/generated/unpack_c16.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_16) + +void +unpack0_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, + const gfc_array_l1 *mask, const GFC_COMPLEX_16 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_16 *vptr; + /* Value for field, this is constant. */ + const GFC_COMPLEX_16 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_c16 (gfc_array_c16 *ret, const gfc_array_c16 *vector, + const gfc_array_l1 *mask, const gfc_array_c16 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_16 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_COMPLEX_16 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_c4.c b/libgfortran/generated/unpack_c4.c new file mode 100644 index 000000000..116f213f9 --- /dev/null +++ b/libgfortran/generated/unpack_c4.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_4) + +void +unpack0_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, + const gfc_array_l1 *mask, const GFC_COMPLEX_4 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_4 *vptr; + /* Value for field, this is constant. */ + const GFC_COMPLEX_4 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_c4 (gfc_array_c4 *ret, const gfc_array_c4 *vector, + const gfc_array_l1 *mask, const gfc_array_c4 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_4 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_COMPLEX_4 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_c8.c b/libgfortran/generated/unpack_c8.c new file mode 100644 index 000000000..7298eecee --- /dev/null +++ b/libgfortran/generated/unpack_c8.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_COMPLEX_8) + +void +unpack0_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, + const gfc_array_l1 *mask, const GFC_COMPLEX_8 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_8 *vptr; + /* Value for field, this is constant. */ + const GFC_COMPLEX_8 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_c8 (gfc_array_c8 *ret, const gfc_array_c8 *vector, + const gfc_array_l1 *mask, const gfc_array_c8 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_COMPLEX_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_COMPLEX_8 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_COMPLEX_8 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_COMPLEX_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_i1.c b/libgfortran/generated/unpack_i1.c new file mode 100644 index 000000000..f5dcb93df --- /dev/null +++ b/libgfortran/generated/unpack_i1.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_1) + +void +unpack0_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, + const gfc_array_l1 *mask, const GFC_INTEGER_1 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_1 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_1 *vptr; + /* Value for field, this is constant. */ + const GFC_INTEGER_1 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_1)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_i1 (gfc_array_i1 *ret, const gfc_array_i1 *vector, + const gfc_array_l1 *mask, const gfc_array_i1 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_1 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_1 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_INTEGER_1 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_1)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_i16.c b/libgfortran/generated/unpack_i16.c new file mode 100644 index 000000000..77920ea60 --- /dev/null +++ b/libgfortran/generated/unpack_i16.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_16) + +void +unpack0_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, + const gfc_array_l1 *mask, const GFC_INTEGER_16 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_16 *vptr; + /* Value for field, this is constant. */ + const GFC_INTEGER_16 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_i16 (gfc_array_i16 *ret, const gfc_array_i16 *vector, + const gfc_array_l1 *mask, const gfc_array_i16 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_16 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_INTEGER_16 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_i2.c b/libgfortran/generated/unpack_i2.c new file mode 100644 index 000000000..c7257bb2f --- /dev/null +++ b/libgfortran/generated/unpack_i2.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_2) + +void +unpack0_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, + const gfc_array_l1 *mask, const GFC_INTEGER_2 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_2 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_2 *vptr; + /* Value for field, this is constant. */ + const GFC_INTEGER_2 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_2)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_i2 (gfc_array_i2 *ret, const gfc_array_i2 *vector, + const gfc_array_l1 *mask, const gfc_array_i2 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_2 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_2 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_INTEGER_2 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_2)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_i4.c b/libgfortran/generated/unpack_i4.c new file mode 100644 index 000000000..e3cdde677 --- /dev/null +++ b/libgfortran/generated/unpack_i4.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_4) + +void +unpack0_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, + const gfc_array_l1 *mask, const GFC_INTEGER_4 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_4 *vptr; + /* Value for field, this is constant. */ + const GFC_INTEGER_4 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_i4 (gfc_array_i4 *ret, const gfc_array_i4 *vector, + const gfc_array_l1 *mask, const gfc_array_i4 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_4 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_INTEGER_4 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_i8.c b/libgfortran/generated/unpack_i8.c new file mode 100644 index 000000000..2f7206403 --- /dev/null +++ b/libgfortran/generated/unpack_i8.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_INTEGER_8) + +void +unpack0_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, + const gfc_array_l1 *mask, const GFC_INTEGER_8 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_8 *vptr; + /* Value for field, this is constant. */ + const GFC_INTEGER_8 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_i8 (gfc_array_i8 *ret, const gfc_array_i8 *vector, + const gfc_array_l1 *mask, const gfc_array_i8 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_INTEGER_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_INTEGER_8 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_INTEGER_8 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_r10.c b/libgfortran/generated/unpack_r10.c new file mode 100644 index 000000000..796df2edd --- /dev/null +++ b/libgfortran/generated/unpack_r10.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_10) + +void +unpack0_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, + const gfc_array_l1 *mask, const GFC_REAL_10 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_10 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_10 *vptr; + /* Value for field, this is constant. */ + const GFC_REAL_10 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_10)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_r10 (gfc_array_r10 *ret, const gfc_array_r10 *vector, + const gfc_array_l1 *mask, const gfc_array_r10 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_10 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_10 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_REAL_10 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_10)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_r16.c b/libgfortran/generated/unpack_r16.c new file mode 100644 index 000000000..b25d2869a --- /dev/null +++ b/libgfortran/generated/unpack_r16.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_16) + +void +unpack0_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, + const gfc_array_l1 *mask, const GFC_REAL_16 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_16 *vptr; + /* Value for field, this is constant. */ + const GFC_REAL_16 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_r16 (gfc_array_r16 *ret, const gfc_array_r16 *vector, + const gfc_array_l1 *mask, const gfc_array_r16 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_16 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_16 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_REAL_16 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_16)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_r4.c b/libgfortran/generated/unpack_r4.c new file mode 100644 index 000000000..f4b763fc1 --- /dev/null +++ b/libgfortran/generated/unpack_r4.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_4) + +void +unpack0_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, + const gfc_array_l1 *mask, const GFC_REAL_4 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_4 *vptr; + /* Value for field, this is constant. */ + const GFC_REAL_4 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_r4 (gfc_array_r4 *ret, const gfc_array_r4 *vector, + const gfc_array_l1 *mask, const gfc_array_r4 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_4 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_4 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_REAL_4 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_4)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/generated/unpack_r8.c b/libgfortran/generated/unpack_r8.c new file mode 100644 index 000000000..dc9b4d398 --- /dev/null +++ b/libgfortran/generated/unpack_r8.c @@ -0,0 +1,331 @@ +/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#if defined (HAVE_GFC_REAL_8) + +void +unpack0_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, + const gfc_array_l1 *mask, const GFC_REAL_8 *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_8 *vptr; + /* Value for field, this is constant. */ + const GFC_REAL_8 fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_r8 (gfc_array_r8 *ret, const gfc_array_r8 *vector, + const gfc_array_l1 *mask, const gfc_array_r8 *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + GFC_REAL_8 * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + GFC_REAL_8 *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const GFC_REAL_8 *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof (GFC_REAL_8)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif + diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map new file mode 100644 index 000000000..211db00cd --- /dev/null +++ b/libgfortran/gfortran.map @@ -0,0 +1,1351 @@ +GFORTRAN_1.0 { + global: + _gfortran_abort; + _gfortran_access_func; + _gfortran_adjustl; + _gfortran_adjustr; + _gfortran_alarm_sub_i4; + _gfortran_alarm_sub_i8; + _gfortran_alarm_sub_int_i4; + _gfortran_alarm_sub_int_i8; + _gfortran_all_l1; + _gfortran_all_l16; + _gfortran_all_l2; + _gfortran_all_l4; + _gfortran_all_l8; + _gfortran_any_l1; + _gfortran_any_l16; + _gfortran_any_l2; + _gfortran_any_l4; + _gfortran_any_l8; + _gfortran_arandom_r10; + _gfortran_arandom_r16; + _gfortran_arandom_r4; + _gfortran_arandom_r8; + _gfortran_associated; + _gfortran_chdir_i4; + _gfortran_chdir_i4_sub; + _gfortran_chdir_i8; + _gfortran_chdir_i8_sub; + _gfortran_chmod_func; + _gfortran_chmod_i4_sub; + _gfortran_chmod_i8_sub; + _gfortran_compare_string; + _gfortran_concat_string; + _gfortran_count_1_l; + _gfortran_count_16_l; + _gfortran_count_2_l; + _gfortran_count_4_l; + _gfortran_count_8_l; + _gfortran_cpu_time_10; + _gfortran_cpu_time_16; + _gfortran_cpu_time_4; + _gfortran_cpu_time_8; + _gfortran_cshift0_1; + _gfortran_cshift0_1_char; + _gfortran_cshift0_2; + _gfortran_cshift0_2_char; + _gfortran_cshift0_4; + _gfortran_cshift0_4_char; + _gfortran_cshift0_8; + _gfortran_cshift0_8_char; + _gfortran_cshift1_16; + _gfortran_cshift1_16_char; + _gfortran_cshift1_4; + _gfortran_cshift1_4_char; + _gfortran_cshift1_8; + _gfortran_cshift1_8_char; + _gfortran_ctime; + _gfortran_ctime_sub; + _gfortran_date_and_time; + _gfortran_dtime; + _gfortran_dtime_sub; + _gfortran_eoshift0_1; + _gfortran_eoshift0_1_char; + _gfortran_eoshift0_2; + _gfortran_eoshift0_2_char; + _gfortran_eoshift0_4; + _gfortran_eoshift0_4_char; + _gfortran_eoshift0_8; + _gfortran_eoshift0_8_char; + _gfortran_eoshift1_16; + _gfortran_eoshift1_16_char; + _gfortran_eoshift1_4; + _gfortran_eoshift1_4_char; + _gfortran_eoshift1_8; + _gfortran_eoshift1_8_char; + _gfortran_eoshift2_1; + _gfortran_eoshift2_1_char; + _gfortran_eoshift2_2; + _gfortran_eoshift2_2_char; + _gfortran_eoshift2_4; + _gfortran_eoshift2_4_char; + _gfortran_eoshift2_8; + _gfortran_eoshift2_8_char; + _gfortran_eoshift3_16; + _gfortran_eoshift3_16_char; + _gfortran_eoshift3_4; + _gfortran_eoshift3_4_char; + _gfortran_eoshift3_8; + _gfortran_eoshift3_8_char; + _gfortran_etime; + _gfortran_etime_sub; + _gfortran_exit_i4; + _gfortran_exit_i8; + _gfortran_exponent_r10; + _gfortran_exponent_r16; + _gfortran_exponent_r4; + _gfortran_exponent_r8; + _gfortran_fdate; + _gfortran_fdate_sub; + _gfortran_fget; + _gfortran_fgetc; + _gfortran_fgetc_i1_sub; + _gfortran_fgetc_i2_sub; + _gfortran_fgetc_i4_sub; + _gfortran_fgetc_i8_sub; + _gfortran_fget_i1_sub; + _gfortran_fget_i2_sub; + _gfortran_fget_i4_sub; + _gfortran_fget_i8_sub; + _gfortran_flush_i4; + _gfortran_flush_i8; + _gfortran_fnum_i4; + _gfortran_fnum_i8; + _gfortran_fput; + _gfortran_fputc; + _gfortran_fputc_i1_sub; + _gfortran_fputc_i2_sub; + _gfortran_fputc_i4_sub; + _gfortran_fputc_i8_sub; + _gfortran_fput_i1_sub; + _gfortran_fput_i2_sub; + _gfortran_fput_i4_sub; + _gfortran_fput_i8_sub; + _gfortran_fraction_r10; + _gfortran_fraction_r16; + _gfortran_fraction_r4; + _gfortran_fraction_r8; + _gfortran_free; + _gfortran_fseek_sub; + _gfortran_fstat_i4; + _gfortran_fstat_i4_sub; + _gfortran_fstat_i8; + _gfortran_fstat_i8_sub; + _gfortran_ftell; + _gfortran_ftell_i1_sub; + _gfortran_ftell_i2_sub; + _gfortran_ftell_i4_sub; + _gfortran_ftell_i8_sub; + _gfortran_generate_error; + _gfortran_gerror; + _gfortran_getarg_i4; + _gfortran_getarg_i8; + _gfortran_get_command_argument_i4; + _gfortran_get_command_argument_i8; + _gfortran_get_command_i4; + _gfortran_get_command_i8; + _gfortran_getcwd; + _gfortran_getcwd_i4_sub; + _gfortran_getcwd_i8_sub; + _gfortran_getenv; + _gfortran_get_environment_variable_i4; + _gfortran_get_environment_variable_i8; + _gfortran_getgid; + _gfortran_getlog; + _gfortran_getpid; + _gfortran_getuid; + _gfortran_gmtime_i4; + _gfortran_gmtime_i8; + _gfortran_hostnm; + _gfortran_hostnm_i4_sub; + _gfortran_hostnm_i8_sub; + _gfortran_iargc; + _gfortran_idate_i4; + _gfortran_idate_i8; + _gfortran_ierrno_i4; + _gfortran_ierrno_i8; + _gfortran_internal_pack; + _gfortran_internal_unpack; + _gfortran_irand; + _gfortran_isatty_l4; + _gfortran_isatty_l8; + _gfortran_ishftc16; + _gfortran_ishftc4; + _gfortran_ishftc8; + _gfortran_itime_i4; + _gfortran_itime_i8; + _gfortran_kill_i4; + _gfortran_kill_i4_sub; + _gfortran_kill_i8; + _gfortran_kill_i8_sub; + _gfortran_link_i4; + _gfortran_link_i4_sub; + _gfortran_link_i8; + _gfortran_link_i8_sub; + _gfortran_lstat_i4; + _gfortran_lstat_i4_sub; + _gfortran_lstat_i8; + _gfortran_lstat_i8_sub; + _gfortran_ltime_i4; + _gfortran_ltime_i8; + _gfortran_malloc; + _gfortran_matmul_c10; + _gfortran_matmul_c16; + _gfortran_matmul_c4; + _gfortran_matmul_c8; + _gfortran_matmul_i1; + _gfortran_matmul_i16; + _gfortran_matmul_i2; + _gfortran_matmul_i4; + _gfortran_matmul_i8; + _gfortran_matmul_l16; + _gfortran_matmul_l4; + _gfortran_matmul_l8; + _gfortran_matmul_r10; + _gfortran_matmul_r16; + _gfortran_matmul_r4; + _gfortran_matmul_r8; + _gfortran_maxloc0_16_i1; + _gfortran_maxloc0_16_i16; + _gfortran_maxloc0_16_i2; + _gfortran_maxloc0_16_i4; + _gfortran_maxloc0_16_i8; + _gfortran_maxloc0_16_r10; + _gfortran_maxloc0_16_r16; + _gfortran_maxloc0_16_r4; + _gfortran_maxloc0_16_r8; + _gfortran_maxloc0_4_i1; + _gfortran_maxloc0_4_i16; + _gfortran_maxloc0_4_i2; + _gfortran_maxloc0_4_i4; + _gfortran_maxloc0_4_i8; + _gfortran_maxloc0_4_r10; + _gfortran_maxloc0_4_r16; + _gfortran_maxloc0_4_r4; + _gfortran_maxloc0_4_r8; + _gfortran_maxloc0_8_i1; + _gfortran_maxloc0_8_i16; + _gfortran_maxloc0_8_i2; + _gfortran_maxloc0_8_i4; + _gfortran_maxloc0_8_i8; + _gfortran_maxloc0_8_r10; + _gfortran_maxloc0_8_r16; + _gfortran_maxloc0_8_r4; + _gfortran_maxloc0_8_r8; + _gfortran_maxloc1_16_i1; + _gfortran_maxloc1_16_i16; + _gfortran_maxloc1_16_i2; + _gfortran_maxloc1_16_i4; + _gfortran_maxloc1_16_i8; + _gfortran_maxloc1_16_r10; + _gfortran_maxloc1_16_r16; + _gfortran_maxloc1_16_r4; + _gfortran_maxloc1_16_r8; + _gfortran_maxloc1_4_i1; + _gfortran_maxloc1_4_i16; + _gfortran_maxloc1_4_i2; + _gfortran_maxloc1_4_i4; + _gfortran_maxloc1_4_i8; + _gfortran_maxloc1_4_r10; + _gfortran_maxloc1_4_r16; + _gfortran_maxloc1_4_r4; + _gfortran_maxloc1_4_r8; + _gfortran_maxloc1_8_i1; + _gfortran_maxloc1_8_i16; + _gfortran_maxloc1_8_i2; + _gfortran_maxloc1_8_i4; + _gfortran_maxloc1_8_i8; + _gfortran_maxloc1_8_r10; + _gfortran_maxloc1_8_r16; + _gfortran_maxloc1_8_r4; + _gfortran_maxloc1_8_r8; + _gfortran_maxval_i1; + _gfortran_maxval_i16; + _gfortran_maxval_i2; + _gfortran_maxval_i4; + _gfortran_maxval_i8; + _gfortran_maxval_r10; + _gfortran_maxval_r16; + _gfortran_maxval_r4; + _gfortran_maxval_r8; + _gfortran_mclock; + _gfortran_mclock8; + _gfortran_minloc0_16_i1; + _gfortran_minloc0_16_i16; + _gfortran_minloc0_16_i2; + _gfortran_minloc0_16_i4; + _gfortran_minloc0_16_i8; + _gfortran_minloc0_16_r10; + _gfortran_minloc0_16_r16; + _gfortran_minloc0_16_r4; + _gfortran_minloc0_16_r8; + _gfortran_minloc0_4_i1; + _gfortran_minloc0_4_i16; + _gfortran_minloc0_4_i2; + _gfortran_minloc0_4_i4; + _gfortran_minloc0_4_i8; + _gfortran_minloc0_4_r10; + _gfortran_minloc0_4_r16; + _gfortran_minloc0_4_r4; + _gfortran_minloc0_4_r8; + _gfortran_minloc0_8_i1; + _gfortran_minloc0_8_i16; + _gfortran_minloc0_8_i2; + _gfortran_minloc0_8_i4; + _gfortran_minloc0_8_i8; + _gfortran_minloc0_8_r10; + _gfortran_minloc0_8_r16; + _gfortran_minloc0_8_r4; + _gfortran_minloc0_8_r8; + _gfortran_minloc1_16_i1; + _gfortran_minloc1_16_i16; + _gfortran_minloc1_16_i2; + _gfortran_minloc1_16_i4; + _gfortran_minloc1_16_i8; + _gfortran_minloc1_16_r10; + _gfortran_minloc1_16_r16; + _gfortran_minloc1_16_r4; + _gfortran_minloc1_16_r8; + _gfortran_minloc1_4_i1; + _gfortran_minloc1_4_i16; + _gfortran_minloc1_4_i2; + _gfortran_minloc1_4_i4; + _gfortran_minloc1_4_i8; + _gfortran_minloc1_4_r10; + _gfortran_minloc1_4_r16; + _gfortran_minloc1_4_r4; + _gfortran_minloc1_4_r8; + _gfortran_minloc1_8_i1; + _gfortran_minloc1_8_i16; + _gfortran_minloc1_8_i2; + _gfortran_minloc1_8_i4; + _gfortran_minloc1_8_i8; + _gfortran_minloc1_8_r10; + _gfortran_minloc1_8_r16; + _gfortran_minloc1_8_r4; + _gfortran_minloc1_8_r8; + _gfortran_minval_i1; + _gfortran_minval_i16; + _gfortran_minval_i2; + _gfortran_minval_i4; + _gfortran_minval_i8; + _gfortran_minval_r10; + _gfortran_minval_r16; + _gfortran_minval_r4; + _gfortran_minval_r8; + _gfortran_mmaxloc0_16_i1; + _gfortran_mmaxloc0_16_i16; + _gfortran_mmaxloc0_16_i2; + _gfortran_mmaxloc0_16_i4; + _gfortran_mmaxloc0_16_i8; + _gfortran_mmaxloc0_16_r10; + _gfortran_mmaxloc0_16_r16; + _gfortran_mmaxloc0_16_r4; + _gfortran_mmaxloc0_16_r8; + _gfortran_mmaxloc0_4_i1; + _gfortran_mmaxloc0_4_i16; + _gfortran_mmaxloc0_4_i2; + _gfortran_mmaxloc0_4_i4; + _gfortran_mmaxloc0_4_i8; + _gfortran_mmaxloc0_4_r10; + _gfortran_mmaxloc0_4_r16; + _gfortran_mmaxloc0_4_r4; + _gfortran_mmaxloc0_4_r8; + _gfortran_mmaxloc0_8_i1; + _gfortran_mmaxloc0_8_i16; + _gfortran_mmaxloc0_8_i2; + _gfortran_mmaxloc0_8_i4; + _gfortran_mmaxloc0_8_i8; + _gfortran_mmaxloc0_8_r10; + _gfortran_mmaxloc0_8_r16; + _gfortran_mmaxloc0_8_r4; + _gfortran_mmaxloc0_8_r8; + _gfortran_mmaxloc1_16_i1; + _gfortran_mmaxloc1_16_i16; + _gfortran_mmaxloc1_16_i2; + _gfortran_mmaxloc1_16_i4; + _gfortran_mmaxloc1_16_i8; + _gfortran_mmaxloc1_16_r10; + _gfortran_mmaxloc1_16_r16; + _gfortran_mmaxloc1_16_r4; + _gfortran_mmaxloc1_16_r8; + _gfortran_mmaxloc1_4_i1; + _gfortran_mmaxloc1_4_i16; + _gfortran_mmaxloc1_4_i2; + _gfortran_mmaxloc1_4_i4; + _gfortran_mmaxloc1_4_i8; + _gfortran_mmaxloc1_4_r10; + _gfortran_mmaxloc1_4_r16; + _gfortran_mmaxloc1_4_r4; + _gfortran_mmaxloc1_4_r8; + _gfortran_mmaxloc1_8_i1; + _gfortran_mmaxloc1_8_i16; + _gfortran_mmaxloc1_8_i2; + _gfortran_mmaxloc1_8_i4; + _gfortran_mmaxloc1_8_i8; + _gfortran_mmaxloc1_8_r10; + _gfortran_mmaxloc1_8_r16; + _gfortran_mmaxloc1_8_r4; + _gfortran_mmaxloc1_8_r8; + _gfortran_mmaxval_i1; + _gfortran_mmaxval_i16; + _gfortran_mmaxval_i2; + _gfortran_mmaxval_i4; + _gfortran_mmaxval_i8; + _gfortran_mmaxval_r10; + _gfortran_mmaxval_r16; + _gfortran_mmaxval_r4; + _gfortran_mmaxval_r8; + _gfortran_mminloc0_16_i1; + _gfortran_mminloc0_16_i16; + _gfortran_mminloc0_16_i2; + _gfortran_mminloc0_16_i4; + _gfortran_mminloc0_16_i8; + _gfortran_mminloc0_16_r10; + _gfortran_mminloc0_16_r16; + _gfortran_mminloc0_16_r4; + _gfortran_mminloc0_16_r8; + _gfortran_mminloc0_4_i1; + _gfortran_mminloc0_4_i16; + _gfortran_mminloc0_4_i2; + _gfortran_mminloc0_4_i4; + _gfortran_mminloc0_4_i8; + _gfortran_mminloc0_4_r10; + _gfortran_mminloc0_4_r16; + _gfortran_mminloc0_4_r4; + _gfortran_mminloc0_4_r8; + _gfortran_mminloc0_8_i1; + _gfortran_mminloc0_8_i16; + _gfortran_mminloc0_8_i2; + _gfortran_mminloc0_8_i4; + _gfortran_mminloc0_8_i8; + _gfortran_mminloc0_8_r10; + _gfortran_mminloc0_8_r16; + _gfortran_mminloc0_8_r4; + _gfortran_mminloc0_8_r8; + _gfortran_mminloc1_16_i1; + _gfortran_mminloc1_16_i16; + _gfortran_mminloc1_16_i2; + _gfortran_mminloc1_16_i4; + _gfortran_mminloc1_16_i8; + _gfortran_mminloc1_16_r10; + _gfortran_mminloc1_16_r16; + _gfortran_mminloc1_16_r4; + _gfortran_mminloc1_16_r8; + _gfortran_mminloc1_4_i1; + _gfortran_mminloc1_4_i16; + _gfortran_mminloc1_4_i2; + _gfortran_mminloc1_4_i4; + _gfortran_mminloc1_4_i8; + _gfortran_mminloc1_4_r10; + _gfortran_mminloc1_4_r16; + _gfortran_mminloc1_4_r4; + _gfortran_mminloc1_4_r8; + _gfortran_mminloc1_8_i1; + _gfortran_mminloc1_8_i16; + _gfortran_mminloc1_8_i2; + _gfortran_mminloc1_8_i4; + _gfortran_mminloc1_8_i8; + _gfortran_mminloc1_8_r10; + _gfortran_mminloc1_8_r16; + _gfortran_mminloc1_8_r4; + _gfortran_mminloc1_8_r8; + _gfortran_mminval_i1; + _gfortran_mminval_i16; + _gfortran_mminval_i2; + _gfortran_mminval_i4; + _gfortran_mminval_i8; + _gfortran_mminval_r10; + _gfortran_mminval_r16; + _gfortran_mminval_r4; + _gfortran_mminval_r8; + _gfortran_move_alloc; + _gfortran_move_alloc_c; + _gfortran_mproduct_c10; + _gfortran_mproduct_c16; + _gfortran_mproduct_c4; + _gfortran_mproduct_c8; + _gfortran_mproduct_i1; + _gfortran_mproduct_i16; + _gfortran_mproduct_i2; + _gfortran_mproduct_i4; + _gfortran_mproduct_i8; + _gfortran_mproduct_r10; + _gfortran_mproduct_r16; + _gfortran_mproduct_r4; + _gfortran_mproduct_r8; + _gfortran_msum_c10; + _gfortran_msum_c16; + _gfortran_msum_c4; + _gfortran_msum_c8; + _gfortran_msum_i1; + _gfortran_msum_i16; + _gfortran_msum_i2; + _gfortran_msum_i4; + _gfortran_msum_i8; + _gfortran_msum_r10; + _gfortran_msum_r16; + _gfortran_msum_r4; + _gfortran_msum_r8; + _gfortran_mvbits_i1; + _gfortran_mvbits_i2; + _gfortran_mvbits_i4; + _gfortran_mvbits_i8; + _gfortran_nearest_r10; + _gfortran_nearest_r16; + _gfortran_nearest_r4; + _gfortran_nearest_r8; + _gfortran_os_error; + _gfortran_pack; + _gfortran_pack_char; + _gfortran_pack_s; + _gfortran_pack_s_char; + _gfortran_pause_numeric; + _gfortran_pause_string; + _gfortran_perror_sub; + _gfortran_pow_c10_i16; + _gfortran_pow_c10_i4; + _gfortran_pow_c10_i8; + _gfortran_pow_c16_i16; + _gfortran_pow_c16_i4; + _gfortran_pow_c16_i8; + _gfortran_pow_c4_i16; + _gfortran_pow_c4_i4; + _gfortran_pow_c4_i8; + _gfortran_pow_c8_i16; + _gfortran_pow_c8_i4; + _gfortran_pow_c8_i8; + _gfortran_pow_i16_i16; + _gfortran_pow_i16_i4; + _gfortran_pow_i16_i8; + _gfortran_pow_i4_i16; + _gfortran_pow_i4_i4; + _gfortran_pow_i4_i8; + _gfortran_pow_i8_i16; + _gfortran_pow_i8_i4; + _gfortran_pow_i8_i8; + _gfortran_pow_r10_i16; + _gfortran_pow_r10_i8; + _gfortran_pow_r16_i16; + _gfortran_pow_r16_i4; + _gfortran_pow_r16_i8; + _gfortran_pow_r4_i16; + _gfortran_pow_r4_i8; + _gfortran_pow_r8_i16; + _gfortran_pow_r8_i8; + _gfortran_product_c10; + _gfortran_product_c16; + _gfortran_product_c4; + _gfortran_product_c8; + _gfortran_product_i1; + _gfortran_product_i16; + _gfortran_product_i2; + _gfortran_product_i4; + _gfortran_product_i8; + _gfortran_product_r10; + _gfortran_product_r16; + _gfortran_product_r4; + _gfortran_product_r8; + _gfortran_rand; + _gfortran_random_r10; + _gfortran_random_r16; + _gfortran_random_r4; + _gfortran_random_r8; + _gfortran_random_seed_i4; + _gfortran_random_seed_i8; + _gfortran_rename_i4; + _gfortran_rename_i4_sub; + _gfortran_rename_i8; + _gfortran_rename_i8_sub; + _gfortran_reshape; + _gfortran_reshape_16; + _gfortran_reshape_4; + _gfortran_reshape_8; + _gfortran_reshape_c10; + _gfortran_reshape_c16; + _gfortran_reshape_c4; + _gfortran_reshape_c8; + _gfortran_reshape_char; + _gfortran_reshape_r10; + _gfortran_reshape_r16; + _gfortran_reshape_r4; + _gfortran_reshape_r8; + _gfortran_rrspacing_r10; + _gfortran_rrspacing_r16; + _gfortran_rrspacing_r4; + _gfortran_rrspacing_r8; + _gfortran_runtime_error; + _gfortran_runtime_error_at; + _gfortran_secnds; + _gfortran_second; + _gfortran_second_sub; + _gfortran_selected_int_kind; + _gfortran_selected_real_kind; + _gfortran_select_string; + _gfortran_set_args; + _gfortran_set_convert; + _gfortran_set_exponent_r10; + _gfortran_set_exponent_r16; + _gfortran_set_exponent_r4; + _gfortran_set_exponent_r8; + _gfortran_set_fpe; + _gfortran_set_max_subrecord_length; + _gfortran_set_record_marker; + _gfortran_set_options; + _gfortran_shape_16; + _gfortran_shape_4; + _gfortran_shape_8; + _gfortran_signal_func; + _gfortran_signal_func_int; + _gfortran_signal_sub; + _gfortran_signal_sub_int; + _gfortran_size0; + _gfortran_size1; + _gfortran_sleep_i4_sub; + _gfortran_sleep_i8_sub; + _gfortran_smaxloc0_16_i1; + _gfortran_smaxloc0_16_i16; + _gfortran_smaxloc0_16_i2; + _gfortran_smaxloc0_16_i4; + _gfortran_smaxloc0_16_i8; + _gfortran_smaxloc0_16_r10; + _gfortran_smaxloc0_16_r16; + _gfortran_smaxloc0_16_r4; + _gfortran_smaxloc0_16_r8; + _gfortran_smaxloc0_4_i1; + _gfortran_smaxloc0_4_i16; + _gfortran_smaxloc0_4_i2; + _gfortran_smaxloc0_4_i4; + _gfortran_smaxloc0_4_i8; + _gfortran_smaxloc0_4_r10; + _gfortran_smaxloc0_4_r16; + _gfortran_smaxloc0_4_r4; + _gfortran_smaxloc0_4_r8; + _gfortran_smaxloc0_8_i1; + _gfortran_smaxloc0_8_i16; + _gfortran_smaxloc0_8_i2; + _gfortran_smaxloc0_8_i4; + _gfortran_smaxloc0_8_i8; + _gfortran_smaxloc0_8_r10; + _gfortran_smaxloc0_8_r16; + _gfortran_smaxloc0_8_r4; + _gfortran_smaxloc0_8_r8; + _gfortran_smaxloc1_16_i1; + _gfortran_smaxloc1_16_i16; + _gfortran_smaxloc1_16_i2; + _gfortran_smaxloc1_16_i4; + _gfortran_smaxloc1_16_i8; + _gfortran_smaxloc1_16_r10; + _gfortran_smaxloc1_16_r16; + _gfortran_smaxloc1_16_r4; + _gfortran_smaxloc1_16_r8; + _gfortran_smaxloc1_4_i1; + _gfortran_smaxloc1_4_i16; + _gfortran_smaxloc1_4_i2; + _gfortran_smaxloc1_4_i4; + _gfortran_smaxloc1_4_i8; + _gfortran_smaxloc1_4_r10; + _gfortran_smaxloc1_4_r16; + _gfortran_smaxloc1_4_r4; + _gfortran_smaxloc1_4_r8; + _gfortran_smaxloc1_8_i1; + _gfortran_smaxloc1_8_i16; + _gfortran_smaxloc1_8_i2; + _gfortran_smaxloc1_8_i4; + _gfortran_smaxloc1_8_i8; + _gfortran_smaxloc1_8_r10; + _gfortran_smaxloc1_8_r16; + _gfortran_smaxloc1_8_r4; + _gfortran_smaxloc1_8_r8; + _gfortran_smaxval_i1; + _gfortran_smaxval_i16; + _gfortran_smaxval_i2; + _gfortran_smaxval_i4; + _gfortran_smaxval_i8; + _gfortran_smaxval_r10; + _gfortran_smaxval_r16; + _gfortran_smaxval_r4; + _gfortran_smaxval_r8; + _gfortran_sminloc0_16_i1; + _gfortran_sminloc0_16_i16; + _gfortran_sminloc0_16_i2; + _gfortran_sminloc0_16_i4; + _gfortran_sminloc0_16_i8; + _gfortran_sminloc0_16_r10; + _gfortran_sminloc0_16_r16; + _gfortran_sminloc0_16_r4; + _gfortran_sminloc0_16_r8; + _gfortran_sminloc0_4_i1; + _gfortran_sminloc0_4_i16; + _gfortran_sminloc0_4_i2; + _gfortran_sminloc0_4_i4; + _gfortran_sminloc0_4_i8; + _gfortran_sminloc0_4_r10; + _gfortran_sminloc0_4_r16; + _gfortran_sminloc0_4_r4; + _gfortran_sminloc0_4_r8; + _gfortran_sminloc0_8_i1; + _gfortran_sminloc0_8_i16; + _gfortran_sminloc0_8_i2; + _gfortran_sminloc0_8_i4; + _gfortran_sminloc0_8_i8; + _gfortran_sminloc0_8_r10; + _gfortran_sminloc0_8_r16; + _gfortran_sminloc0_8_r4; + _gfortran_sminloc0_8_r8; + _gfortran_sminloc1_16_i1; + _gfortran_sminloc1_16_i16; + _gfortran_sminloc1_16_i2; + _gfortran_sminloc1_16_i4; + _gfortran_sminloc1_16_i8; + _gfortran_sminloc1_16_r10; + _gfortran_sminloc1_16_r16; + _gfortran_sminloc1_16_r4; + _gfortran_sminloc1_16_r8; + _gfortran_sminloc1_4_i1; + _gfortran_sminloc1_4_i16; + _gfortran_sminloc1_4_i2; + _gfortran_sminloc1_4_i4; + _gfortran_sminloc1_4_i8; + _gfortran_sminloc1_4_r10; + _gfortran_sminloc1_4_r16; + _gfortran_sminloc1_4_r4; + _gfortran_sminloc1_4_r8; + _gfortran_sminloc1_8_i1; + _gfortran_sminloc1_8_i16; + _gfortran_sminloc1_8_i2; + _gfortran_sminloc1_8_i4; + _gfortran_sminloc1_8_i8; + _gfortran_sminloc1_8_r10; + _gfortran_sminloc1_8_r16; + _gfortran_sminloc1_8_r4; + _gfortran_sminloc1_8_r8; + _gfortran_sminval_i1; + _gfortran_sminval_i16; + _gfortran_sminval_i2; + _gfortran_sminval_i4; + _gfortran_sminval_i8; + _gfortran_sminval_r10; + _gfortran_sminval_r16; + _gfortran_sminval_r4; + _gfortran_sminval_r8; + _gfortran_spacing_r10; + _gfortran_spacing_r16; + _gfortran_spacing_r4; + _gfortran_spacing_r8; + _gfortran_specific__abs_c10; + _gfortran_specific__abs_c16; + _gfortran_specific__abs_c4; + _gfortran_specific__abs_c8; + _gfortran_specific__abs_i16; + _gfortran_specific__abs_i4; + _gfortran_specific__abs_i8; + _gfortran_specific__abs_r10; + _gfortran_specific__abs_r16; + _gfortran_specific__abs_r4; + _gfortran_specific__abs_r8; + _gfortran_specific__acosh_r10; + _gfortran_specific__acosh_r16; + _gfortran_specific__acosh_r4; + _gfortran_specific__acosh_r8; + _gfortran_specific__acos_r10; + _gfortran_specific__acos_r16; + _gfortran_specific__acos_r4; + _gfortran_specific__acos_r8; + _gfortran_specific__aimag_c10; + _gfortran_specific__aimag_c16; + _gfortran_specific__aimag_c4; + _gfortran_specific__aimag_c8; + _gfortran_specific__aint_r10; + _gfortran_specific__aint_r16; + _gfortran_specific__aint_r4; + _gfortran_specific__aint_r8; + _gfortran_specific__anint_r10; + _gfortran_specific__anint_r16; + _gfortran_specific__anint_r4; + _gfortran_specific__anint_r8; + _gfortran_specific__asinh_r10; + _gfortran_specific__asinh_r16; + _gfortran_specific__asinh_r4; + _gfortran_specific__asinh_r8; + _gfortran_specific__asin_r10; + _gfortran_specific__asin_r16; + _gfortran_specific__asin_r4; + _gfortran_specific__asin_r8; + _gfortran_specific__atan2_r10; + _gfortran_specific__atan2_r16; + _gfortran_specific__atan2_r4; + _gfortran_specific__atan2_r8; + _gfortran_specific__atanh_r10; + _gfortran_specific__atanh_r16; + _gfortran_specific__atanh_r4; + _gfortran_specific__atanh_r8; + _gfortran_specific__atan_r10; + _gfortran_specific__atan_r16; + _gfortran_specific__atan_r4; + _gfortran_specific__atan_r8; + _gfortran_specific__char_1_i16; + _gfortran_specific__char_1_i4; + _gfortran_specific__char_1_i8; + _gfortran_specific__conjg_10; + _gfortran_specific__conjg_16; + _gfortran_specific__conjg_4; + _gfortran_specific__conjg_8; + _gfortran_specific__cos_c10; + _gfortran_specific__cos_c16; + _gfortran_specific__cos_c4; + _gfortran_specific__cos_c8; + _gfortran_specific__cosh_r10; + _gfortran_specific__cosh_r16; + _gfortran_specific__cosh_r4; + _gfortran_specific__cosh_r8; + _gfortran_specific__cos_r10; + _gfortran_specific__cos_r16; + _gfortran_specific__cos_r4; + _gfortran_specific__cos_r8; + _gfortran_specific__dim_i16; + _gfortran_specific__dim_i4; + _gfortran_specific__dim_i8; + _gfortran_specific__dim_r10; + _gfortran_specific__dim_r16; + _gfortran_specific__dim_r4; + _gfortran_specific__dim_r8; + _gfortran_specific__dprod_r8; + _gfortran_specific__exp_c10; + _gfortran_specific__exp_c16; + _gfortran_specific__exp_c4; + _gfortran_specific__exp_c8; + _gfortran_specific__exp_r10; + _gfortran_specific__exp_r16; + _gfortran_specific__exp_r4; + _gfortran_specific__exp_r8; + _gfortran_specific__index_1_i16; + _gfortran_specific__index_1_i4; + _gfortran_specific__index_1_i8; + _gfortran_specific__len_1_i16; + _gfortran_specific__len_1_i4; + _gfortran_specific__len_1_i8; + _gfortran_specific__log10_r10; + _gfortran_specific__log10_r16; + _gfortran_specific__log10_r4; + _gfortran_specific__log10_r8; + _gfortran_specific__log_c10; + _gfortran_specific__log_c16; + _gfortran_specific__log_c4; + _gfortran_specific__log_c8; + _gfortran_specific__log_r10; + _gfortran_specific__log_r16; + _gfortran_specific__log_r4; + _gfortran_specific__log_r8; + _gfortran_specific__mod_i16; + _gfortran_specific__mod_i4; + _gfortran_specific__mod_i8; + _gfortran_specific__mod_r10; + _gfortran_specific__mod_r16; + _gfortran_specific__mod_r4; + _gfortran_specific__mod_r8; + _gfortran_specific__nint_16_10; + _gfortran_specific__nint_16_16; + _gfortran_specific__nint_16_4; + _gfortran_specific__nint_16_8; + _gfortran_specific__nint_4_10; + _gfortran_specific__nint_4_16; + _gfortran_specific__nint_4_4; + _gfortran_specific__nint_4_8; + _gfortran_specific__nint_8_10; + _gfortran_specific__nint_8_16; + _gfortran_specific__nint_8_4; + _gfortran_specific__nint_8_8; + _gfortran_specific__sign_i16; + _gfortran_specific__sign_i4; + _gfortran_specific__sign_i8; + _gfortran_specific__sign_r10; + _gfortran_specific__sign_r16; + _gfortran_specific__sign_r4; + _gfortran_specific__sign_r8; + _gfortran_specific__sin_c10; + _gfortran_specific__sin_c16; + _gfortran_specific__sin_c4; + _gfortran_specific__sin_c8; + _gfortran_specific__sinh_r10; + _gfortran_specific__sinh_r16; + _gfortran_specific__sinh_r4; + _gfortran_specific__sinh_r8; + _gfortran_specific__sin_r10; + _gfortran_specific__sin_r16; + _gfortran_specific__sin_r4; + _gfortran_specific__sin_r8; + _gfortran_specific__sqrt_c10; + _gfortran_specific__sqrt_c16; + _gfortran_specific__sqrt_c4; + _gfortran_specific__sqrt_c8; + _gfortran_specific__sqrt_r10; + _gfortran_specific__sqrt_r16; + _gfortran_specific__sqrt_r4; + _gfortran_specific__sqrt_r8; + _gfortran_specific__tanh_r10; + _gfortran_specific__tanh_r16; + _gfortran_specific__tanh_r4; + _gfortran_specific__tanh_r8; + _gfortran_specific__tan_r10; + _gfortran_specific__tan_r16; + _gfortran_specific__tan_r4; + _gfortran_specific__tan_r8; + _gfortran_spread; + _gfortran_spread_char; + _gfortran_spread_char_scalar; + _gfortran_spread_scalar; + _gfortran_sproduct_c10; + _gfortran_sproduct_c16; + _gfortran_sproduct_c4; + _gfortran_sproduct_c8; + _gfortran_sproduct_i1; + _gfortran_sproduct_i16; + _gfortran_sproduct_i2; + _gfortran_sproduct_i4; + _gfortran_sproduct_i8; + _gfortran_sproduct_r10; + _gfortran_sproduct_r16; + _gfortran_sproduct_r4; + _gfortran_sproduct_r8; + _gfortran_srand; + _gfortran_ssum_c10; + _gfortran_ssum_c16; + _gfortran_ssum_c4; + _gfortran_ssum_c8; + _gfortran_ssum_i1; + _gfortran_ssum_i16; + _gfortran_ssum_i2; + _gfortran_ssum_i4; + _gfortran_ssum_i8; + _gfortran_ssum_r10; + _gfortran_ssum_r16; + _gfortran_ssum_r4; + _gfortran_ssum_r8; + _gfortran_stat_i4; + _gfortran_stat_i4_sub; + _gfortran_stat_i8; + _gfortran_stat_i8_sub; + _gfortran_st_backspace; + _gfortran_st_close; + _gfortran_st_endfile; + _gfortran_st_flush; + _gfortran_st_inquire; + _gfortran_st_iolength; + _gfortran_st_iolength_done; + _gfortran_st_open; + _gfortran_stop_numeric; + _gfortran_stop_string; + _gfortran_store_exe_path; + _gfortran_st_read; + _gfortran_st_read_done; + _gfortran_st_rewind; + _gfortran_string_index; + _gfortran_string_len_trim; + _gfortran_string_minmax; + _gfortran_string_scan; + _gfortran_string_trim; + _gfortran_string_verify; + _gfortran_st_set_nml_var; + _gfortran_st_set_nml_var_dim; + _gfortran_st_write; + _gfortran_st_write_done; + _gfortran_sum_c10; + _gfortran_sum_c16; + _gfortran_sum_c4; + _gfortran_sum_c8; + _gfortran_sum_i1; + _gfortran_sum_i16; + _gfortran_sum_i2; + _gfortran_sum_i4; + _gfortran_sum_i8; + _gfortran_sum_r10; + _gfortran_sum_r16; + _gfortran_sum_r4; + _gfortran_sum_r8; + _gfortran_symlnk_i4; + _gfortran_symlnk_i4_sub; + _gfortran_symlnk_i8; + _gfortran_symlnk_i8_sub; + _gfortran_system; + _gfortran_system_clock_4; + _gfortran_system_clock_8; + _gfortran_system_sub; + _gfortran_time8_func; + _gfortran_time_func; + _gfortran_transfer_array; + _gfortran_transfer_character; + _gfortran_transfer_complex; + _gfortran_transfer_integer; + _gfortran_transfer_logical; + _gfortran_transfer_real; + _gfortran_transpose; + _gfortran_transpose_c10; + _gfortran_transpose_c16; + _gfortran_transpose_c4; + _gfortran_transpose_c8; + _gfortran_transpose_char; + _gfortran_transpose_i16; + _gfortran_transpose_i4; + _gfortran_transpose_i8; + _gfortran_transpose_r10; + _gfortran_transpose_r16; + _gfortran_transpose_r4; + _gfortran_transpose_r8; + _gfortran_ttynam; + _gfortran_ttynam_sub; + _gfortran_umask_i4; + _gfortran_umask_i4_sub; + _gfortran_umask_i8; + _gfortran_umask_i8_sub; + _gfortran_unlink; + _gfortran_unlink_i4_sub; + _gfortran_unlink_i8_sub; + _gfortran_unpack0; + _gfortran_unpack0_char; + _gfortran_unpack1; + _gfortran_unpack1_char; + __iso_c_binding_c_f_pointer; + __iso_c_binding_c_f_pointer_d0; + __iso_c_binding_c_f_pointer_i1; + __iso_c_binding_c_f_pointer_i2; + __iso_c_binding_c_f_pointer_i4; + __iso_c_binding_c_f_pointer_i8; + __iso_c_binding_c_f_pointer_i16; + __iso_c_binding_c_f_pointer_r4; + __iso_c_binding_c_f_pointer_r8; + __iso_c_binding_c_f_pointer_r10; + __iso_c_binding_c_f_pointer_r16; + __iso_c_binding_c_f_pointer_c4; + __iso_c_binding_c_f_pointer_c8; + __iso_c_binding_c_f_pointer_c10; + __iso_c_binding_c_f_pointer_c16; + __iso_c_binding_c_f_pointer_s0; + __iso_c_binding_c_f_pointer_l1; + __iso_c_binding_c_f_pointer_l2; + __iso_c_binding_c_f_pointer_l4; + __iso_c_binding_c_f_pointer_l8; + __iso_c_binding_c_f_pointer_u0; + local: + *; +}; + +GFORTRAN_1.1 { + global: + _gfortran_adjustl_char4; + _gfortran_adjustr_char4; + _gfortran_compare_string_char4; + _gfortran_concat_string_char4; + _gfortran_convert_char1_to_char4; + _gfortran_convert_char4_to_char1; + _gfortran_cshift0_16; + _gfortran_cshift0_16_char; + _gfortran_cshift0_1_char4; + _gfortran_cshift0_2_char4; + _gfortran_cshift0_4_char4; + _gfortran_cshift0_8_char4; + _gfortran_cshift1_16_char4; + _gfortran_cshift1_4_char4; + _gfortran_cshift1_8_char4; + _gfortran_eoshift0_16; + _gfortran_eoshift0_16_char; + _gfortran_eoshift0_1_char4; + _gfortran_eoshift0_2_char4; + _gfortran_eoshift0_4_char4; + _gfortran_eoshift0_8_char4; + _gfortran_eoshift1_16_char4; + _gfortran_eoshift1_4_char4; + _gfortran_eoshift1_8_char4; + _gfortran_eoshift2_16; + _gfortran_eoshift2_16_char; + _gfortran_eoshift2_1_char4; + _gfortran_eoshift2_2_char4; + _gfortran_eoshift2_4_char4; + _gfortran_eoshift2_8_char4; + _gfortran_eoshift3_16_char4; + _gfortran_eoshift3_4_char4; + _gfortran_eoshift3_8_char4; + _gfortran_erfc_scaled_r10; + _gfortran_erfc_scaled_r16; + _gfortran_erfc_scaled_r4; + _gfortran_erfc_scaled_r8; + _gfortran_execute_command_line_i4; + _gfortran_execute_command_line_i8; + _gfortran_pack_char4; + _gfortran_pack_s_char4; + _gfortran_reshape_char4; + _gfortran_runtime_warning_at; + _gfortran_selected_char_kind; + _gfortran_select_string_char4; + _gfortran_spread_char4; + _gfortran_spread_char4_scalar; + _gfortran_string_index_char4; + _gfortran_string_len_trim_char4; + _gfortran_string_minmax_char4; + _gfortran_string_scan_char4; + _gfortran_string_trim_char4; + _gfortran_string_verify_char4; + _gfortran_st_wait; + _gfortran_transfer_character_wide; + _gfortran_transpose_char4; + _gfortran_unpack0_char4; + _gfortran_unpack1_char4; +} GFORTRAN_1.0; + + +GFORTRAN_1.2 { + global: + _gfortran_clz128; + _gfortran_ctz128; + _gfortran_is_extension_of; +} GFORTRAN_1.1; + +GFORTRAN_1.3 { + global: + _gfortran_error_stop_string; +} GFORTRAN_1.2; + +GFORTRAN_1.4 { + global: + _gfortran_bessel_jn_r4; + _gfortran_bessel_jn_r8; + _gfortran_bessel_jn_r10; + _gfortran_bessel_jn_r16; + _gfortran_bessel_yn_r4; + _gfortran_bessel_yn_r8; + _gfortran_bessel_yn_r10; + _gfortran_bessel_yn_r16; + _gfortran_error_stop_numeric; + _gfortran_iall_i1; + _gfortran_iall_i2; + _gfortran_iall_i4; + _gfortran_iall_i8; + _gfortran_iall_i16; + _gfortran_miall_i1; + _gfortran_miall_i2; + _gfortran_miall_i4; + _gfortran_miall_i8; + _gfortran_miall_i16; + _gfortran_siall_i1; + _gfortran_siall_i2; + _gfortran_siall_i4; + _gfortran_siall_i8; + _gfortran_siall_i16; + _gfortran_iany_i1; + _gfortran_iany_i2; + _gfortran_iany_i4; + _gfortran_iany_i8; + _gfortran_iany_i16; + _gfortran_miany_i1; + _gfortran_miany_i2; + _gfortran_miany_i4; + _gfortran_miany_i8; + _gfortran_miany_i16; + _gfortran_siany_i1; + _gfortran_siany_i2; + _gfortran_siany_i4; + _gfortran_siany_i8; + _gfortran_siany_i16; + _gfortran_iparity_i1; + _gfortran_iparity_i2; + _gfortran_iparity_i4; + _gfortran_iparity_i8; + _gfortran_iparity_i16; + _gfortran_miparity_i1; + _gfortran_miparity_i2; + _gfortran_miparity_i4; + _gfortran_miparity_i8; + _gfortran_miparity_i16; + _gfortran_siparity_i1; + _gfortran_siparity_i2; + _gfortran_siparity_i4; + _gfortran_siparity_i8; + _gfortran_siparity_i16; + _gfortran_norm2_r4; + _gfortran_norm2_r8; + _gfortran_norm2_r10; + _gfortran_norm2_r16; + _gfortran_parity_l1; + _gfortran_parity_l2; + _gfortran_parity_l4; + _gfortran_parity_l8; + _gfortran_parity_l16; + _gfortran_selected_real_kind2008; + _gfortran_stop_numeric_f08; + _gfortran_transfer_array_write; + _gfortran_transfer_character_write; + _gfortran_transfer_character_wide_write; + _gfortran_transfer_complex_write; + _gfortran_transfer_complex128; + _gfortran_transfer_complex128_write; + _gfortran_transfer_integer_write; + _gfortran_transfer_logical_write; + _gfortran_transfer_real_write; + _gfortran_transfer_real128; + _gfortran_transfer_real128_write; + _gfortran_cshift0_16_char4; + _gfortran_eoshift0_16_char4; + _gfortran_eoshift2_16_char4; +} GFORTRAN_1.3; + +F2C_1.0 { + global: + _gfortran_f2c_specific__abs_c4; + _gfortran_f2c_specific__abs_r4; + _gfortran_f2c_specific__acosh_r4; + _gfortran_f2c_specific__acos_r4; + _gfortran_f2c_specific__aimag_c4; + _gfortran_f2c_specific__aimag_c8; + _gfortran_f2c_specific__aint_r4; + _gfortran_f2c_specific__anint_r4; + _gfortran_f2c_specific__asinh_r4; + _gfortran_f2c_specific__asin_r4; + _gfortran_f2c_specific__atan2_r4; + _gfortran_f2c_specific__atanh_r4; + _gfortran_f2c_specific__atan_r4; + _gfortran_f2c_specific__conjg_4; + _gfortran_f2c_specific__conjg_8; + _gfortran_f2c_specific__cos_c4; + _gfortran_f2c_specific__cos_c8; + _gfortran_f2c_specific__cosh_r4; + _gfortran_f2c_specific__cos_r4; + _gfortran_f2c_specific__dim_r4; + _gfortran_f2c_specific__exp_c4; + _gfortran_f2c_specific__exp_c8; + _gfortran_f2c_specific__exp_r4; + _gfortran_f2c_specific__log10_r4; + _gfortran_f2c_specific__log_c4; + _gfortran_f2c_specific__log_c8; + _gfortran_f2c_specific__log_r4; + _gfortran_f2c_specific__mod_r4; + _gfortran_f2c_specific__sign_r4; + _gfortran_f2c_specific__sin_c4; + _gfortran_f2c_specific__sin_c8; + _gfortran_f2c_specific__sinh_r4; + _gfortran_f2c_specific__sin_r4; + _gfortran_f2c_specific__sqrt_c4; + _gfortran_f2c_specific__sqrt_c8; + _gfortran_f2c_specific__sqrt_r4; + _gfortran_f2c_specific__tanh_r4; + _gfortran_f2c_specific__tan_r4; +}; + +GFORTRAN_C99_1.0 { + global: + acosf; + acoshf; + asinf; + asinhf; + atan2f; + atanf; + atanhf; + cabs; + cabsf; + cabsl; + carg; + cargf; + cargl; + ccos; + ccosf; + ccosh; + ccoshf; + ccoshl; + ccosl; + ceilf; + cexp; + cexpf; + cexpl; + clog; + clog10; + clog10f; + clog10l; + clogf; + clogl; + copysignf; + cosf; + coshf; + cpow; + cpowf; + cpowl; + csin; + csinf; + csinh; + csinhf; + csinhl; + csinl; + csqrt; + csqrtf; + csqrtl; + ctan; + ctanf; + ctanh; + ctanhf; + ctanhl; + ctanl; + erfcf; + erff; + expf; + fabsf; + floorf; + floorl; + fmodf; + fmodl; + frexpf; + hypotf; + j0f; + j1f; + jnf; + lgamma; + lgammaf; + log10f; + log10l; + logf; + nextafterf; + powf; + round; + roundf; + scalbn; + scalbnf; + sinf; + sinhf; + sqrtf; + tanf; + tanhf; + tgamma; + tgammaf; + trunc; + truncf; + y0f; + y1f; + ynf; +}; + +GFORTRAN_C99_1.1 { + global: + cacos; + cacosf; + cacosh; + cacoshf; + cacoshl; + cacosl; + casin; + casinf; + casinh; + casinhf; + casinhl; + casinl; + catan; + catanf; + catanh; + catanhf; + catanhl; + catanl; + llround; + llroundf; + llroundl; + lround; + lroundf; + lroundl; + roundl; +} GFORTRAN_C99_1.0; diff --git a/libgfortran/intrinsics/abort.c b/libgfortran/intrinsics/abort.c new file mode 100644 index 000000000..ada406143 --- /dev/null +++ b/libgfortran/intrinsics/abort.c @@ -0,0 +1,35 @@ +/* Implementation of the ABORT intrinsic. + Copyright (C) 2003, 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + +void PREFIX(abort) (void); +export_proto_np(PREFIX(abort)); + +void PREFIX(abort) (void) +{ + close_units (); + abort (); +} diff --git a/libgfortran/intrinsics/access.c b/libgfortran/intrinsics/access.c new file mode 100644 index 000000000..9d44531e2 --- /dev/null +++ b/libgfortran/intrinsics/access.c @@ -0,0 +1,90 @@ +/* Implementation of the ACCESS intrinsic. + Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +#ifdef HAVE_UNISTD_H +#include +#endif + +/* INTEGER FUNCTION ACCESS(NAME, MODE) + CHARACTER(len=*), INTENT(IN) :: NAME, MODE */ + +#ifdef HAVE_ACCESS +extern int access_func (char *, char *, gfc_charlen_type, gfc_charlen_type); +export_proto(access_func); + +int +access_func (char *name, char *mode, gfc_charlen_type name_len, + gfc_charlen_type mode_len) +{ + char * file; + gfc_charlen_type i; + int m; + + /* Parse the MODE string. */ + m = F_OK; + for (i = 0; i < mode_len && mode[i]; i++) + switch (mode[i]) + { + case ' ': + break; + + case 'r': + case 'R': + m |= R_OK; + break; + + case 'w': + case 'W': + m |= W_OK; + break; + + case 'x': + case 'X': + m |= X_OK; + break; + + default: + return -1; + break; + } + + /* Trim trailing spaces from NAME argument. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + + /* Make a null terminated copy of the string. */ + file = gfc_alloca (name_len + 1); + memcpy (file, name, name_len); + file[name_len] = '\0'; + + /* And make the call to access(). */ + return (access (file, m) == 0 ? 0 : errno); +} +#endif diff --git a/libgfortran/intrinsics/args.c b/libgfortran/intrinsics/args.c new file mode 100644 index 000000000..545cfe506 --- /dev/null +++ b/libgfortran/intrinsics/args.c @@ -0,0 +1,270 @@ +/* Implementation of the GETARG and IARGC g77, and + corresponding F2003, intrinsics. + Copyright (C) 2004, 2005, 2007, 2009, 2010 + Free Software Foundation, Inc. + Contributed by Bud Davis and Janne Blomqvist. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +/* Get a commandline argument. */ + +extern void getarg_i4 (GFC_INTEGER_4 *, char *, gfc_charlen_type); +iexport_proto(getarg_i4); + +void +getarg_i4 (GFC_INTEGER_4 *pos, char *val, gfc_charlen_type val_len) +{ + int argc; + int arglen; + char **argv; + + get_args (&argc, &argv); + + if (val_len < 1 || !val ) + return; /* something is wrong , leave immediately */ + + memset (val, ' ', val_len); + + if ((*pos) + 1 <= argc && *pos >=0 ) + { + arglen = strlen (argv[*pos]); + if (arglen > val_len) + arglen = val_len; + memcpy (val, argv[*pos], arglen); + } +} +iexport(getarg_i4); + + +/* INTEGER*8 wrapper of getarg. */ + +extern void getarg_i8 (GFC_INTEGER_8 *, char *, gfc_charlen_type); +export_proto (getarg_i8); + +void +getarg_i8 (GFC_INTEGER_8 *pos, char *val, gfc_charlen_type val_len) +{ + GFC_INTEGER_4 pos4 = (GFC_INTEGER_4) *pos; + getarg_i4 (&pos4, val, val_len); +} + + +/* Return the number of commandline arguments. The g77 info page + states that iargc does not include the specification of the + program name itself. */ + +extern GFC_INTEGER_4 iargc (void); +export_proto(iargc); + +GFC_INTEGER_4 +iargc (void) +{ + int argc; + char **argv; + + get_args (&argc, &argv); + + return (argc - 1); +} + + +/* F2003 intrinsic functions and subroutines related to command line + arguments. + + - function command_argument_count() is converted to iargc by the compiler. + + - subroutine get_command([command, length, status]). + + - subroutine get_command_argument(number, [value, length, status]). +*/ + +/* These two status codes are specified in the standard. */ +#define GFC_GC_SUCCESS 0 +#define GFC_GC_VALUE_TOO_SHORT -1 + +/* Processor-specific status failure code. */ +#define GFC_GC_FAILURE 42 + + +extern void get_command_argument_i4 (GFC_INTEGER_4 *, char *, GFC_INTEGER_4 *, + GFC_INTEGER_4 *, gfc_charlen_type); +iexport_proto(get_command_argument_i4); + +/* Get a single commandline argument. */ + +void +get_command_argument_i4 (GFC_INTEGER_4 *number, char *value, + GFC_INTEGER_4 *length, GFC_INTEGER_4 *status, + gfc_charlen_type value_len) +{ + int argc, arglen = 0, stat_flag = GFC_GC_SUCCESS; + char **argv; + + if (number == NULL ) + /* Should never happen. */ + runtime_error ("Missing argument to get_command_argument"); + + if (value == NULL && length == NULL && status == NULL) + return; /* No need to do anything. */ + + get_args (&argc, &argv); + + if (*number < 0 || *number >= argc) + stat_flag = GFC_GC_FAILURE; + else + arglen = strlen(argv[*number]); + + if (value != NULL) + { + if (value_len < 1) + stat_flag = GFC_GC_FAILURE; + else + memset (value, ' ', value_len); + } + + if (value != NULL && stat_flag != GFC_GC_FAILURE) + { + if (arglen > value_len) + stat_flag = GFC_GC_VALUE_TOO_SHORT; + + memcpy (value, argv[*number], arglen <= value_len ? arglen : value_len); + } + + if (length != NULL) + *length = arglen; + + if (status != NULL) + *status = stat_flag; +} +iexport(get_command_argument_i4); + + +/* INTEGER*8 wrapper for get_command_argument. */ + +extern void get_command_argument_i8 (GFC_INTEGER_8 *, char *, GFC_INTEGER_8 *, + GFC_INTEGER_8 *, gfc_charlen_type); +export_proto(get_command_argument_i8); + +void +get_command_argument_i8 (GFC_INTEGER_8 *number, char *value, + GFC_INTEGER_8 *length, GFC_INTEGER_8 *status, + gfc_charlen_type value_len) +{ + GFC_INTEGER_4 number4; + GFC_INTEGER_4 length4; + GFC_INTEGER_4 status4; + + number4 = (GFC_INTEGER_4) *number; + get_command_argument_i4 (&number4, value, &length4, &status4, value_len); + if (length) + *length = length4; + if (status) + *status = status4; +} + + +/* Return the whole commandline. */ + +extern void get_command_i4 (char *, GFC_INTEGER_4 *, GFC_INTEGER_4 *, + gfc_charlen_type); +iexport_proto(get_command_i4); + +void +get_command_i4 (char *command, GFC_INTEGER_4 *length, GFC_INTEGER_4 *status, + gfc_charlen_type command_len) +{ + int i, argc, arglen, thisarg; + int stat_flag = GFC_GC_SUCCESS; + int tot_len = 0; + char **argv; + + if (command == NULL && length == NULL && status == NULL) + return; /* No need to do anything. */ + + get_args (&argc, &argv); + + if (command != NULL) + { + /* Initialize the string to blanks. */ + if (command_len < 1) + stat_flag = GFC_GC_FAILURE; + else + memset (command, ' ', command_len); + } + + for (i = 0; i < argc ; i++) + { + arglen = strlen(argv[i]); + + if (command != NULL && stat_flag == GFC_GC_SUCCESS) + { + thisarg = arglen; + if (tot_len + thisarg > command_len) + { + thisarg = command_len - tot_len; /* Truncate. */ + stat_flag = GFC_GC_VALUE_TOO_SHORT; + } + /* Also a space before the next arg. */ + else if (i != argc - 1 && tot_len + arglen == command_len) + stat_flag = GFC_GC_VALUE_TOO_SHORT; + + memcpy (&command[tot_len], argv[i], thisarg); + } + + /* Add the legth of the argument. */ + tot_len += arglen; + if (i != argc - 1) + tot_len++; + } + + if (length != NULL) + *length = tot_len; + + if (status != NULL) + *status = stat_flag; +} +iexport(get_command_i4); + + +/* INTEGER*8 wrapper for get_command. */ + +extern void get_command_i8 (char *, GFC_INTEGER_8 *, GFC_INTEGER_8 *, + gfc_charlen_type); +export_proto(get_command_i8); + +void +get_command_i8 (char *command, GFC_INTEGER_8 *length, GFC_INTEGER_8 *status, + gfc_charlen_type command_len) +{ + GFC_INTEGER_4 length4; + GFC_INTEGER_4 status4; + + get_command_i4 (command, &length4, &status4, command_len); + if (length) + *length = length4; + if (status) + *status = status4; +} diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c new file mode 100644 index 000000000..0aade1d95 --- /dev/null +++ b/libgfortran/intrinsics/associated.c @@ -0,0 +1,58 @@ +/* Implementation of the ASSOCIATED intrinsic + Copyright 2003, 2009 Free Software Foundation, Inc. + Contributed by kejia Zhao (CCRG) + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +extern int associated (const gfc_array_void *, const gfc_array_void *); +export_proto(associated); + +int +associated (const gfc_array_void *pointer, const gfc_array_void *target) +{ + int n, rank; + + if (GFC_DESCRIPTOR_DATA (pointer) == NULL) + return 0; + if (GFC_DESCRIPTOR_DATA (pointer) != GFC_DESCRIPTOR_DATA (target)) + return 0; + if (GFC_DESCRIPTOR_DTYPE (pointer) != GFC_DESCRIPTOR_DTYPE (target)) + return 0; + + rank = GFC_DESCRIPTOR_RANK (pointer); + for (n = 0; n < rank; n++) + { + long extent; + extent = GFC_DESCRIPTOR_EXTENT(pointer,n); + + if (extent != GFC_DESCRIPTOR_EXTENT(target,n)) + return 0; + if (GFC_DESCRIPTOR_STRIDE(pointer,n) != GFC_DESCRIPTOR_STRIDE(target,n) && extent != 1) + return 0; + if (extent <= 0) + return 0; + } + + return 1; +} diff --git a/libgfortran/intrinsics/bit_intrinsics.c b/libgfortran/intrinsics/bit_intrinsics.c new file mode 100644 index 000000000..92f5f039b --- /dev/null +++ b/libgfortran/intrinsics/bit_intrinsics.c @@ -0,0 +1,138 @@ +/* Implementation of the bit intrinsics not implemented as GCC builtins. + Copyright (C) 2009 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + +#ifdef HAVE_GFC_INTEGER_16 +extern int clz128 (GFC_INTEGER_16); +export_proto(clz128); + +int +clz128 (GFC_INTEGER_16 x) +{ + int res = 127; + + // We can't write 0xFFFFFFFFFFFFFFFF0000000000000000, so we work around it + if (x & ((__uint128_t) 0xFFFFFFFFFFFFFFFF << 64)) + { + res -= 64; + x >>= 64; + } + + if (x & 0xFFFFFFFF00000000) + { + res -= 32; + x >>= 32; + } + + if (x & 0xFFFF0000) + { + res -= 16; + x >>= 16; + } + + if (x & 0xFF00) + { + res -= 8; + x >>= 8; + } + + if (x & 0xF0) + { + res -= 4; + x >>= 4; + } + + if (x & 0xC) + { + res -= 2; + x >>= 2; + } + + if (x & 0x2) + { + res -= 1; + x >>= 1; + } + + return res; +} +#endif + + +#ifdef HAVE_GFC_INTEGER_16 +extern int ctz128 (GFC_INTEGER_16); +export_proto(ctz128); + +int +ctz128 (GFC_INTEGER_16 x) +{ + int res = 0; + + if ((x & 0xFFFFFFFFFFFFFFFF) == 0) + { + res += 64; + x >>= 64; + } + + if ((x & 0xFFFFFFFF) == 0) + { + res += 32; + x >>= 32; + } + + if ((x & 0xFFFF) == 0) + { + res += 16; + x >>= 16; + } + + if ((x & 0xFF) == 0) + { + res += 8; + x >>= 8; + } + + if ((x & 0xF) == 0) + { + res += 4; + x >>= 4; + } + + if ((x & 0x3) == 0) + { + res += 2; + x >>= 2; + } + + if ((x & 0x1) == 0) + { + res += 1; + x >>= 1; + } + + return res; +} +#endif diff --git a/libgfortran/intrinsics/c99_functions.c b/libgfortran/intrinsics/c99_functions.c new file mode 100644 index 000000000..9ba5544a0 --- /dev/null +++ b/libgfortran/intrinsics/c99_functions.c @@ -0,0 +1,2135 @@ +/* Implementation of various C99 functions + Copyright (C) 2004, 2009, 2010 Free Software Foundation, Inc. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "config.h" + +#define C99_PROTOS_H WE_DONT_WANT_PROTOS_NOW +#include "libgfortran.h" + +/* IRIX's declares a non-C99 compliant implementation of cabs, + which takes two floating point arguments instead of a single complex. + If is missing this prevents building of c99_functions.c. + To work around this we redirect cabs{,f,l} calls to __gfc_cabs{,f,l}. */ + +#if defined(__sgi__) && !defined(HAVE_COMPLEX_H) +#undef HAVE_CABS +#undef HAVE_CABSF +#undef HAVE_CABSL +#define cabs __gfc_cabs +#define cabsf __gfc_cabsf +#define cabsl __gfc_cabsl +#endif + +/* Tru64's declares a non-C99 compliant implementation of cabs, + which takes two floating point arguments instead of a single complex. + To work around this we redirect cabs{,f,l} calls to __gfc_cabs{,f,l}. */ + +#ifdef __osf__ +#undef HAVE_CABS +#undef HAVE_CABSF +#undef HAVE_CABSL +#define cabs __gfc_cabs +#define cabsf __gfc_cabsf +#define cabsl __gfc_cabsl +#endif + +/* On a C99 system "I" (with I*I = -1) should be defined in complex.h; + if not, we define a fallback version here. */ +#ifndef I +# if defined(_Imaginary_I) +# define I _Imaginary_I +# elif defined(_Complex_I) +# define I _Complex_I +# else +# define I (1.0fi) +# endif +#endif + +/* Prototypes are included to silence -Wstrict-prototypes + -Wmissing-prototypes. */ + + +/* Wrappers for systems without the various C99 single precision Bessel + functions. */ + +#if defined(HAVE_J0) && ! defined(HAVE_J0F) +#define HAVE_J0F 1 +float j0f (float); + +float +j0f (float x) +{ + return (float) j0 ((double) x); +} +#endif + +#if defined(HAVE_J1) && !defined(HAVE_J1F) +#define HAVE_J1F 1 +float j1f (float); + +float j1f (float x) +{ + return (float) j1 ((double) x); +} +#endif + +#if defined(HAVE_JN) && !defined(HAVE_JNF) +#define HAVE_JNF 1 +float jnf (int, float); + +float +jnf (int n, float x) +{ + return (float) jn (n, (double) x); +} +#endif + +#if defined(HAVE_Y0) && !defined(HAVE_Y0F) +#define HAVE_Y0F 1 +float y0f (float); + +float +y0f (float x) +{ + return (float) y0 ((double) x); +} +#endif + +#if defined(HAVE_Y1) && !defined(HAVE_Y1F) +#define HAVE_Y1F 1 +float y1f (float); + +float +y1f (float x) +{ + return (float) y1 ((double) x); +} +#endif + +#if defined(HAVE_YN) && !defined(HAVE_YNF) +#define HAVE_YNF 1 +float ynf (int, float); + +float +ynf (int n, float x) +{ + return (float) yn (n, (double) x); +} +#endif + + +/* Wrappers for systems without the C99 erff() and erfcf() functions. */ + +#if defined(HAVE_ERF) && !defined(HAVE_ERFF) +#define HAVE_ERFF 1 +float erff (float); + +float +erff (float x) +{ + return (float) erf ((double) x); +} +#endif + +#if defined(HAVE_ERFC) && !defined(HAVE_ERFCF) +#define HAVE_ERFCF 1 +float erfcf (float); + +float +erfcf (float x) +{ + return (float) erfc ((double) x); +} +#endif + + +#ifndef HAVE_ACOSF +#define HAVE_ACOSF 1 +float acosf (float x); + +float +acosf (float x) +{ + return (float) acos (x); +} +#endif + +#if HAVE_ACOSH && !HAVE_ACOSHF +float acoshf (float x); + +float +acoshf (float x) +{ + return (float) acosh ((double) x); +} +#endif + +#ifndef HAVE_ASINF +#define HAVE_ASINF 1 +float asinf (float x); + +float +asinf (float x) +{ + return (float) asin (x); +} +#endif + +#if HAVE_ASINH && !HAVE_ASINHF +float asinhf (float x); + +float +asinhf (float x) +{ + return (float) asinh ((double) x); +} +#endif + +#ifndef HAVE_ATAN2F +#define HAVE_ATAN2F 1 +float atan2f (float y, float x); + +float +atan2f (float y, float x) +{ + return (float) atan2 (y, x); +} +#endif + +#ifndef HAVE_ATANF +#define HAVE_ATANF 1 +float atanf (float x); + +float +atanf (float x) +{ + return (float) atan (x); +} +#endif + +#if HAVE_ATANH && !HAVE_ATANHF +float atanhf (float x); + +float +atanhf (float x) +{ + return (float) atanh ((double) x); +} +#endif + +#ifndef HAVE_CEILF +#define HAVE_CEILF 1 +float ceilf (float x); + +float +ceilf (float x) +{ + return (float) ceil (x); +} +#endif + +#ifndef HAVE_COPYSIGNF +#define HAVE_COPYSIGNF 1 +float copysignf (float x, float y); + +float +copysignf (float x, float y) +{ + return (float) copysign (x, y); +} +#endif + +#ifndef HAVE_COSF +#define HAVE_COSF 1 +float cosf (float x); + +float +cosf (float x) +{ + return (float) cos (x); +} +#endif + +#ifndef HAVE_COSHF +#define HAVE_COSHF 1 +float coshf (float x); + +float +coshf (float x) +{ + return (float) cosh (x); +} +#endif + +#ifndef HAVE_EXPF +#define HAVE_EXPF 1 +float expf (float x); + +float +expf (float x) +{ + return (float) exp (x); +} +#endif + +#ifndef HAVE_FABSF +#define HAVE_FABSF 1 +float fabsf (float x); + +float +fabsf (float x) +{ + return (float) fabs (x); +} +#endif + +#ifndef HAVE_FLOORF +#define HAVE_FLOORF 1 +float floorf (float x); + +float +floorf (float x) +{ + return (float) floor (x); +} +#endif + +#ifndef HAVE_FMODF +#define HAVE_FMODF 1 +float fmodf (float x, float y); + +float +fmodf (float x, float y) +{ + return (float) fmod (x, y); +} +#endif + +#ifndef HAVE_FREXPF +#define HAVE_FREXPF 1 +float frexpf (float x, int *exp); + +float +frexpf (float x, int *exp) +{ + return (float) frexp (x, exp); +} +#endif + +#ifndef HAVE_HYPOTF +#define HAVE_HYPOTF 1 +float hypotf (float x, float y); + +float +hypotf (float x, float y) +{ + return (float) hypot (x, y); +} +#endif + +#ifndef HAVE_LOGF +#define HAVE_LOGF 1 +float logf (float x); + +float +logf (float x) +{ + return (float) log (x); +} +#endif + +#ifndef HAVE_LOG10F +#define HAVE_LOG10F 1 +float log10f (float x); + +float +log10f (float x) +{ + return (float) log10 (x); +} +#endif + +#ifndef HAVE_SCALBN +#define HAVE_SCALBN 1 +double scalbn (double x, int y); + +double +scalbn (double x, int y) +{ +#if (FLT_RADIX == 2) && defined(HAVE_LDEXP) + return ldexp (x, y); +#else + return x * pow (FLT_RADIX, y); +#endif +} +#endif + +#ifndef HAVE_SCALBNF +#define HAVE_SCALBNF 1 +float scalbnf (float x, int y); + +float +scalbnf (float x, int y) +{ + return (float) scalbn (x, y); +} +#endif + +#ifndef HAVE_SINF +#define HAVE_SINF 1 +float sinf (float x); + +float +sinf (float x) +{ + return (float) sin (x); +} +#endif + +#ifndef HAVE_SINHF +#define HAVE_SINHF 1 +float sinhf (float x); + +float +sinhf (float x) +{ + return (float) sinh (x); +} +#endif + +#ifndef HAVE_SQRTF +#define HAVE_SQRTF 1 +float sqrtf (float x); + +float +sqrtf (float x) +{ + return (float) sqrt (x); +} +#endif + +#ifndef HAVE_TANF +#define HAVE_TANF 1 +float tanf (float x); + +float +tanf (float x) +{ + return (float) tan (x); +} +#endif + +#ifndef HAVE_TANHF +#define HAVE_TANHF 1 +float tanhf (float x); + +float +tanhf (float x) +{ + return (float) tanh (x); +} +#endif + +#ifndef HAVE_TRUNC +#define HAVE_TRUNC 1 +double trunc (double x); + +double +trunc (double x) +{ + if (!isfinite (x)) + return x; + + if (x < 0.0) + return - floor (-x); + else + return floor (x); +} +#endif + +#ifndef HAVE_TRUNCF +#define HAVE_TRUNCF 1 +float truncf (float x); + +float +truncf (float x) +{ + return (float) trunc (x); +} +#endif + +#ifndef HAVE_NEXTAFTERF +#define HAVE_NEXTAFTERF 1 +/* This is a portable implementation of nextafterf that is intended to be + independent of the floating point format or its in memory representation. + This implementation works correctly with denormalized values. */ +float nextafterf (float x, float y); + +float +nextafterf (float x, float y) +{ + /* This variable is marked volatile to avoid excess precision problems + on some platforms, including IA-32. */ + volatile float delta; + float absx, denorm_min; + + if (isnan (x) || isnan (y)) + return x + y; + if (x == y) + return x; + if (!isfinite (x)) + return x > 0 ? __FLT_MAX__ : - __FLT_MAX__; + + /* absx = fabsf (x); */ + absx = (x < 0.0) ? -x : x; + + /* __FLT_DENORM_MIN__ is non-zero iff the target supports denormals. */ + if (__FLT_DENORM_MIN__ == 0.0f) + denorm_min = __FLT_MIN__; + else + denorm_min = __FLT_DENORM_MIN__; + + if (absx < __FLT_MIN__) + delta = denorm_min; + else + { + float frac; + int exp; + + /* Discard the fraction from x. */ + frac = frexpf (absx, &exp); + delta = scalbnf (0.5f, exp); + + /* Scale x by the epsilon of the representation. By rights we should + have been able to combine this with scalbnf, but some targets don't + get that correct with denormals. */ + delta *= __FLT_EPSILON__; + + /* If we're going to be reducing the absolute value of X, and doing so + would reduce the exponent of X, then the delta to be applied is + one exponent smaller. */ + if (frac == 0.5f && (y < x) == (x > 0)) + delta *= 0.5f; + + /* If that underflows to zero, then we're back to the minimum. */ + if (delta == 0.0f) + delta = denorm_min; + } + + if (y < x) + delta = -delta; + + return x + delta; +} +#endif + + +#if !defined(HAVE_POWF) || defined(HAVE_BROKEN_POWF) +#ifndef HAVE_POWF +#define HAVE_POWF 1 +#endif +float powf (float x, float y); + +float +powf (float x, float y) +{ + return (float) pow (x, y); +} +#endif + + +/* Algorithm by Steven G. Kargl. */ + +#if !defined(HAVE_ROUNDL) +#define HAVE_ROUNDL 1 +long double roundl (long double x); + +#if defined(HAVE_CEILL) +/* Round to nearest integral value. If the argument is halfway between two + integral values then round away from zero. */ + +long double +roundl (long double x) +{ + long double t; + if (!isfinite (x)) + return (x); + + if (x >= 0.0) + { + t = ceill (x); + if (t - x > 0.5) + t -= 1.0; + return (t); + } + else + { + t = ceill (-x); + if (t + x > 0.5) + t -= 1.0; + return (-t); + } +} +#else + +/* Poor version of roundl for system that don't have ceill. */ +long double +roundl (long double x) +{ + if (x > DBL_MAX || x < -DBL_MAX) + { +#ifdef HAVE_NEXTAFTERL + long double prechalf = nextafterl (0.5L, LDBL_MAX); +#else + static long double prechalf = 0.5L; +#endif + return (GFC_INTEGER_LARGEST) (x + (x > 0 ? prechalf : -prechalf)); + } + else + /* Use round(). */ + return round ((double) x); +} + +#endif +#endif + +#ifndef HAVE_ROUND +#define HAVE_ROUND 1 +/* Round to nearest integral value. If the argument is halfway between two + integral values then round away from zero. */ +double round (double x); + +double +round (double x) +{ + double t; + if (!isfinite (x)) + return (x); + + if (x >= 0.0) + { + t = floor (x); + if (t - x <= -0.5) + t += 1.0; + return (t); + } + else + { + t = floor (-x); + if (t + x <= -0.5) + t += 1.0; + return (-t); + } +} +#endif + +#ifndef HAVE_ROUNDF +#define HAVE_ROUNDF 1 +/* Round to nearest integral value. If the argument is halfway between two + integral values then round away from zero. */ +float roundf (float x); + +float +roundf (float x) +{ + float t; + if (!isfinite (x)) + return (x); + + if (x >= 0.0) + { + t = floorf (x); + if (t - x <= -0.5) + t += 1.0; + return (t); + } + else + { + t = floorf (-x); + if (t + x <= -0.5) + t += 1.0; + return (-t); + } +} +#endif + + +/* lround{f,,l} and llround{f,,l} functions. */ + +#if !defined(HAVE_LROUNDF) && defined(HAVE_ROUNDF) +#define HAVE_LROUNDF 1 +long int lroundf (float x); + +long int +lroundf (float x) +{ + return (long int) roundf (x); +} +#endif + +#if !defined(HAVE_LROUND) && defined(HAVE_ROUND) +#define HAVE_LROUND 1 +long int lround (double x); + +long int +lround (double x) +{ + return (long int) round (x); +} +#endif + +#if !defined(HAVE_LROUNDL) && defined(HAVE_ROUNDL) +#define HAVE_LROUNDL 1 +long int lroundl (long double x); + +long int +lroundl (long double x) +{ + return (long long int) roundl (x); +} +#endif + +#if !defined(HAVE_LLROUNDF) && defined(HAVE_ROUNDF) +#define HAVE_LLROUNDF 1 +long long int llroundf (float x); + +long long int +llroundf (float x) +{ + return (long long int) roundf (x); +} +#endif + +#if !defined(HAVE_LLROUND) && defined(HAVE_ROUND) +#define HAVE_LLROUND 1 +long long int llround (double x); + +long long int +llround (double x) +{ + return (long long int) round (x); +} +#endif + +#if !defined(HAVE_LLROUNDL) && defined(HAVE_ROUNDL) +#define HAVE_LLROUNDL 1 +long long int llroundl (long double x); + +long long int +llroundl (long double x) +{ + return (long long int) roundl (x); +} +#endif + + +#ifndef HAVE_LOG10L +#define HAVE_LOG10L 1 +/* log10 function for long double variables. The version provided here + reduces the argument until it fits into a double, then use log10. */ +long double log10l (long double x); + +long double +log10l (long double x) +{ +#if LDBL_MAX_EXP > DBL_MAX_EXP + if (x > DBL_MAX) + { + double val; + int p2_result = 0; + if (x > 0x1p16383L) { p2_result += 16383; x /= 0x1p16383L; } + if (x > 0x1p8191L) { p2_result += 8191; x /= 0x1p8191L; } + if (x > 0x1p4095L) { p2_result += 4095; x /= 0x1p4095L; } + if (x > 0x1p2047L) { p2_result += 2047; x /= 0x1p2047L; } + if (x > 0x1p1023L) { p2_result += 1023; x /= 0x1p1023L; } + val = log10 ((double) x); + return (val + p2_result * .30102999566398119521373889472449302L); + } +#endif +#if LDBL_MIN_EXP < DBL_MIN_EXP + if (x < DBL_MIN) + { + double val; + int p2_result = 0; + if (x < 0x1p-16380L) { p2_result += 16380; x /= 0x1p-16380L; } + if (x < 0x1p-8189L) { p2_result += 8189; x /= 0x1p-8189L; } + if (x < 0x1p-4093L) { p2_result += 4093; x /= 0x1p-4093L; } + if (x < 0x1p-2045L) { p2_result += 2045; x /= 0x1p-2045L; } + if (x < 0x1p-1021L) { p2_result += 1021; x /= 0x1p-1021L; } + val = fabs (log10 ((double) x)); + return (- val - p2_result * .30102999566398119521373889472449302L); + } +#endif + return log10 (x); +} +#endif + + +#ifndef HAVE_FLOORL +#define HAVE_FLOORL 1 +long double floorl (long double x); + +long double +floorl (long double x) +{ + /* Zero, possibly signed. */ + if (x == 0) + return x; + + /* Large magnitude. */ + if (x > DBL_MAX || x < (-DBL_MAX)) + return x; + + /* Small positive values. */ + if (x >= 0 && x < DBL_MIN) + return 0; + + /* Small negative values. */ + if (x < 0 && x > (-DBL_MIN)) + return -1; + + return floor (x); +} +#endif + + +#ifndef HAVE_FMODL +#define HAVE_FMODL 1 +long double fmodl (long double x, long double y); + +long double +fmodl (long double x, long double y) +{ + if (y == 0.0L) + return 0.0L; + + /* Need to check that the result has the same sign as x and magnitude + less than the magnitude of y. */ + return x - floorl (x / y) * y; +} +#endif + + +#if !defined(HAVE_CABSF) +#define HAVE_CABSF 1 +float cabsf (float complex z); + +float +cabsf (float complex z) +{ + return hypotf (REALPART (z), IMAGPART (z)); +} +#endif + +#if !defined(HAVE_CABS) +#define HAVE_CABS 1 +double cabs (double complex z); + +double +cabs (double complex z) +{ + return hypot (REALPART (z), IMAGPART (z)); +} +#endif + +#if !defined(HAVE_CABSL) && defined(HAVE_HYPOTL) +#define HAVE_CABSL 1 +long double cabsl (long double complex z); + +long double +cabsl (long double complex z) +{ + return hypotl (REALPART (z), IMAGPART (z)); +} +#endif + + +#if !defined(HAVE_CARGF) +#define HAVE_CARGF 1 +float cargf (float complex z); + +float +cargf (float complex z) +{ + return atan2f (IMAGPART (z), REALPART (z)); +} +#endif + +#if !defined(HAVE_CARG) +#define HAVE_CARG 1 +double carg (double complex z); + +double +carg (double complex z) +{ + return atan2 (IMAGPART (z), REALPART (z)); +} +#endif + +#if !defined(HAVE_CARGL) && defined(HAVE_ATAN2L) +#define HAVE_CARGL 1 +long double cargl (long double complex z); + +long double +cargl (long double complex z) +{ + return atan2l (IMAGPART (z), REALPART (z)); +} +#endif + + +/* exp(z) = exp(a)*(cos(b) + i sin(b)) */ +#if !defined(HAVE_CEXPF) +#define HAVE_CEXPF 1 +float complex cexpf (float complex z); + +float complex +cexpf (float complex z) +{ + float a, b; + float complex v; + + a = REALPART (z); + b = IMAGPART (z); + COMPLEX_ASSIGN (v, cosf (b), sinf (b)); + return expf (a) * v; +} +#endif + +#if !defined(HAVE_CEXP) +#define HAVE_CEXP 1 +double complex cexp (double complex z); + +double complex +cexp (double complex z) +{ + double a, b; + double complex v; + + a = REALPART (z); + b = IMAGPART (z); + COMPLEX_ASSIGN (v, cos (b), sin (b)); + return exp (a) * v; +} +#endif + +#if !defined(HAVE_CEXPL) && defined(HAVE_COSL) && defined(HAVE_SINL) && defined(EXPL) +#define HAVE_CEXPL 1 +long double complex cexpl (long double complex z); + +long double complex +cexpl (long double complex z) +{ + long double a, b; + long double complex v; + + a = REALPART (z); + b = IMAGPART (z); + COMPLEX_ASSIGN (v, cosl (b), sinl (b)); + return expl (a) * v; +} +#endif + + +/* log(z) = log (cabs(z)) + i*carg(z) */ +#if !defined(HAVE_CLOGF) +#define HAVE_CLOGF 1 +float complex clogf (float complex z); + +float complex +clogf (float complex z) +{ + float complex v; + + COMPLEX_ASSIGN (v, logf (cabsf (z)), cargf (z)); + return v; +} +#endif + +#if !defined(HAVE_CLOG) +#define HAVE_CLOG 1 +double complex clog (double complex z); + +double complex +clog (double complex z) +{ + double complex v; + + COMPLEX_ASSIGN (v, log (cabs (z)), carg (z)); + return v; +} +#endif + +#if !defined(HAVE_CLOGL) && defined(HAVE_LOGL) && defined(HAVE_CABSL) && defined(HAVE_CARGL) +#define HAVE_CLOGL 1 +long double complex clogl (long double complex z); + +long double complex +clogl (long double complex z) +{ + long double complex v; + + COMPLEX_ASSIGN (v, logl (cabsl (z)), cargl (z)); + return v; +} +#endif + + +/* log10(z) = log10 (cabs(z)) + i*carg(z) */ +#if !defined(HAVE_CLOG10F) +#define HAVE_CLOG10F 1 +float complex clog10f (float complex z); + +float complex +clog10f (float complex z) +{ + float complex v; + + COMPLEX_ASSIGN (v, log10f (cabsf (z)), cargf (z)); + return v; +} +#endif + +#if !defined(HAVE_CLOG10) +#define HAVE_CLOG10 1 +double complex clog10 (double complex z); + +double complex +clog10 (double complex z) +{ + double complex v; + + COMPLEX_ASSIGN (v, log10 (cabs (z)), carg (z)); + return v; +} +#endif + +#if !defined(HAVE_CLOG10L) && defined(HAVE_LOG10L) && defined(HAVE_CABSL) && defined(HAVE_CARGL) +#define HAVE_CLOG10L 1 +long double complex clog10l (long double complex z); + +long double complex +clog10l (long double complex z) +{ + long double complex v; + + COMPLEX_ASSIGN (v, log10l (cabsl (z)), cargl (z)); + return v; +} +#endif + + +/* pow(base, power) = cexp (power * clog (base)) */ +#if !defined(HAVE_CPOWF) +#define HAVE_CPOWF 1 +float complex cpowf (float complex base, float complex power); + +float complex +cpowf (float complex base, float complex power) +{ + return cexpf (power * clogf (base)); +} +#endif + +#if !defined(HAVE_CPOW) +#define HAVE_CPOW 1 +double complex cpow (double complex base, double complex power); + +double complex +cpow (double complex base, double complex power) +{ + return cexp (power * clog (base)); +} +#endif + +#if !defined(HAVE_CPOWL) && defined(HAVE_CEXPL) && defined(HAVE_CLOGL) +#define HAVE_CPOWL 1 +long double complex cpowl (long double complex base, long double complex power); + +long double complex +cpowl (long double complex base, long double complex power) +{ + return cexpl (power * clogl (base)); +} +#endif + + +/* sqrt(z). Algorithm pulled from glibc. */ +#if !defined(HAVE_CSQRTF) +#define HAVE_CSQRTF 1 +float complex csqrtf (float complex z); + +float complex +csqrtf (float complex z) +{ + float re, im; + float complex v; + + re = REALPART (z); + im = IMAGPART (z); + if (im == 0) + { + if (re < 0) + { + COMPLEX_ASSIGN (v, 0, copysignf (sqrtf (-re), im)); + } + else + { + COMPLEX_ASSIGN (v, fabsf (sqrtf (re)), copysignf (0, im)); + } + } + else if (re == 0) + { + float r; + + r = sqrtf (0.5 * fabsf (im)); + + COMPLEX_ASSIGN (v, r, copysignf (r, im)); + } + else + { + float d, r, s; + + d = hypotf (re, im); + /* Use the identity 2 Re res Im res = Im x + to avoid cancellation error in d +/- Re x. */ + if (re > 0) + { + r = sqrtf (0.5 * d + 0.5 * re); + s = (0.5 * im) / r; + } + else + { + s = sqrtf (0.5 * d - 0.5 * re); + r = fabsf ((0.5 * im) / s); + } + + COMPLEX_ASSIGN (v, r, copysignf (s, im)); + } + return v; +} +#endif + +#if !defined(HAVE_CSQRT) +#define HAVE_CSQRT 1 +double complex csqrt (double complex z); + +double complex +csqrt (double complex z) +{ + double re, im; + double complex v; + + re = REALPART (z); + im = IMAGPART (z); + if (im == 0) + { + if (re < 0) + { + COMPLEX_ASSIGN (v, 0, copysign (sqrt (-re), im)); + } + else + { + COMPLEX_ASSIGN (v, fabs (sqrt (re)), copysign (0, im)); + } + } + else if (re == 0) + { + double r; + + r = sqrt (0.5 * fabs (im)); + + COMPLEX_ASSIGN (v, r, copysign (r, im)); + } + else + { + double d, r, s; + + d = hypot (re, im); + /* Use the identity 2 Re res Im res = Im x + to avoid cancellation error in d +/- Re x. */ + if (re > 0) + { + r = sqrt (0.5 * d + 0.5 * re); + s = (0.5 * im) / r; + } + else + { + s = sqrt (0.5 * d - 0.5 * re); + r = fabs ((0.5 * im) / s); + } + + COMPLEX_ASSIGN (v, r, copysign (s, im)); + } + return v; +} +#endif + +#if !defined(HAVE_CSQRTL) && defined(HAVE_COPYSIGNL) && defined(HAVE_SQRTL) && defined(HAVE_FABSL) && defined(HAVE_HYPOTL) +#define HAVE_CSQRTL 1 +long double complex csqrtl (long double complex z); + +long double complex +csqrtl (long double complex z) +{ + long double re, im; + long double complex v; + + re = REALPART (z); + im = IMAGPART (z); + if (im == 0) + { + if (re < 0) + { + COMPLEX_ASSIGN (v, 0, copysignl (sqrtl (-re), im)); + } + else + { + COMPLEX_ASSIGN (v, fabsl (sqrtl (re)), copysignl (0, im)); + } + } + else if (re == 0) + { + long double r; + + r = sqrtl (0.5 * fabsl (im)); + + COMPLEX_ASSIGN (v, copysignl (r, im), r); + } + else + { + long double d, r, s; + + d = hypotl (re, im); + /* Use the identity 2 Re res Im res = Im x + to avoid cancellation error in d +/- Re x. */ + if (re > 0) + { + r = sqrtl (0.5 * d + 0.5 * re); + s = (0.5 * im) / r; + } + else + { + s = sqrtl (0.5 * d - 0.5 * re); + r = fabsl ((0.5 * im) / s); + } + + COMPLEX_ASSIGN (v, r, copysignl (s, im)); + } + return v; +} +#endif + + +/* sinh(a + i b) = sinh(a) cos(b) + i cosh(a) sin(b) */ +#if !defined(HAVE_CSINHF) +#define HAVE_CSINHF 1 +float complex csinhf (float complex a); + +float complex +csinhf (float complex a) +{ + float r, i; + float complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinhf (r) * cosf (i), coshf (r) * sinf (i)); + return v; +} +#endif + +#if !defined(HAVE_CSINH) +#define HAVE_CSINH 1 +double complex csinh (double complex a); + +double complex +csinh (double complex a) +{ + double r, i; + double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinh (r) * cos (i), cosh (r) * sin (i)); + return v; +} +#endif + +#if !defined(HAVE_CSINHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CSINHL 1 +long double complex csinhl (long double complex a); + +long double complex +csinhl (long double complex a) +{ + long double r, i; + long double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinhl (r) * cosl (i), coshl (r) * sinl (i)); + return v; +} +#endif + + +/* cosh(a + i b) = cosh(a) cos(b) + i sinh(a) sin(b) */ +#if !defined(HAVE_CCOSHF) +#define HAVE_CCOSHF 1 +float complex ccoshf (float complex a); + +float complex +ccoshf (float complex a) +{ + float r, i; + float complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, coshf (r) * cosf (i), sinhf (r) * sinf (i)); + return v; +} +#endif + +#if !defined(HAVE_CCOSH) +#define HAVE_CCOSH 1 +double complex ccosh (double complex a); + +double complex +ccosh (double complex a) +{ + double r, i; + double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cosh (r) * cos (i), sinh (r) * sin (i)); + return v; +} +#endif + +#if !defined(HAVE_CCOSHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CCOSHL 1 +long double complex ccoshl (long double complex a); + +long double complex +ccoshl (long double complex a) +{ + long double r, i; + long double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, coshl (r) * cosl (i), sinhl (r) * sinl (i)); + return v; +} +#endif + + +/* tanh(a + i b) = (tanh(a) + i tan(b)) / (1 + i tanh(a) tan(b)) */ +#if !defined(HAVE_CTANHF) +#define HAVE_CTANHF 1 +float complex ctanhf (float complex a); + +float complex +ctanhf (float complex a) +{ + float rt, it; + float complex n, d; + + rt = tanhf (REALPART (a)); + it = tanf (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, rt * it); + + return n / d; +} +#endif + +#if !defined(HAVE_CTANH) +#define HAVE_CTANH 1 +double complex ctanh (double complex a); +double complex +ctanh (double complex a) +{ + double rt, it; + double complex n, d; + + rt = tanh (REALPART (a)); + it = tan (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, rt * it); + + return n / d; +} +#endif + +#if !defined(HAVE_CTANHL) && defined(HAVE_TANL) && defined(HAVE_TANHL) +#define HAVE_CTANHL 1 +long double complex ctanhl (long double complex a); + +long double complex +ctanhl (long double complex a) +{ + long double rt, it; + long double complex n, d; + + rt = tanhl (REALPART (a)); + it = tanl (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, rt * it); + + return n / d; +} +#endif + + +/* sin(a + i b) = sin(a) cosh(b) + i cos(a) sinh(b) */ +#if !defined(HAVE_CSINF) +#define HAVE_CSINF 1 +float complex csinf (float complex a); + +float complex +csinf (float complex a) +{ + float r, i; + float complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinf (r) * coshf (i), cosf (r) * sinhf (i)); + return v; +} +#endif + +#if !defined(HAVE_CSIN) +#define HAVE_CSIN 1 +double complex csin (double complex a); + +double complex +csin (double complex a) +{ + double r, i; + double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sin (r) * cosh (i), cos (r) * sinh (i)); + return v; +} +#endif + +#if !defined(HAVE_CSINL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CSINL 1 +long double complex csinl (long double complex a); + +long double complex +csinl (long double complex a) +{ + long double r, i; + long double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinl (r) * coshl (i), cosl (r) * sinhl (i)); + return v; +} +#endif + + +/* cos(a + i b) = cos(a) cosh(b) - i sin(a) sinh(b) */ +#if !defined(HAVE_CCOSF) +#define HAVE_CCOSF 1 +float complex ccosf (float complex a); + +float complex +ccosf (float complex a) +{ + float r, i; + float complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cosf (r) * coshf (i), - (sinf (r) * sinhf (i))); + return v; +} +#endif + +#if !defined(HAVE_CCOS) +#define HAVE_CCOS 1 +double complex ccos (double complex a); + +double complex +ccos (double complex a) +{ + double r, i; + double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cos (r) * cosh (i), - (sin (r) * sinh (i))); + return v; +} +#endif + +#if !defined(HAVE_CCOSL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CCOSL 1 +long double complex ccosl (long double complex a); + +long double complex +ccosl (long double complex a) +{ + long double r, i; + long double complex v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cosl (r) * coshl (i), - (sinl (r) * sinhl (i))); + return v; +} +#endif + + +/* tan(a + i b) = (tan(a) + i tanh(b)) / (1 - i tan(a) tanh(b)) */ +#if !defined(HAVE_CTANF) +#define HAVE_CTANF 1 +float complex ctanf (float complex a); + +float complex +ctanf (float complex a) +{ + float rt, it; + float complex n, d; + + rt = tanf (REALPART (a)); + it = tanhf (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; +} +#endif + +#if !defined(HAVE_CTAN) +#define HAVE_CTAN 1 +double complex ctan (double complex a); + +double complex +ctan (double complex a) +{ + double rt, it; + double complex n, d; + + rt = tan (REALPART (a)); + it = tanh (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; +} +#endif + +#if !defined(HAVE_CTANL) && defined(HAVE_TANL) && defined(HAVE_TANHL) +#define HAVE_CTANL 1 +long double complex ctanl (long double complex a); + +long double complex +ctanl (long double complex a) +{ + long double rt, it; + long double complex n, d; + + rt = tanl (REALPART (a)); + it = tanhl (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; +} +#endif + + +/* Complex ASIN. Returns wrongly NaN for infinite arguments. + Algorithm taken from Abramowitz & Stegun. */ + +#if !defined(HAVE_CASINF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF) +#define HAVE_CASINF 1 +complex float casinf (complex float z); + +complex float +casinf (complex float z) +{ + return -I*clogf (I*z + csqrtf (1.0f-z*z)); +} +#endif + + +#if !defined(HAVE_CASIN) && defined(HAVE_CLOG) && defined(HAVE_CSQRT) +#define HAVE_CASIN 1 +complex double casin (complex double z); + +complex double +casin (complex double z) +{ + return -I*clog (I*z + csqrt (1.0-z*z)); +} +#endif + + +#if !defined(HAVE_CASINL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL) +#define HAVE_CASINL 1 +complex long double casinl (complex long double z); + +complex long double +casinl (complex long double z) +{ + return -I*clogl (I*z + csqrtl (1.0L-z*z)); +} +#endif + + +/* Complex ACOS. Returns wrongly NaN for infinite arguments. + Algorithm taken from Abramowitz & Stegun. */ + +#if !defined(HAVE_CACOSF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF) +#define HAVE_CACOSF 1 +complex float cacosf (complex float z); + +complex float +cacosf (complex float z) +{ + return -I*clogf (z + I*csqrtf (1.0f-z*z)); +} +#endif + + +#if !defined(HAVE_CACOS) && defined(HAVE_CLOG) && defined(HAVE_CSQRT) +#define HAVE_CACOS 1 +complex double cacos (complex double z); + +complex double +cacos (complex double z) +{ + return -I*clog (z + I*csqrt (1.0-z*z)); +} +#endif + + +#if !defined(HAVE_CACOSL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL) +#define HAVE_CACOSL 1 +complex long double cacosl (complex long double z); + +complex long double +cacosl (complex long double z) +{ + return -I*clogl (z + I*csqrtl (1.0L-z*z)); +} +#endif + + +/* Complex ATAN. Returns wrongly NaN for infinite arguments. + Algorithm taken from Abramowitz & Stegun. */ + +#if !defined(HAVE_CATANF) && defined(HAVE_CLOGF) +#define HAVE_CACOSF 1 +complex float catanf (complex float z); + +complex float +catanf (complex float z) +{ + return I*clogf ((I+z)/(I-z))/2.0f; +} +#endif + + +#if !defined(HAVE_CATAN) && defined(HAVE_CLOG) +#define HAVE_CACOS 1 +complex double catan (complex double z); + +complex double +catan (complex double z) +{ + return I*clog ((I+z)/(I-z))/2.0; +} +#endif + + +#if !defined(HAVE_CATANL) && defined(HAVE_CLOGL) +#define HAVE_CACOSL 1 +complex long double catanl (complex long double z); + +complex long double +catanl (complex long double z) +{ + return I*clogl ((I+z)/(I-z))/2.0L; +} +#endif + + +/* Complex ASINH. Returns wrongly NaN for infinite arguments. + Algorithm taken from Abramowitz & Stegun. */ + +#if !defined(HAVE_CASINHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF) +#define HAVE_CASINHF 1 +complex float casinhf (complex float z); + +complex float +casinhf (complex float z) +{ + return clogf (z + csqrtf (z*z+1.0f)); +} +#endif + + +#if !defined(HAVE_CASINH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT) +#define HAVE_CASINH 1 +complex double casinh (complex double z); + +complex double +casinh (complex double z) +{ + return clog (z + csqrt (z*z+1.0)); +} +#endif + + +#if !defined(HAVE_CASINHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL) +#define HAVE_CASINHL 1 +complex long double casinhl (complex long double z); + +complex long double +casinhl (complex long double z) +{ + return clogl (z + csqrtl (z*z+1.0L)); +} +#endif + + +/* Complex ACOSH. Returns wrongly NaN for infinite arguments. + Algorithm taken from Abramowitz & Stegun. */ + +#if !defined(HAVE_CACOSHF) && defined(HAVE_CLOGF) && defined(HAVE_CSQRTF) +#define HAVE_CACOSHF 1 +complex float cacoshf (complex float z); + +complex float +cacoshf (complex float z) +{ + return clogf (z + csqrtf (z-1.0f) * csqrtf (z+1.0f)); +} +#endif + + +#if !defined(HAVE_CACOSH) && defined(HAVE_CLOG) && defined(HAVE_CSQRT) +#define HAVE_CACOSH 1 +complex double cacosh (complex double z); + +complex double +cacosh (complex double z) +{ + return clog (z + csqrt (z-1.0) * csqrt (z+1.0)); +} +#endif + + +#if !defined(HAVE_CACOSHL) && defined(HAVE_CLOGL) && defined(HAVE_CSQRTL) +#define HAVE_CACOSHL 1 +complex long double cacoshl (complex long double z); + +complex long double +cacoshl (complex long double z) +{ + return clogl (z + csqrtl (z-1.0L) * csqrtl (z+1.0L)); +} +#endif + + +/* Complex ATANH. Returns wrongly NaN for infinite arguments. + Algorithm taken from Abramowitz & Stegun. */ + +#if !defined(HAVE_CATANHF) && defined(HAVE_CLOGF) +#define HAVE_CATANHF 1 +complex float catanhf (complex float z); + +complex float +catanhf (complex float z) +{ + return clogf ((1.0f+z)/(1.0f-z))/2.0f; +} +#endif + + +#if !defined(HAVE_CATANH) && defined(HAVE_CLOG) +#define HAVE_CATANH 1 +complex double catanh (complex double z); + +complex double +catanh (complex double z) +{ + return clog ((1.0+z)/(1.0-z))/2.0; +} +#endif + +#if !defined(HAVE_CATANHL) && defined(HAVE_CLOGL) +#define HAVE_CATANHL 1 +complex long double catanhl (complex long double z); + +complex long double +catanhl (complex long double z) +{ + return clogl ((1.0L+z)/(1.0L-z))/2.0L; +} +#endif + + +#if !defined(HAVE_TGAMMA) +#define HAVE_TGAMMA 1 +double tgamma (double); + +/* Fallback tgamma() function. Uses the algorithm from + http://www.netlib.org/specfun/gamma and references therein. */ + +#undef SQRTPI +#define SQRTPI 0.9189385332046727417803297 + +#undef PI +#define PI 3.1415926535897932384626434 + +double +tgamma (double x) +{ + int i, n, parity; + double fact, res, sum, xden, xnum, y, y1, ysq, z; + + static double p[8] = { + -1.71618513886549492533811e0, 2.47656508055759199108314e1, + -3.79804256470945635097577e2, 6.29331155312818442661052e2, + 8.66966202790413211295064e2, -3.14512729688483675254357e4, + -3.61444134186911729807069e4, 6.64561438202405440627855e4 }; + + static double q[8] = { + -3.08402300119738975254353e1, 3.15350626979604161529144e2, + -1.01515636749021914166146e3, -3.10777167157231109440444e3, + 2.25381184209801510330112e4, 4.75584627752788110767815e3, + -1.34659959864969306392456e5, -1.15132259675553483497211e5 }; + + static double c[7] = { -1.910444077728e-03, + 8.4171387781295e-04, -5.952379913043012e-04, + 7.93650793500350248e-04, -2.777777777777681622553e-03, + 8.333333333333333331554247e-02, 5.7083835261e-03 }; + + static const double xminin = 2.23e-308; + static const double xbig = 171.624; + static const double xnan = __builtin_nan ("0x0"), xinf = __builtin_inf (); + static double eps = 0; + + if (eps == 0) + eps = nextafter (1., 2.) - 1.; + + parity = 0; + fact = 1; + n = 0; + y = x; + + if (isnan (x)) + return x; + + if (y <= 0) + { + y = -x; + y1 = trunc (y); + res = y - y1; + + if (res != 0) + { + if (y1 != trunc (y1*0.5l)*2) + parity = 1; + fact = -PI / sin (PI*res); + y = y + 1; + } + else + return x == 0 ? copysign (xinf, x) : xnan; + } + + if (y < eps) + { + if (y >= xminin) + res = 1 / y; + else + return xinf; + } + else if (y < 13) + { + y1 = y; + if (y < 1) + { + z = y; + y = y + 1; + } + else + { + n = (int)y - 1; + y = y - n; + z = y - 1; + } + + xnum = 0; + xden = 1; + for (i = 0; i < 8; i++) + { + xnum = (xnum + p[i]) * z; + xden = xden * z + q[i]; + } + + res = xnum / xden + 1; + + if (y1 < y) + res = res / y1; + else if (y1 > y) + for (i = 1; i <= n; i++) + { + res = res * y; + y = y + 1; + } + } + else + { + if (y < xbig) + { + ysq = y * y; + sum = c[6]; + for (i = 0; i < 6; i++) + sum = sum / ysq + c[i]; + + sum = sum/y - y + SQRTPI; + sum = sum + (y - 0.5) * log (y); + res = exp (sum); + } + else + return x < 0 ? xnan : xinf; + } + + if (parity) + res = -res; + if (fact != 1) + res = fact / res; + + return res; +} +#endif + + + +#if !defined(HAVE_LGAMMA) +#define HAVE_LGAMMA 1 +double lgamma (double); + +/* Fallback lgamma() function. Uses the algorithm from + http://www.netlib.org/specfun/algama and references therein, + except for negative arguments (where netlib would return +Inf) + where we use the following identity: + lgamma(y) = log(pi/(|y*sin(pi*y)|)) - lgamma(-y) + */ + +double +lgamma (double y) +{ + +#undef SQRTPI +#define SQRTPI 0.9189385332046727417803297 + +#undef PI +#define PI 3.1415926535897932384626434 + +#define PNT68 0.6796875 +#define D1 -0.5772156649015328605195174 +#define D2 0.4227843350984671393993777 +#define D4 1.791759469228055000094023 + + static double p1[8] = { + 4.945235359296727046734888e0, 2.018112620856775083915565e2, + 2.290838373831346393026739e3, 1.131967205903380828685045e4, + 2.855724635671635335736389e4, 3.848496228443793359990269e4, + 2.637748787624195437963534e4, 7.225813979700288197698961e3 }; + static double q1[8] = { + 6.748212550303777196073036e1, 1.113332393857199323513008e3, + 7.738757056935398733233834e3, 2.763987074403340708898585e4, + 5.499310206226157329794414e4, 6.161122180066002127833352e4, + 3.635127591501940507276287e4, 8.785536302431013170870835e3 }; + static double p2[8] = { + 4.974607845568932035012064e0, 5.424138599891070494101986e2, + 1.550693864978364947665077e4, 1.847932904445632425417223e5, + 1.088204769468828767498470e6, 3.338152967987029735917223e6, + 5.106661678927352456275255e6, 3.074109054850539556250927e6 }; + static double q2[8] = { + 1.830328399370592604055942e2, 7.765049321445005871323047e3, + 1.331903827966074194402448e5, 1.136705821321969608938755e6, + 5.267964117437946917577538e6, 1.346701454311101692290052e7, + 1.782736530353274213975932e7, 9.533095591844353613395747e6 }; + static double p4[8] = { + 1.474502166059939948905062e4, 2.426813369486704502836312e6, + 1.214755574045093227939592e8, 2.663432449630976949898078e9, + 2.940378956634553899906876e10, 1.702665737765398868392998e11, + 4.926125793377430887588120e11, 5.606251856223951465078242e11 }; + static double q4[8] = { + 2.690530175870899333379843e3, 6.393885654300092398984238e5, + 4.135599930241388052042842e7, 1.120872109616147941376570e9, + 1.488613728678813811542398e10, 1.016803586272438228077304e11, + 3.417476345507377132798597e11, 4.463158187419713286462081e11 }; + static double c[7] = { + -1.910444077728e-03, 8.4171387781295e-04, + -5.952379913043012e-04, 7.93650793500350248e-04, + -2.777777777777681622553e-03, 8.333333333333333331554247e-02, + 5.7083835261e-03 }; + + static double xbig = 2.55e305, xinf = __builtin_inf (), eps = 0, + frtbig = 2.25e76; + + int i; + double corr, res, xden, xm1, xm2, xm4, xnum, ysq; + + if (eps == 0) + eps = __builtin_nextafter (1., 2.) - 1.; + + if ((y > 0) && (y <= xbig)) + { + if (y <= eps) + res = -log (y); + else if (y <= 1.5) + { + if (y < PNT68) + { + corr = -log (y); + xm1 = y; + } + else + { + corr = 0; + xm1 = (y - 0.5) - 0.5; + } + + if ((y <= 0.5) || (y >= PNT68)) + { + xden = 1; + xnum = 0; + for (i = 0; i < 8; i++) + { + xnum = xnum*xm1 + p1[i]; + xden = xden*xm1 + q1[i]; + } + res = corr + (xm1 * (D1 + xm1*(xnum/xden))); + } + else + { + xm2 = (y - 0.5) - 0.5; + xden = 1; + xnum = 0; + for (i = 0; i < 8; i++) + { + xnum = xnum*xm2 + p2[i]; + xden = xden*xm2 + q2[i]; + } + res = corr + xm2 * (D2 + xm2*(xnum/xden)); + } + } + else if (y <= 4) + { + xm2 = y - 2; + xden = 1; + xnum = 0; + for (i = 0; i < 8; i++) + { + xnum = xnum*xm2 + p2[i]; + xden = xden*xm2 + q2[i]; + } + res = xm2 * (D2 + xm2*(xnum/xden)); + } + else if (y <= 12) + { + xm4 = y - 4; + xden = -1; + xnum = 0; + for (i = 0; i < 8; i++) + { + xnum = xnum*xm4 + p4[i]; + xden = xden*xm4 + q4[i]; + } + res = D4 + xm4*(xnum/xden); + } + else + { + res = 0; + if (y <= frtbig) + { + res = c[6]; + ysq = y * y; + for (i = 0; i < 6; i++) + res = res / ysq + c[i]; + } + res = res/y; + corr = log (y); + res = res + SQRTPI - 0.5*corr; + res = res + y*(corr-1); + } + } + else if (y < 0 && __builtin_floor (y) != y) + { + /* lgamma(y) = log(pi/(|y*sin(pi*y)|)) - lgamma(-y) + For abs(y) very close to zero, we use a series expansion to + the first order in y to avoid overflow. */ + if (y > -1.e-100) + res = -2 * log (fabs (y)) - lgamma (-y); + else + res = log (PI / fabs (y * sin (PI * y))) - lgamma (-y); + } + else + res = xinf; + + return res; +} +#endif + + +#if defined(HAVE_TGAMMA) && !defined(HAVE_TGAMMAF) +#define HAVE_TGAMMAF 1 +float tgammaf (float); + +float +tgammaf (float x) +{ + return (float) tgamma ((double) x); +} +#endif + +#if defined(HAVE_LGAMMA) && !defined(HAVE_LGAMMAF) +#define HAVE_LGAMMAF 1 +float lgammaf (float); + +float +lgammaf (float x) +{ + return (float) lgamma ((double) x); +} +#endif diff --git a/libgfortran/intrinsics/chdir.c b/libgfortran/intrinsics/chdir.c new file mode 100644 index 000000000..62f46931b --- /dev/null +++ b/libgfortran/intrinsics/chdir.c @@ -0,0 +1,111 @@ +/* Implementation of the CHDIR intrinsic. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +#ifdef HAVE_UNISTD_H +#include +#endif + +/* SUBROUTINE CHDIR(DIR, STATUS) + CHARACTER(len=*), INTENT(IN) :: DIR + INTEGER, INTENT(OUT), OPTIONAL :: STATUS */ + +#ifdef HAVE_CHDIR +extern void chdir_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type); +iexport_proto(chdir_i4_sub); + +void +chdir_i4_sub (char *dir, GFC_INTEGER_4 *status, gfc_charlen_type dir_len) +{ + int val; + char *str; + + /* Trim trailing spaces from paths. */ + while (dir_len > 0 && dir[dir_len - 1] == ' ') + dir_len--; + + /* Make a null terminated copy of the strings. */ + str = gfc_alloca (dir_len + 1); + memcpy (str, dir, dir_len); + str[dir_len] = '\0'; + + val = chdir (str); + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(chdir_i4_sub); + +extern void chdir_i8_sub (char *, GFC_INTEGER_8 *, gfc_charlen_type); +iexport_proto(chdir_i8_sub); + +void +chdir_i8_sub (char *dir, GFC_INTEGER_8 *status, gfc_charlen_type dir_len) +{ + int val; + char *str; + + /* Trim trailing spaces from paths. */ + while (dir_len > 0 && dir[dir_len - 1] == ' ') + dir_len--; + + /* Make a null terminated copy of the strings. */ + str = gfc_alloca (dir_len + 1); + memcpy (str, dir, dir_len); + str[dir_len] = '\0'; + + val = chdir (str); + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(chdir_i8_sub); + +extern GFC_INTEGER_4 chdir_i4 (char *, gfc_charlen_type); +export_proto(chdir_i4); + +GFC_INTEGER_4 +chdir_i4 (char *dir, gfc_charlen_type dir_len) +{ + GFC_INTEGER_4 val; + chdir_i4_sub (dir, &val, dir_len); + return val; +} + +extern GFC_INTEGER_8 chdir_i8 (char *, gfc_charlen_type); +export_proto(chdir_i8); + +GFC_INTEGER_8 +chdir_i8 (char *dir, gfc_charlen_type dir_len) +{ + GFC_INTEGER_8 val; + chdir_i8_sub (dir, &val, dir_len); + return val; +} +#endif diff --git a/libgfortran/intrinsics/chmod.c b/libgfortran/intrinsics/chmod.c new file mode 100644 index 000000000..cf768ff00 --- /dev/null +++ b/libgfortran/intrinsics/chmod.c @@ -0,0 +1,120 @@ +/* Implementation of the CHMOD intrinsic. + Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +#ifdef HAVE_UNISTD_H +#include +#endif +#ifdef HAVE_SYS_WAIT_H +#include +#endif + +/* INTEGER FUNCTION ACCESS(NAME, MODE) + CHARACTER(len=*), INTENT(IN) :: NAME, MODE */ + +#if defined(HAVE_FORK) && defined(HAVE_EXECL) && defined(HAVE_WAIT) + +extern int chmod_func (char *, char *, gfc_charlen_type, gfc_charlen_type); +export_proto(chmod_func); + +int +chmod_func (char *name, char *mode, gfc_charlen_type name_len, + gfc_charlen_type mode_len) +{ + char * file, * m; + pid_t pid; + int status; + + /* Trim trailing spaces. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + while (mode_len > 0 && mode[mode_len - 1] == ' ') + mode_len--; + + /* Make a null terminated copy of the strings. */ + file = gfc_alloca (name_len + 1); + memcpy (file, name, name_len); + file[name_len] = '\0'; + + m = gfc_alloca (mode_len + 1); + memcpy (m, mode, mode_len); + m[mode_len]= '\0'; + + /* Execute /bin/chmod. */ + if ((pid = fork()) < 0) + return errno; + if (pid == 0) + { + /* Child process. */ + execl ("/bin/chmod", "chmod", m, file, (char *) NULL); + return errno; + } + else + wait (&status); + + if (WIFEXITED(status)) + return WEXITSTATUS(status); + else + return -1; +} + + + +extern void chmod_i4_sub (char *, char *, GFC_INTEGER_4 *, + gfc_charlen_type, gfc_charlen_type); +export_proto(chmod_i4_sub); + +void +chmod_i4_sub (char *name, char *mode, GFC_INTEGER_4 * status, + gfc_charlen_type name_len, gfc_charlen_type mode_len) +{ + int val; + + val = chmod_func (name, mode, name_len, mode_len); + if (status) + *status = val; +} + + +extern void chmod_i8_sub (char *, char *, GFC_INTEGER_8 *, + gfc_charlen_type, gfc_charlen_type); +export_proto(chmod_i8_sub); + +void +chmod_i8_sub (char *name, char *mode, GFC_INTEGER_8 * status, + gfc_charlen_type name_len, gfc_charlen_type mode_len) +{ + int val; + + val = chmod_func (name, mode, name_len, mode_len); + if (status) + *status = val; +} + +#endif diff --git a/libgfortran/intrinsics/clock.c b/libgfortran/intrinsics/clock.c new file mode 100644 index 000000000..b1d61d886 --- /dev/null +++ b/libgfortran/intrinsics/clock.c @@ -0,0 +1,72 @@ +/* Implementation of the MCLOCK and MCLOCK8 g77 intrinsics. + Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#ifdef TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# ifdef HAVE_TIME_H +# include +# endif +# endif +#endif + + +/* INTEGER(KIND=4) FUNCTION MCLOCK() */ + +extern GFC_INTEGER_4 mclock (void); +export_proto(mclock); + +GFC_INTEGER_4 +mclock (void) +{ +#ifdef HAVE_CLOCK + return (GFC_INTEGER_4) clock (); +#else + return (GFC_INTEGER_4) -1; +#endif +} + + +/* INTEGER(KIND=8) FUNCTION MCLOCK8() */ + +extern GFC_INTEGER_8 mclock8 (void); +export_proto(mclock8); + +GFC_INTEGER_8 +mclock8 (void) +{ +#ifdef HAVE_CLOCK + return (GFC_INTEGER_8) clock (); +#else + return (GFC_INTEGER_8) -1; +#endif +} + diff --git a/libgfortran/intrinsics/cpu_time.c b/libgfortran/intrinsics/cpu_time.c new file mode 100644 index 000000000..619f8d252 --- /dev/null +++ b/libgfortran/intrinsics/cpu_time.c @@ -0,0 +1,111 @@ +/* Implementation of the CPU_TIME intrinsic. + Copyright (C) 2003, 2007, 2009, 2010, 2011 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include "time_1.h" + + +static inline void __cpu_time_1 (long *, long *) ATTRIBUTE_ALWAYS_INLINE; + +static inline void +__cpu_time_1 (long *sec, long *usec) +{ + long user_sec, user_usec, system_sec, system_usec; + if (gf_cputime (&user_sec, &user_usec, &system_sec, &system_usec) == 0) + { + *sec = user_sec + system_sec; + *usec = user_usec + system_usec; + } + else + { + *sec = -1; + *usec = 0; + } +} + + +extern void cpu_time_4 (GFC_REAL_4 *); +iexport_proto(cpu_time_4); + +void cpu_time_4 (GFC_REAL_4 *time) +{ + long sec, usec; + __cpu_time_1 (&sec, &usec); + *time = sec + usec * GFC_REAL_4_LITERAL(1.e-6); +} +iexport(cpu_time_4); + +extern void cpu_time_8 (GFC_REAL_8 *); +export_proto(cpu_time_8); + +void cpu_time_8 (GFC_REAL_8 *time) +{ + long sec, usec; + __cpu_time_1 (&sec, &usec); + *time = sec + usec * GFC_REAL_8_LITERAL(1.e-6); +} + +#ifdef HAVE_GFC_REAL_10 +extern void cpu_time_10 (GFC_REAL_10 *); +export_proto(cpu_time_10); + +void cpu_time_10 (GFC_REAL_10 *time) +{ + long sec, usec; + __cpu_time_1 (&sec, &usec); + *time = sec + usec * GFC_REAL_10_LITERAL(1.e-6); +} +#endif + +#ifdef HAVE_GFC_REAL_16 +extern void cpu_time_16 (GFC_REAL_16 *); +export_proto(cpu_time_16); + +void cpu_time_16 (GFC_REAL_16 *time) +{ + long sec, usec; + __cpu_time_1 (&sec, &usec); + *time = sec + usec * GFC_REAL_16_LITERAL(1.e-6); +} +#endif + +extern void second_sub (GFC_REAL_4 *); +export_proto(second_sub); + +void +second_sub (GFC_REAL_4 *s) +{ + cpu_time_4 (s); +} + +extern GFC_REAL_4 second (void); +export_proto(second); + +GFC_REAL_4 +second (void) +{ + GFC_REAL_4 s; + cpu_time_4 (&s); + return s; +} diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c new file mode 100644 index 000000000..651cd6e1e --- /dev/null +++ b/libgfortran/intrinsics/cshift0.c @@ -0,0 +1,454 @@ +/* Generic implementation of the CSHIFT intrinsic + Copyright 2003, 2005, 2006, 2007, 2010 Free Software Foundation, Inc. + Contributed by Feng Wang + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +static void +cshift0 (gfc_array_char * ret, const gfc_array_char * array, + ssize_t shift, int which, index_type size) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const char *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + index_type arraysize; + + index_type type_size; + + if (which < 1 || which > GFC_DESCRIPTOR_RANK (array)) + runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); + + arraysize = size0 ((array_t *) array); + + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * + GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } + + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "CSHIFT"); + } + + if (arraysize == 0) + return; + + type_size = GFC_DTYPE_TYPE_SIZE (array); + + switch(type_size) + { + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_INTEGER_1: + case GFC_DTYPE_DERIVED_1: + cshift0_i1 ((gfc_array_i1 *)ret, (gfc_array_i1 *) array, shift, which); + return; + + case GFC_DTYPE_LOGICAL_2: + case GFC_DTYPE_INTEGER_2: + cshift0_i2 ((gfc_array_i2 *)ret, (gfc_array_i2 *) array, shift, which); + return; + + case GFC_DTYPE_LOGICAL_4: + case GFC_DTYPE_INTEGER_4: + cshift0_i4 ((gfc_array_i4 *)ret, (gfc_array_i4 *) array, shift, which); + return; + + case GFC_DTYPE_LOGICAL_8: + case GFC_DTYPE_INTEGER_8: + cshift0_i8 ((gfc_array_i8 *)ret, (gfc_array_i8 *) array, shift, which); + return; + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_LOGICAL_16: + case GFC_DTYPE_INTEGER_16: + cshift0_i16 ((gfc_array_i16 *)ret, (gfc_array_i16 *) array, shift, + which); + return; +#endif + + case GFC_DTYPE_REAL_4: + cshift0_r4 ((gfc_array_r4 *)ret, (gfc_array_r4 *) array, shift, which); + return; + + case GFC_DTYPE_REAL_8: + cshift0_r8 ((gfc_array_r8 *)ret, (gfc_array_r8 *) array, shift, which); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef HAVE_GFC_REAL_10 + case GFC_DTYPE_REAL_10: + cshift0_r10 ((gfc_array_r10 *)ret, (gfc_array_r10 *) array, shift, + which); + return; +# endif + +# ifdef HAVE_GFC_REAL_16 + case GFC_DTYPE_REAL_16: + cshift0_r16 ((gfc_array_r16 *)ret, (gfc_array_r16 *) array, shift, + which); + return; +# endif +#endif + + case GFC_DTYPE_COMPLEX_4: + cshift0_c4 ((gfc_array_c4 *)ret, (gfc_array_c4 *) array, shift, which); + return; + + case GFC_DTYPE_COMPLEX_8: + cshift0_c8 ((gfc_array_c8 *)ret, (gfc_array_c8 *) array, shift, which); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef HAVE_GFC_COMPLEX_10 + case GFC_DTYPE_COMPLEX_10: + cshift0_c10 ((gfc_array_c10 *)ret, (gfc_array_c10 *) array, shift, + which); + return; +# endif + +# ifdef HAVE_GFC_COMPLEX_16 + case GFC_DTYPE_COMPLEX_16: + cshift0_c16 ((gfc_array_c16 *)ret, (gfc_array_c16 *) array, shift, + which); + return; +# endif +#endif + + default: + break; + } + + switch (size) + { + /* Let's check the actual alignment of the data pointers. If they + are suitably aligned, we can safely call the unpack functions. */ + + case sizeof (GFC_INTEGER_1): + cshift0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) array, shift, + which); + break; + + case sizeof (GFC_INTEGER_2): + if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(array->data)) + break; + else + { + cshift0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array, shift, + which); + return; + } + + case sizeof (GFC_INTEGER_4): + if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(array->data)) + break; + else + { + cshift0_i4 ((gfc_array_i4 *)ret, (gfc_array_i4 *) array, shift, + which); + return; + } + + case sizeof (GFC_INTEGER_8): + if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(array->data)) + { + /* Let's try to use the complex routines. First, a sanity + check that the sizes match; this should be optimized to + a no-op. */ + if (sizeof(GFC_INTEGER_8) != sizeof(GFC_COMPLEX_4)) + break; + + if (GFC_UNALIGNED_C4(ret->data) || GFC_UNALIGNED_C4(array->data)) + break; + + cshift0_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) array, shift, + which); + return; + } + else + { + cshift0_i8 ((gfc_array_i8 *)ret, (gfc_array_i8 *) array, shift, + which); + return; + } + +#ifdef HAVE_GFC_INTEGER_16 + case sizeof (GFC_INTEGER_16): + if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(array->data)) + { + /* Let's try to use the complex routines. First, a sanity + check that the sizes match; this should be optimized to + a no-op. */ + if (sizeof(GFC_INTEGER_16) != sizeof(GFC_COMPLEX_8)) + break; + + if (GFC_UNALIGNED_C8(ret->data) || GFC_UNALIGNED_C8(array->data)) + break; + + cshift0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array, shift, + which); + return; + } + else + { + cshift0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array, + shift, which); + return; + } +#else + case sizeof (GFC_COMPLEX_8): + + if (GFC_UNALIGNED_C8(ret->data) || GFC_UNALIGNED_C8(array->data)) + break; + else + { + cshift0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array, shift, + which); + return; + } +#endif + + default: + break; + } + + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = size; + soffset = size; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == size && roffset == size) + { + size_t len1 = shift * size; + size_t len2 = (len - shift) * size; + memcpy (rptr, sptr + len1, len2); + memcpy (rptr + len2, sptr, len1); + } + else + { + /* Otherwise, we'll have to perform the copy one element at + a time. */ + char *dest = rptr; + const char *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } +} + +#define DEFINE_CSHIFT(N) \ + extern void cshift0_##N (gfc_array_char *, const gfc_array_char *, \ + const GFC_INTEGER_##N *, const GFC_INTEGER_##N *); \ + export_proto(cshift0_##N); \ + \ + void \ + cshift0_##N (gfc_array_char *ret, const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, const GFC_INTEGER_##N *pdim) \ + { \ + cshift0 (ret, array, *pshift, pdim ? *pdim : 1, \ + GFC_DESCRIPTOR_SIZE (array)); \ + } \ + \ + extern void cshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + const GFC_INTEGER_##N *, GFC_INTEGER_4); \ + export_proto(cshift0_##N##_char); \ + \ + void \ + cshift0_##N##_char (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length) \ + { \ + cshift0 (ret, array, *pshift, pdim ? *pdim : 1, array_length); \ + } \ + \ + extern void cshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + const GFC_INTEGER_##N *, GFC_INTEGER_4); \ + export_proto(cshift0_##N##_char4); \ + \ + void \ + cshift0_##N##_char4 (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length) \ + { \ + cshift0 (ret, array, *pshift, pdim ? *pdim : 1, \ + array_length * sizeof (gfc_char4_t)); \ + } + +DEFINE_CSHIFT (1); +DEFINE_CSHIFT (2); +DEFINE_CSHIFT (4); +DEFINE_CSHIFT (8); +#ifdef HAVE_GFC_INTEGER_16 +DEFINE_CSHIFT (16); +#endif diff --git a/libgfortran/intrinsics/ctime.c b/libgfortran/intrinsics/ctime.c new file mode 100644 index 000000000..92c043135 --- /dev/null +++ b/libgfortran/intrinsics/ctime.c @@ -0,0 +1,129 @@ +/* Implementation of the CTIME and FDATE g77 intrinsics. + Copyright (C) 2005, 2007, 2009, 2011 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include "time_1.h" + +#include + + +/* strftime-like function that fills a C string with %c format which + is identical to ctime in the default locale. As ctime and ctime_r + are poorly specified and their usage not recommended, the + implementation instead uses strftime. */ + +static size_t +strctime (char *s, size_t max, const time_t *timep) +{ +#ifdef HAVE_STRFTIME + struct tm ltm; + int failed; + /* Some targets provide a localtime_r based on a draft of the POSIX + standard where the return type is int rather than the + standardized struct tm*. */ + __builtin_choose_expr (__builtin_classify_type (localtime_r (timep, <m)) + == 5, + failed = localtime_r (timep, <m) == NULL, + failed = localtime_r (timep, <m) != 0); + if (failed) + return 0; + return strftime (s, max, "%c", <m); +#else + return 0; +#endif +} + +/* In the default locale, the date and time representation fits in 26 + bytes. However, other locales might need more space. */ +#define CSZ 100 + +extern void fdate (char **, gfc_charlen_type *); +export_proto(fdate); + +void +fdate (char ** date, gfc_charlen_type * date_len) +{ +#if defined(HAVE_TIME) + time_t now = time(NULL); + *date = get_mem (CSZ); + *date_len = strctime (*date, CSZ, &now); +#else + + *date = NULL; + *date_len = 0; +#endif +} + + +extern void fdate_sub (char *, gfc_charlen_type); +export_proto(fdate_sub); + +void +fdate_sub (char * date, gfc_charlen_type date_len) +{ +#if defined(HAVE_TIME) + time_t now = time(NULL); + char *s = get_mem (date_len + 1); + size_t n = strctime (s, date_len + 1, &now); + fstrcpy (date, date_len, s, n); + free (s); +#else + memset (date, ' ', date_len); +#endif +} + + + +extern void PREFIX(ctime) (char **, gfc_charlen_type *, GFC_INTEGER_8); +export_proto_np(PREFIX(ctime)); + +void +PREFIX(ctime) (char ** date, gfc_charlen_type * date_len, GFC_INTEGER_8 t) +{ +#if defined(HAVE_TIME) + time_t now = t; + *date = get_mem (CSZ); + *date_len = strctime (*date, CSZ, &now); +#else + + *date = NULL; + *date_len = 0; +#endif +} + + +extern void ctime_sub (GFC_INTEGER_8 *, char *, gfc_charlen_type); +export_proto(ctime_sub); + +void +ctime_sub (GFC_INTEGER_8 * t, char * date, gfc_charlen_type date_len) +{ + time_t now = *t; + char *s = get_mem (date_len + 1); + size_t n = strctime (s, date_len + 1, &now); + fstrcpy (date, date_len, s, n); + free (s); +} diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c new file mode 100644 index 000000000..793df687f --- /dev/null +++ b/libgfortran/intrinsics/date_and_time.c @@ -0,0 +1,672 @@ +/* Implementation of the DATE_AND_TIME intrinsic. + Copyright (C) 2003, 2004, 2005, 2006, 2007, 2009, 2010, 2011 + Free Software Foundation, Inc. + Contributed by Steven Bosscher. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +#include "time_1.h" + +#ifndef abs +#define abs(x) ((x)>=0 ? (x) : -(x)) +#endif + + +/* If the re-entrant version of gmtime is not available, provide a + fallback implementation. On some targets where the _r version is + not available, gmtime uses thread-local storage so it's + threadsafe. */ + +#ifndef HAVE_GMTIME_R +/* If _POSIX is defined gmtime_r gets defined by mingw-w64 headers. */ +#ifdef gmtime_r +#undef gmtime_r +#endif + +static struct tm * +gmtime_r (const time_t * timep, struct tm * result) +{ + *result = *gmtime (timep); + return result; +} +#endif + + +/* DATE_AND_TIME ([DATE, TIME, ZONE, VALUES]) + + Description: Returns data on the real-time clock and date in a form + compatible with the representations defined in ISO 8601:1988. + + Class: Non-elemental subroutine. + + Arguments: + + DATE (optional) shall be scalar and of type default character. + It is an INTENT(OUT) argument. It is assigned a value of the + form CCYYMMDD, where CC is the century, YY the year within the + century, MM the month within the year, and DD the day within the + month. If there is no date available, they are assigned blanks. + + TIME (optional) shall be scalar and of type default character. + It is an INTENT(OUT) argument. It is assigned a value of the + form hhmmss.sss, where hh is the hour of the day, mm is the + minutes of the hour, and ss.sss is the seconds and milliseconds + of the minute. If there is no clock available, they are assigned + blanks. + + ZONE (optional) shall be scalar and of type default character. + It is an INTENT(OUT) argument. It is assigned a value of the + form [+-]hhmm, where hh and mm are the time difference with + respect to Coordinated Universal Time (UTC) in hours and parts + of an hour expressed in minutes, respectively. If there is no + clock available, they are assigned blanks. + + VALUES (optional) shall be of type default integer and of rank + one. It is an INTENT(OUT) argument. Its size shall be at least + 8. The values returned in VALUES are as follows: + + VALUES(1) the year (for example, 2003), or -HUGE(0) if there is + no date available; + + VALUES(2) the month of the year, or -HUGE(0) if there + is no date available; + + VALUES(3) the day of the month, or -HUGE(0) if there is no date + available; + + VALUES(4) the time difference with respect to Coordinated + Universal Time (UTC) in minutes, or -HUGE(0) if this information + is not available; + + VALUES(5) the hour of the day, in the range of 0 to 23, or + -HUGE(0) if there is no clock; + + VALUES(6) the minutes of the hour, in the range 0 to 59, or + -HUGE(0) if there is no clock; + + VALUES(7) the seconds of the minute, in the range 0 to 60, or + -HUGE(0) if there is no clock; + + VALUES(8) the milliseconds of the second, in the range 0 to + 999, or -HUGE(0) if there is no clock. + + NULL pointer represent missing OPTIONAL arguments. All arguments + have INTENT(OUT). Because of the -i8 option, we must implement + VALUES for INTEGER(kind=4) and INTEGER(kind=8). + + Based on libU77's date_time_.c. + + TODO : + - Check year boundaries. +*/ +#define DATE_LEN 8 +#define TIME_LEN 10 +#define ZONE_LEN 5 +#define VALUES_SIZE 8 + +extern void date_and_time (char *, char *, char *, gfc_array_i4 *, + GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(date_and_time); + +void +date_and_time (char *__date, char *__time, char *__zone, + gfc_array_i4 *__values, GFC_INTEGER_4 __date_len, + GFC_INTEGER_4 __time_len, GFC_INTEGER_4 __zone_len) +{ + int i; + char date[DATE_LEN + 1]; + char timec[TIME_LEN + 1]; + char zone[ZONE_LEN + 1]; + GFC_INTEGER_4 values[VALUES_SIZE]; + +#ifndef HAVE_NO_DATE_TIME + time_t lt; + struct tm local_time; + struct tm UTC_time; + + long usecs; + + if (!gf_gettime (<, &usecs)) + { + values[7] = usecs / 1000; + + localtime_r (<, &local_time); + gmtime_r (<, &UTC_time); + + /* All arguments can be derived from VALUES. */ + values[0] = 1900 + local_time.tm_year; + values[1] = 1 + local_time.tm_mon; + values[2] = local_time.tm_mday; + values[3] = (local_time.tm_min - UTC_time.tm_min + + 60 * (local_time.tm_hour - UTC_time.tm_hour + + 24 * (local_time.tm_yday - UTC_time.tm_yday))); + values[4] = local_time.tm_hour; + values[5] = local_time.tm_min; + values[6] = local_time.tm_sec; + +#if HAVE_SNPRINTF + if (__date) + snprintf (date, DATE_LEN + 1, "%04d%02d%02d", + values[0], values[1], values[2]); + if (__time) + snprintf (timec, TIME_LEN + 1, "%02d%02d%02d.%03d", + values[4], values[5], values[6], values[7]); + + if (__zone) + snprintf (zone, ZONE_LEN + 1, "%+03d%02d", + values[3] / 60, abs (values[3] % 60)); +#else + if (__date) + sprintf (date, "%04d%02d%02d", values[0], values[1], values[2]); + + if (__time) + sprintf (timec, "%02d%02d%02d.%03d", + values[4], values[5], values[6], values[7]); + + if (__zone) + sprintf (zone, "%+03d%02d", + values[3] / 60, abs (values[3] % 60)); +#endif + } + else + { + memset (date, ' ', DATE_LEN); + date[DATE_LEN] = '\0'; + + memset (timec, ' ', TIME_LEN); + timec[TIME_LEN] = '\0'; + + memset (zone, ' ', ZONE_LEN); + zone[ZONE_LEN] = '\0'; + + for (i = 0; i < VALUES_SIZE; i++) + values[i] = - GFC_INTEGER_4_HUGE; + } +#else /* if defined HAVE_NO_DATE_TIME */ + /* We really have *nothing* to return, so return blanks and HUGE(0). */ + + memset (date, ' ', DATE_LEN); + date[DATE_LEN] = '\0'; + + memset (timec, ' ', TIME_LEN); + timec[TIME_LEN] = '\0'; + + memset (zone, ' ', ZONE_LEN); + zone[ZONE_LEN] = '\0'; + + for (i = 0; i < VALUES_SIZE; i++) + values[i] = - GFC_INTEGER_4_HUGE; +#endif /* HAVE_NO_DATE_TIME */ + + /* Copy the values into the arguments. */ + if (__values) + { + index_type len, delta, elt_size; + + elt_size = GFC_DESCRIPTOR_SIZE (__values); + len = GFC_DESCRIPTOR_EXTENT(__values,0); + delta = GFC_DESCRIPTOR_STRIDE(__values,0); + if (delta == 0) + delta = 1; + + if (unlikely (len < VALUES_SIZE)) + runtime_error ("Incorrect extent in VALUE argument to" + " DATE_AND_TIME intrinsic: is %ld, should" + " be >=%ld", (long int) len, (long int) VALUES_SIZE); + + /* Cope with different type kinds. */ + if (elt_size == 4) + { + GFC_INTEGER_4 *vptr4 = __values->data; + + for (i = 0; i < VALUES_SIZE; i++, vptr4 += delta) + *vptr4 = values[i]; + } + else if (elt_size == 8) + { + GFC_INTEGER_8 *vptr8 = (GFC_INTEGER_8 *)__values->data; + + for (i = 0; i < VALUES_SIZE; i++, vptr8 += delta) + { + if (values[i] == - GFC_INTEGER_4_HUGE) + *vptr8 = - GFC_INTEGER_8_HUGE; + else + *vptr8 = values[i]; + } + } + else + abort (); + } + + if (__zone) + fstrcpy (__zone, __zone_len, zone, ZONE_LEN); + + if (__time) + fstrcpy (__time, __time_len, timec, TIME_LEN); + + if (__date) + fstrcpy (__date, __date_len, date, DATE_LEN); +} + + +/* SECNDS (X) - Non-standard + + Description: Returns the system time of day, or elapsed time, as a GFC_REAL_4 + in seconds. + + Class: Non-elemental subroutine. + + Arguments: + + X must be REAL(4) and the result is of the same type. The accuracy is system + dependent. + + Usage: + + T = SECNDS (X) + + yields the time in elapsed seconds since X. If X is 0.0, T is the time in + seconds since midnight. Note that a time that spans midnight but is less than + 24hours will be calculated correctly. */ + +extern GFC_REAL_4 secnds (GFC_REAL_4 *); +export_proto(secnds); + +GFC_REAL_4 +secnds (GFC_REAL_4 *x) +{ + GFC_INTEGER_4 values[VALUES_SIZE]; + GFC_REAL_4 temp1, temp2; + + /* Make the INTEGER*4 array for passing to date_and_time. */ + gfc_array_i4 *avalues = internal_malloc_size (sizeof (gfc_array_i4)); + avalues->data = &values[0]; + GFC_DESCRIPTOR_DTYPE (avalues) = ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) + & GFC_DTYPE_TYPE_MASK) + + (4 << GFC_DTYPE_SIZE_SHIFT); + + GFC_DIMENSION_SET(avalues->dim[0], 0, 7, 1); + + date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0); + + free (avalues); + + temp1 = 3600.0 * (GFC_REAL_4)values[4] + + 60.0 * (GFC_REAL_4)values[5] + + (GFC_REAL_4)values[6] + + 0.001 * (GFC_REAL_4)values[7]; + temp2 = fmod (*x, 86400.0); + temp2 = (temp1 - temp2 >= 0.0) ? temp2 : (temp2 - 86400.0); + return temp1 - temp2; +} + + + +/* ITIME(X) - Non-standard + + Description: Returns the current local time hour, minutes, and seconds + in elements 1, 2, and 3 of X, respectively. */ + +static void +itime0 (int x[3]) +{ +#ifndef HAVE_NO_DATE_TIME + time_t lt; + struct tm local_time; + + lt = time (NULL); + + if (lt != (time_t) -1) + { + localtime_r (<, &local_time); + + x[0] = local_time.tm_hour; + x[1] = local_time.tm_min; + x[2] = local_time.tm_sec; + } +#else + x[0] = x[1] = x[2] = -1; +#endif +} + +extern void itime_i4 (gfc_array_i4 *); +export_proto(itime_i4); + +void +itime_i4 (gfc_array_i4 *__values) +{ + int x[3], i; + index_type len, delta; + GFC_INTEGER_4 *vptr; + + /* Call helper function. */ + itime0(x); + + /* Copy the value into the array. */ + len = GFC_DESCRIPTOR_EXTENT(__values,0); + assert (len >= 3); + delta = GFC_DESCRIPTOR_STRIDE(__values,0); + if (delta == 0) + delta = 1; + + vptr = __values->data; + for (i = 0; i < 3; i++, vptr += delta) + *vptr = x[i]; +} + + +extern void itime_i8 (gfc_array_i8 *); +export_proto(itime_i8); + +void +itime_i8 (gfc_array_i8 *__values) +{ + int x[3], i; + index_type len, delta; + GFC_INTEGER_8 *vptr; + + /* Call helper function. */ + itime0(x); + + /* Copy the value into the array. */ + len = GFC_DESCRIPTOR_EXTENT(__values,0); + assert (len >= 3); + delta = GFC_DESCRIPTOR_STRIDE(__values,0); + if (delta == 0) + delta = 1; + + vptr = __values->data; + for (i = 0; i < 3; i++, vptr += delta) + *vptr = x[i]; +} + + + +/* IDATE(X) - Non-standard + + Description: Fills TArray with the numerical values at the current + local time. The day (in the range 1-31), month (in the range 1-12), + and year appear in elements 1, 2, and 3 of X, respectively. + The year has four significant digits. */ + +static void +idate0 (int x[3]) +{ +#ifndef HAVE_NO_DATE_TIME + time_t lt; + struct tm local_time; + + lt = time (NULL); + + if (lt != (time_t) -1) + { + localtime_r (<, &local_time); + + x[0] = local_time.tm_mday; + x[1] = 1 + local_time.tm_mon; + x[2] = 1900 + local_time.tm_year; + } +#else + x[0] = x[1] = x[2] = -1; +#endif +} + +extern void idate_i4 (gfc_array_i4 *); +export_proto(idate_i4); + +void +idate_i4 (gfc_array_i4 *__values) +{ + int x[3], i; + index_type len, delta; + GFC_INTEGER_4 *vptr; + + /* Call helper function. */ + idate0(x); + + /* Copy the value into the array. */ + len = GFC_DESCRIPTOR_EXTENT(__values,0); + assert (len >= 3); + delta = GFC_DESCRIPTOR_STRIDE(__values,0); + if (delta == 0) + delta = 1; + + vptr = __values->data; + for (i = 0; i < 3; i++, vptr += delta) + *vptr = x[i]; +} + + +extern void idate_i8 (gfc_array_i8 *); +export_proto(idate_i8); + +void +idate_i8 (gfc_array_i8 *__values) +{ + int x[3], i; + index_type len, delta; + GFC_INTEGER_8 *vptr; + + /* Call helper function. */ + idate0(x); + + /* Copy the value into the array. */ + len = GFC_DESCRIPTOR_EXTENT(__values,0); + assert (len >= 3); + delta = GFC_DESCRIPTOR_STRIDE(__values,0); + if (delta == 0) + delta = 1; + + vptr = __values->data; + for (i = 0; i < 3; i++, vptr += delta) + *vptr = x[i]; +} + + + +/* GMTIME(STIME, TARRAY) - Non-standard + + Description: Given a system time value STime, fills TArray with values + extracted from it appropriate to the GMT time zone using gmtime_r(3). + + The array elements are as follows: + + 1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds + 2. Minutes after the hour, range 0-59 + 3. Hours past midnight, range 0-23 + 4. Day of month, range 0-31 + 5. Number of months since January, range 0-11 + 6. Years since 1900 + 7. Number of days since Sunday, range 0-6 + 8. Days since January 1 + 9. Daylight savings indicator: positive if daylight savings is in effect, + zero if not, and negative if the information isn't available. */ + +static void +gmtime_0 (const time_t * t, int x[9]) +{ + struct tm lt; + + gmtime_r (t, <); + x[0] = lt.tm_sec; + x[1] = lt.tm_min; + x[2] = lt.tm_hour; + x[3] = lt.tm_mday; + x[4] = lt.tm_mon; + x[5] = lt.tm_year; + x[6] = lt.tm_wday; + x[7] = lt.tm_yday; + x[8] = lt.tm_isdst; +} + +extern void gmtime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *); +export_proto(gmtime_i4); + +void +gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) +{ + int x[9], i; + index_type len, delta; + GFC_INTEGER_4 *vptr; + time_t tt; + + /* Call helper function. */ + tt = (time_t) *t; + gmtime_0(&tt, x); + + /* Copy the values into the array. */ + len = GFC_DESCRIPTOR_EXTENT(tarray,0); + assert (len >= 9); + delta = GFC_DESCRIPTOR_STRIDE(tarray,0); + if (delta == 0) + delta = 1; + + vptr = tarray->data; + for (i = 0; i < 9; i++, vptr += delta) + *vptr = x[i]; +} + +extern void gmtime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *); +export_proto(gmtime_i8); + +void +gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) +{ + int x[9], i; + index_type len, delta; + GFC_INTEGER_8 *vptr; + time_t tt; + + /* Call helper function. */ + tt = (time_t) *t; + gmtime_0(&tt, x); + + /* Copy the values into the array. */ + len = GFC_DESCRIPTOR_EXTENT(tarray,0); + assert (len >= 9); + delta = GFC_DESCRIPTOR_STRIDE(tarray,0); + if (delta == 0) + delta = 1; + + vptr = tarray->data; + for (i = 0; i < 9; i++, vptr += delta) + *vptr = x[i]; +} + + + + +/* LTIME(STIME, TARRAY) - Non-standard + + Description: Given a system time value STime, fills TArray with values + extracted from it appropriate to the local time zone using localtime_r(3). + + The array elements are as follows: + + 1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds + 2. Minutes after the hour, range 0-59 + 3. Hours past midnight, range 0-23 + 4. Day of month, range 0-31 + 5. Number of months since January, range 0-11 + 6. Years since 1900 + 7. Number of days since Sunday, range 0-6 + 8. Days since January 1 + 9. Daylight savings indicator: positive if daylight savings is in effect, + zero if not, and negative if the information isn't available. */ + +static void +ltime_0 (const time_t * t, int x[9]) +{ + struct tm lt; + + localtime_r (t, <); + x[0] = lt.tm_sec; + x[1] = lt.tm_min; + x[2] = lt.tm_hour; + x[3] = lt.tm_mday; + x[4] = lt.tm_mon; + x[5] = lt.tm_year; + x[6] = lt.tm_wday; + x[7] = lt.tm_yday; + x[8] = lt.tm_isdst; +} + +extern void ltime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *); +export_proto(ltime_i4); + +void +ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) +{ + int x[9], i; + index_type len, delta; + GFC_INTEGER_4 *vptr; + time_t tt; + + /* Call helper function. */ + tt = (time_t) *t; + ltime_0(&tt, x); + + /* Copy the values into the array. */ + len = GFC_DESCRIPTOR_EXTENT(tarray,0); + assert (len >= 9); + delta = GFC_DESCRIPTOR_STRIDE(tarray,0); + if (delta == 0) + delta = 1; + + vptr = tarray->data; + for (i = 0; i < 9; i++, vptr += delta) + *vptr = x[i]; +} + +extern void ltime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *); +export_proto(ltime_i8); + +void +ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) +{ + int x[9], i; + index_type len, delta; + GFC_INTEGER_8 *vptr; + time_t tt; + + /* Call helper function. */ + tt = (time_t) * t; + ltime_0(&tt, x); + + /* Copy the values into the array. */ + len = GFC_DESCRIPTOR_EXTENT(tarray,0); + assert (len >= 9); + delta = GFC_DESCRIPTOR_STRIDE(tarray,0); + if (delta == 0) + delta = 1; + + vptr = tarray->data; + for (i = 0; i < 9; i++, vptr += delta) + *vptr = x[i]; +} + + diff --git a/libgfortran/intrinsics/dprod_r8.f90 b/libgfortran/intrinsics/dprod_r8.f90 new file mode 100644 index 000000000..7eb0ede01 --- /dev/null +++ b/libgfortran/intrinsics/dprod_r8.f90 @@ -0,0 +1,32 @@ +! Copyright 2003, 2009 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 3 of the License, or (at your option) any later version. +! +!Libgfortran is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU General Public License for more details. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. + + +elemental function _gfortran_specific__dprod_r8 (p1, p2) + implicit none + real (kind=4), intent (in) :: p1, p2 + real (kind=8) :: _gfortran_specific__dprod_r8 + + _gfortran_specific__dprod_r8 = dprod (p1, p2) +end function diff --git a/libgfortran/intrinsics/dtime.c b/libgfortran/intrinsics/dtime.c new file mode 100644 index 000000000..e36e1f1d0 --- /dev/null +++ b/libgfortran/intrinsics/dtime.c @@ -0,0 +1,87 @@ +/* Implementation of the dtime intrinsic. + Copyright (C) 2004, 2005, 2006, 2007, 2009, 2011 Free Software + Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include "time_1.h" +#include + +#ifdef __GTHREAD_MUTEX_INIT +static __gthread_mutex_t dtime_update_lock = __GTHREAD_MUTEX_INIT; +#else +static __gthread_mutex_t dtime_update_lock; +#endif + +extern void dtime_sub (gfc_array_r4 *t, GFC_REAL_4 *result); +iexport_proto(dtime_sub); + +void +dtime_sub (gfc_array_r4 *t, GFC_REAL_4 *result) +{ + GFC_REAL_4 *tp; + long user_sec, user_usec, system_sec, system_usec; + static long us = 0, uu = 0, ss = 0 , su = 0; + GFC_REAL_4 tu, ts, tt; + + if (((GFC_DESCRIPTOR_EXTENT(t,0))) < 2) + runtime_error ("Insufficient number of elements in TARRAY."); + + __gthread_mutex_lock (&dtime_update_lock); + if (gf_cputime (&user_sec, &user_usec, &system_sec, &system_usec) == 0) + { + tu = (GFC_REAL_4) ((user_sec - us) + 1.e-6 * (user_usec - uu)); + ts = (GFC_REAL_4) ((system_sec - ss) + 1.e-6 * (system_usec - su)); + tt = tu + ts; + us = user_sec; + uu = user_usec; + ss = system_sec; + su = system_usec; + } + else + { + tu = -1; + ts = -1; + tt = -1; + } + + tp = t->data; + + *tp = tu; + tp += GFC_DESCRIPTOR_STRIDE(t,0); + *tp = ts; + *result = tt; + __gthread_mutex_unlock (&dtime_update_lock); +} +iexport(dtime_sub); + +extern GFC_REAL_4 dtime (gfc_array_r4 *t); +export_proto(dtime); + +GFC_REAL_4 +dtime (gfc_array_r4 *t) +{ + GFC_REAL_4 val; + dtime_sub (t, &val); + return val; +} diff --git a/libgfortran/intrinsics/env.c b/libgfortran/intrinsics/env.c new file mode 100644 index 000000000..883603848 --- /dev/null +++ b/libgfortran/intrinsics/env.c @@ -0,0 +1,195 @@ +/* Implementation of the GETENV g77, and + GET_ENVIRONMENT_VARIABLE F2003, intrinsics. + Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. + Contributed by Janne Blomqvist. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + + +/* GETENV (NAME, VALUE), g77 intrinsic for retrieving the value of + an environment variable. The name of the variable is specified in + NAME, and the result is stored into VALUE. */ + +void PREFIX(getenv) (char *, char *, gfc_charlen_type, gfc_charlen_type); +export_proto_np(PREFIX(getenv)); + +void +PREFIX(getenv) (char * name, char * value, gfc_charlen_type name_len, + gfc_charlen_type value_len) +{ + char *name_nt; + char *res = NULL; + int res_len; + + if (name == NULL || value == NULL) + runtime_error ("Both arguments to getenv are mandatory."); + + if (value_len < 1 || name_len < 1) + runtime_error ("Zero length string(s) passed to getenv."); + else + memset (value, ' ', value_len); /* Blank the string. */ + + /* Trim trailing spaces from name. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + + /* Make a null terminated copy of the string. */ + name_nt = gfc_alloca (name_len + 1); + memcpy (name_nt, name, name_len); + name_nt[name_len] = '\0'; + + res = getenv(name_nt); + + /* If res is NULL, it means that the environment variable didn't + exist, so just return. */ + if (res == NULL) + return; + + res_len = strlen(res); + if (value_len < res_len) + memcpy (value, res, value_len); + else + memcpy (value, res, res_len); +} + + +/* GET_ENVIRONMENT_VARIABLE (name, [value, length, status, trim_name]) + is a F2003 intrinsic for getting an environment variable. */ + +/* Status codes specifyed by the standard. */ +#define GFC_SUCCESS 0 +#define GFC_VALUE_TOO_SHORT -1 +#define GFC_NAME_DOES_NOT_EXIST 1 + +/* This is also specified by the standard and means that the + processor doesn't support environment variables. At the moment, + gfortran doesn't use it. */ +#define GFC_NOT_SUPPORTED 2 + +/* Processor-specific failure code. */ +#define GFC_FAILURE 42 + +extern void get_environment_variable_i4 (char *, char *, GFC_INTEGER_4 *, + GFC_INTEGER_4 *, GFC_LOGICAL_4 *, + gfc_charlen_type, gfc_charlen_type); +iexport_proto(get_environment_variable_i4); + +void +get_environment_variable_i4 (char *name, char *value, GFC_INTEGER_4 *length, + GFC_INTEGER_4 *status, GFC_LOGICAL_4 *trim_name, + gfc_charlen_type name_len, + gfc_charlen_type value_len) +{ + int stat = GFC_SUCCESS, res_len = 0; + char *name_nt; + char *res; + + if (name == NULL) + runtime_error ("Name is required for get_environment_variable."); + + if (value == NULL && length == NULL && status == NULL && trim_name == NULL) + return; + + if (name_len < 1) + runtime_error ("Zero-length string passed as name to " + "get_environment_variable."); + + if (value != NULL) + { + if (value_len < 1) + runtime_error ("Zero-length string passed as value to " + "get_environment_variable."); + else + memset (value, ' ', value_len); /* Blank the string. */ + } + + if ((!trim_name) || *trim_name) + { + /* Trim trailing spaces from name. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + } + /* Make a null terminated copy of the name. */ + name_nt = gfc_alloca (name_len + 1); + memcpy (name_nt, name, name_len); + name_nt[name_len] = '\0'; + + res = getenv(name_nt); + + if (res == NULL) + stat = GFC_NAME_DOES_NOT_EXIST; + else + { + res_len = strlen(res); + if (value != NULL) + { + if (value_len < res_len) + { + memcpy (value, res, value_len); + stat = GFC_VALUE_TOO_SHORT; + } + else + memcpy (value, res, res_len); + } + } + + if (status != NULL) + *status = stat; + + if (length != NULL) + *length = res_len; +} +iexport(get_environment_variable_i4); + + +/* INTEGER*8 wrapper for get_environment_variable. */ + +extern void get_environment_variable_i8 (char *, char *, GFC_INTEGER_8 *, + GFC_INTEGER_8 *, GFC_LOGICAL_8 *, + gfc_charlen_type, gfc_charlen_type); +export_proto(get_environment_variable_i8); + +void +get_environment_variable_i8 (char *name, char *value, GFC_INTEGER_8 *length, + GFC_INTEGER_8 *status, GFC_LOGICAL_8 *trim_name, + gfc_charlen_type name_len, + gfc_charlen_type value_len) +{ + GFC_INTEGER_4 length4, status4; + GFC_LOGICAL_4 trim_name4; + + if (trim_name) + trim_name4 = *trim_name; + + get_environment_variable_i4 (name, value, &length4, &status4, + &trim_name4, name_len, value_len); + + if (length) + *length = length4; + + if (status) + *status = status4; +} diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c new file mode 100644 index 000000000..74ba5ab7a --- /dev/null +++ b/libgfortran/intrinsics/eoshift0.c @@ -0,0 +1,302 @@ +/* Generic implementation of the EOSHIFT intrinsic + Copyright 2002, 2005, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +/* TODO: make this work for large shifts when + sizeof(int) < sizeof (index_type). */ + +static void +eoshift0 (gfc_array_char * ret, const gfc_array_char * array, + int shift, const char * pbound, int which, index_type size, + const char *filler, index_type filler_len) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char * restrict 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; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + index_type arraysize; + + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + + arraysize = size0 ((array_t *) array); + + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + + } + + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (arraysize == 0) + return; + + which = which - 1; + + extent[0] = 1; + count[0] = 0; + sstride[0] = -1; + rstride[0] = -1; + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + if ((shift >= 0 ? shift : -shift) > len) + { + shift = len; + len = 0; + } + else + { + if (shift > 0) + len = len - shift; + else + len = len + shift; + } + + while (rptr) + { + /* Do the shift for this dimension. */ + if (shift > 0) + { + src = &sptr[shift * soffset]; + dest = rptr; + } + else + { + src = sptr; + dest = &rptr[-shift * roffset]; + } + for (n = 0; n < len; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + if (shift >= 0) + { + n = shift; + } + else + { + dest = rptr; + n = -shift; + } + + if (pbound) + while (n--) + { + memcpy (dest, pbound, size); + dest += roffset; + } + else + while (n--) + { + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size ; i += filler_len) + memcpy (&dest[i], filler, filler_len); + + dest += roffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } +} + + +#define DEFINE_EOSHIFT(N) \ + extern void eoshift0_##N (gfc_array_char *, const gfc_array_char *, \ + const GFC_INTEGER_##N *, const char *, \ + const GFC_INTEGER_##N *); \ + export_proto(eoshift0_##N); \ + \ + void \ + eoshift0_##N (gfc_array_char *ret, const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, const char *pbound, \ + const GFC_INTEGER_##N *pdim) \ + { \ + eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ + GFC_DESCRIPTOR_SIZE (array), "\0", 1); \ + } \ + \ + extern void eoshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, const char *, \ + const GFC_INTEGER_##N *, GFC_INTEGER_4, \ + GFC_INTEGER_4); \ + export_proto(eoshift0_##N##_char); \ + \ + void \ + eoshift0_##N##_char (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const char *pbound, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length, \ + GFC_INTEGER_4 bound_length __attribute__((unused))) \ + { \ + eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ + array_length, " ", 1); \ + } \ + \ + extern void eoshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, const char *, \ + const GFC_INTEGER_##N *, GFC_INTEGER_4, \ + GFC_INTEGER_4); \ + export_proto(eoshift0_##N##_char4); \ + \ + void \ + eoshift0_##N##_char4 (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const char *pbound, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length, \ + GFC_INTEGER_4 bound_length __attribute__((unused))) \ + { \ + static const gfc_char4_t space = (unsigned char) ' '; \ + eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ + array_length * sizeof (gfc_char4_t), (const char *) &space, \ + sizeof (gfc_char4_t)); \ + } + +DEFINE_EOSHIFT (1); +DEFINE_EOSHIFT (2); +DEFINE_EOSHIFT (4); +DEFINE_EOSHIFT (8); +#ifdef HAVE_GFC_INTEGER_16 +DEFINE_EOSHIFT (16); +#endif diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c new file mode 100644 index 000000000..fe38d058b --- /dev/null +++ b/libgfortran/intrinsics/eoshift2.c @@ -0,0 +1,326 @@ +/* Generic implementation of the EOSHIFT intrinsic + Copyright 2002, 2005, 2007, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +/* TODO: make this work for large shifts when + sizeof(int) < sizeof (index_type). */ + +static void +eoshift2 (gfc_array_char *ret, const gfc_array_char *array, + int shift, const gfc_array_char *bound, int which, + const char *filler, index_type filler_len) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char * restrict 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; + /* 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; + index_type arraysize; + index_type size; + + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + + size = GFC_DESCRIPTOR_SIZE (array); + + arraysize = size0 ((array_t *) array); + + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (arraysize == 0) + return; + + which = which - 1; + + extent[0] = 1; + count[0] = 0; + sstride[0] = -1; + rstride[0] = -1; + bstride[0] = -1; + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (bound) + bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); + else + bstride[n] = 0; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + if (bound && bstride[0] == 0) + bstride[0] = size; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + bstride0 = bstride[0]; + rptr = ret->data; + sptr = array->data; + + if ((shift >= 0 ? shift : -shift ) > len) + { + shift = len; + len = 0; + } + else + { + if (shift > 0) + len = len - shift; + else + len = len + shift; + } + + if (bound) + bptr = bound->data; + else + bptr = NULL; + + while (rptr) + { + /* Do the shift for this dimension. */ + if (shift > 0) + { + src = &sptr[shift * soffset]; + dest = rptr; + } + else + { + src = sptr; + dest = &rptr[-shift * roffset]; + } + for (n = 0; n < len; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + if (shift >= 0) + { + n = shift; + } + else + { + dest = rptr; + n = -shift; + } + + if (bptr) + while (n--) + { + memcpy (dest, bptr, size); + dest += roffset; + } + else + while (n--) + { + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size ; i += filler_len) + memcpy (&dest[i], filler, filler_len); + + dest += roffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + 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 probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[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]; + bptr += bstride[n]; + } + } + } +} + + +#define DEFINE_EOSHIFT(N) \ + extern void eoshift2_##N (gfc_array_char *, const gfc_array_char *, \ + const GFC_INTEGER_##N *, const gfc_array_char *, \ + const GFC_INTEGER_##N *); \ + export_proto(eoshift2_##N); \ + \ + void \ + eoshift2_##N (gfc_array_char *ret, const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, const gfc_array_char *pbound, \ + const GFC_INTEGER_##N *pdim) \ + { \ + eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ + "\0", 1); \ + } \ + \ + extern void eoshift2_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + GFC_INTEGER_4, GFC_INTEGER_4); \ + export_proto(eoshift2_##N##_char); \ + \ + void \ + eoshift2_##N##_char (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const gfc_array_char *pbound, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length __attribute__((unused)), \ + GFC_INTEGER_4 bound_length __attribute__((unused))) \ + { \ + eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ + " ", 1); \ + } \ + \ + extern void eoshift2_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + GFC_INTEGER_4, GFC_INTEGER_4); \ + export_proto(eoshift2_##N##_char4); \ + \ + void \ + eoshift2_##N##_char4 (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const gfc_array_char *pbound, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length __attribute__((unused)), \ + GFC_INTEGER_4 bound_length __attribute__((unused))) \ + { \ + static const gfc_char4_t space = (unsigned char) ' '; \ + eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ + (const char *) &space, \ + sizeof (gfc_char4_t)); \ + } + +DEFINE_EOSHIFT (1); +DEFINE_EOSHIFT (2); +DEFINE_EOSHIFT (4); +DEFINE_EOSHIFT (8); +#ifdef HAVE_GFC_INTEGER_16 +DEFINE_EOSHIFT (16); +#endif diff --git a/libgfortran/intrinsics/erfc_scaled.c b/libgfortran/intrinsics/erfc_scaled.c new file mode 100644 index 000000000..7ffca40db --- /dev/null +++ b/libgfortran/intrinsics/erfc_scaled.c @@ -0,0 +1,52 @@ +/* Implementation of the ERFC_SCALED intrinsic. + Copyright (C) 2008, 2009 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +/* This implementation of ERFC_SCALED is based on the netlib algorithm + available at http://www.netlib.org/specfun/erf */ + +#ifdef HAVE_GFC_REAL_4 +#undef KIND +#define KIND 4 +#include "erfc_scaled_inc.c" +#endif + +#ifdef HAVE_GFC_REAL_8 +#undef KIND +#define KIND 8 +#include "erfc_scaled_inc.c" +#endif + +#ifdef HAVE_GFC_REAL_10 +#undef KIND +#define KIND 10 +#include "erfc_scaled_inc.c" +#endif + +#ifdef HAVE_GFC_REAL_16 +#undef KIND +#define KIND 16 +#include "erfc_scaled_inc.c" +#endif diff --git a/libgfortran/intrinsics/erfc_scaled_inc.c b/libgfortran/intrinsics/erfc_scaled_inc.c new file mode 100644 index 000000000..7886136c5 --- /dev/null +++ b/libgfortran/intrinsics/erfc_scaled_inc.c @@ -0,0 +1,193 @@ +/* Implementation of the ERFC_SCALED intrinsic, to be included by erfc_scaled.c + Copyright (c) 2008, 2010 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR a PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +/* This implementation of ERFC_SCALED is based on the netlib algorithm + available at http://www.netlib.org/specfun/erf */ + +#define TYPE KIND_SUFFIX(GFC_REAL_,KIND) +#define CONCAT(x,y) x ## y +#define KIND_SUFFIX(x,y) CONCAT(x,y) + +#if (KIND == 4) + +# define EXP(x) expf(x) +# define TRUNC(x) truncf(x) + +#elif (KIND == 8) + +# define EXP(x) exp(x) +# define TRUNC(x) trunc(x) + +#elif (KIND == 10) || (KIND == 16 && defined(GFC_REAL_16_IS_LONG_DOUBLE)) + +# ifdef HAVE_EXPL +# define EXP(x) expl(x) +# endif +# ifdef HAVE_TRUNCL +# define TRUNC(x) truncl(x) +# endif + +#elif (KIND == 16 && defined(GFC_REAL_16_IS_FLOAT128)) + +# define EXP(x) expq(x) +# define TRUNC(x) truncq(x) + +#else + +# error "What exactly is it that you want me to do?" + +#endif + +#if defined(EXP) && defined(TRUNC) + +extern TYPE KIND_SUFFIX(erfc_scaled_r,KIND) (TYPE); +export_proto(KIND_SUFFIX(erfc_scaled_r,KIND)); + +TYPE +KIND_SUFFIX(erfc_scaled_r,KIND) (TYPE x) +{ + /* The main computation evaluates near-minimax approximations + from "Rational Chebyshev approximations for the error function" + by W. J. Cody, Math. Comp., 1969, PP. 631-638. This + transportable program uses rational functions that theoretically + approximate erf(x) and erfc(x) to at least 18 significant + decimal digits. The accuracy achieved depends on the arithmetic + system, the compiler, the intrinsic functions, and proper + selection of the machine-dependent constants. */ + + int i; + TYPE del, res, xden, xnum, y, ysq; + +#if (KIND == 4) + static TYPE xneg = -9.382, xsmall = 5.96e-8, + xbig = 9.194, xhuge = 2.90e+3, xmax = 4.79e+37; +#else + static TYPE xneg = -26.628, xsmall = 1.11e-16, + xbig = 26.543, xhuge = 6.71e+7, xmax = 2.53e+307; +#endif + +#define SQRPI ((TYPE) 0.56418958354775628695L) +#define THRESH ((TYPE) 0.46875L) + + static TYPE a[5] = { 3.16112374387056560l, 113.864154151050156l, + 377.485237685302021l, 3209.37758913846947l, 0.185777706184603153l }; + + static TYPE b[4] = { 23.6012909523441209l, 244.024637934444173l, + 1282.61652607737228l, 2844.23683343917062l }; + + static TYPE c[9] = { 0.564188496988670089l, 8.88314979438837594l, + 66.1191906371416295l, 298.635138197400131l, 881.952221241769090l, + 1712.04761263407058l, 2051.07837782607147l, 1230.33935479799725l, + 2.15311535474403846e-8l }; + + static TYPE d[8] = { 15.7449261107098347l, 117.693950891312499l, + 537.181101862009858l, 1621.38957456669019l, 3290.79923573345963l, + 4362.61909014324716l, 3439.36767414372164l, 1230.33935480374942l }; + + static TYPE p[6] = { 0.305326634961232344l, 0.360344899949804439l, + 0.125781726111229246l, 0.0160837851487422766l, + 0.000658749161529837803l, 0.0163153871373020978l }; + + static TYPE q[5] = { 2.56852019228982242l, 1.87295284992346047l, + 0.527905102951428412l, 0.0605183413124413191l, + 0.00233520497626869185l }; + + y = (x > 0 ? x : -x); + if (y <= THRESH) + { + ysq = 0; + if (y > xsmall) + ysq = y * y; + xnum = a[4]*ysq; + xden = ysq; + for (i = 0; i <= 2; i++) + { + xnum = (xnum + a[i]) * ysq; + xden = (xden + b[i]) * ysq; + } + res = x * (xnum + a[3]) / (xden + b[3]); + res = 1 - res; + res = EXP(ysq) * res; + return res; + } + else if (y <= 4) + { + xnum = c[8]*y; + xden = y; + for (i = 0; i <= 6; i++) + { + xnum = (xnum + c[i]) * y; + xden = (xden + d[i]) * y; + } + res = (xnum + c[7]) / (xden + d[7]); + } + else + { + res = 0; + if (y >= xbig) + { + if (y >= xmax) + goto finish; + if (y >= xhuge) + { + res = SQRPI / y; + goto finish; + } + } + ysq = ((TYPE) 1) / (y * y); + xnum = p[5]*ysq; + xden = ysq; + for (i = 0; i <= 3; i++) + { + xnum = (xnum + p[i]) * ysq; + xden = (xden + q[i]) * ysq; + } + res = ysq *(xnum + p[4]) / (xden + q[4]); + res = (SQRPI - res) / y; + } + +finish: + if (x < 0) + { + if (x < xneg) + res = __builtin_inf (); + else + { + ysq = TRUNC (x*((TYPE) 16))/((TYPE) 16); + del = (x-ysq)*(x+ysq); + y = EXP(ysq*ysq) * EXP(del); + res = (y+y) - res; + } + } + return res; +} + +#endif + +#undef EXP +#undef TRUNC + +#undef CONCAT +#undef TYPE +#undef KIND_SUFFIX diff --git a/libgfortran/intrinsics/etime.c b/libgfortran/intrinsics/etime.c new file mode 100644 index 000000000..d90bc3022 --- /dev/null +++ b/libgfortran/intrinsics/etime.c @@ -0,0 +1,73 @@ +/* Implementation of the ETIME intrinsic. + Copyright (C) 2004, 2005, 2006, 2007, 2009, 2011 Free Software + Foundation, Inc. + Contributed by Steven G. Kargl . + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include "time_1.h" + +extern void etime_sub (gfc_array_r4 *t, GFC_REAL_4 *result); +iexport_proto(etime_sub); + +void +etime_sub (gfc_array_r4 *t, GFC_REAL_4 *result) +{ + GFC_REAL_4 tu, ts, tt, *tp; + long user_sec, user_usec, system_sec, system_usec; + + if (((GFC_DESCRIPTOR_EXTENT(t,0))) < 2) + runtime_error ("Insufficient number of elements in TARRAY."); + + if (gf_cputime (&user_sec, &user_usec, &system_sec, &system_usec) == 0) + { + tu = (GFC_REAL_4)(user_sec + 1.e-6 * user_usec); + ts = (GFC_REAL_4)(system_sec + 1.e-6 * system_usec); + tt = tu + ts; + } + else + { + tu = (GFC_REAL_4)-1.0; + ts = (GFC_REAL_4)-1.0; + tt = (GFC_REAL_4)-1.0; + } + + tp = t->data; + + *tp = tu; + tp += GFC_DESCRIPTOR_STRIDE(t,0); + *tp = ts; + *result = tt; +} +iexport(etime_sub); + +extern GFC_REAL_4 etime (gfc_array_r4 *t); +export_proto(etime); + +GFC_REAL_4 +etime (gfc_array_r4 *t) +{ + GFC_REAL_4 val; + etime_sub (t, &val); + return val; +} diff --git a/libgfortran/intrinsics/execute_command_line.c b/libgfortran/intrinsics/execute_command_line.c new file mode 100644 index 000000000..4e3c4451d --- /dev/null +++ b/libgfortran/intrinsics/execute_command_line.c @@ -0,0 +1,177 @@ +/* Implementation of the EXECUTE_COMMAND_LINE intrinsic. + Copyright (C) 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free +Software Foundation; either version 3, or (at your option) any later +version. + +Libgfortran is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + +#ifdef HAVE_STDLIB_H +#include +#endif +#ifdef HAVE_UNISTD_H +#include +#endif +#ifdef HAVE_SYS_WAIT_H +#include +#endif + + +enum { EXEC_NOERROR = 0, EXEC_SYSTEMFAILED }; +static const char *cmdmsg_values[] = + { "", "Execution of child process impossible" }; + + + +static void +set_cmdstat (int *cmdstat, int value) +{ + if (cmdstat) + *cmdstat = value; + else if (value != 0) + runtime_error ("Could not execute command line"); +} + + +static void +execute_command_line (const char *command, bool wait, int *exitstat, + int *cmdstat, char *cmdmsg, + gfc_charlen_type command_len, + gfc_charlen_type cmdmsg_len) +{ + /* Transform the Fortran string to a C string. */ + char cmd[command_len + 1]; + memcpy (cmd, command, command_len); + cmd[command_len] = '\0'; + + /* Flush all I/O units before executing the command. */ + flush_all_units(); + +#if defined(HAVE_FORK) + if (!wait) + { + /* Asynchronous execution. */ + pid_t pid; + + set_cmdstat (cmdstat, 0); + + if ((pid = fork()) < 0) + set_cmdstat (cmdstat, EXEC_SYSTEMFAILED); + else if (pid == 0) + { + /* Child process. */ + int res = system (cmd); + _exit (WIFEXITED(res) ? WEXITSTATUS(res) : res); + } + } + else +#endif + { + /* Synchronous execution. */ + int res = system (cmd); + + if (!wait) + set_cmdstat (cmdstat, -2); + else if (res == -1) + set_cmdstat (cmdstat, EXEC_SYSTEMFAILED); + else + { + set_cmdstat (cmdstat, 0); +#if defined(WEXITSTATUS) && defined(WIFEXITED) + *exitstat = WIFEXITED(res) ? WEXITSTATUS(res) : res; +#else + *exitstat = res; +#endif + } + } + + /* Now copy back to the Fortran string if needed. */ + if (cmdstat && *cmdstat > 0) + { + if (cmdmsg) + fstrcpy (cmdmsg, cmdmsg_len, cmdmsg_values[*cmdstat], + strlen (cmdmsg_values[*cmdstat])); + else + runtime_error ("Failure in EXECUTE_COMMAND_LINE: %s", + cmdmsg_values[*cmdstat]); + } +} + + +extern void +execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait, + GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat, + char *cmdmsg, gfc_charlen_type command_len, + gfc_charlen_type cmdmsg_len); +export_proto(execute_command_line_i4); + +void +execute_command_line_i4 (const char *command, GFC_LOGICAL_4 *wait, + GFC_INTEGER_4 *exitstat, GFC_INTEGER_4 *cmdstat, + char *cmdmsg, gfc_charlen_type command_len, + gfc_charlen_type cmdmsg_len) +{ + bool w = wait ? *wait : true; + int estat, estat_initial, cstat; + + if (exitstat) + estat_initial = estat = *exitstat; + + execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL, + cmdmsg, command_len, cmdmsg_len); + + if (exitstat && estat != estat_initial) + *exitstat = estat; + if (cmdstat) + *cmdstat = cstat; +} + + +extern void +execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait, + GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat, + char *cmdmsg, gfc_charlen_type command_len, + gfc_charlen_type cmdmsg_len); +export_proto(execute_command_line_i8); + +void +execute_command_line_i8 (const char *command, GFC_LOGICAL_8 *wait, + GFC_INTEGER_8 *exitstat, GFC_INTEGER_8 *cmdstat, + char *cmdmsg, gfc_charlen_type command_len, + gfc_charlen_type cmdmsg_len) +{ + bool w = wait ? *wait : true; + int estat, estat_initial, cstat; + + if (exitstat) + estat_initial = estat = *exitstat; + + execute_command_line (command, w, &estat, cmdstat ? &cstat : NULL, + cmdmsg, command_len, cmdmsg_len); + + if (exitstat && estat != estat_initial) + *exitstat = estat; + if (cmdstat) + *cmdstat = cstat; +} diff --git a/libgfortran/intrinsics/exit.c b/libgfortran/intrinsics/exit.c new file mode 100644 index 000000000..7787581d0 --- /dev/null +++ b/libgfortran/intrinsics/exit.c @@ -0,0 +1,52 @@ +/* Implementation of the EXIT intrinsic. + Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +#include "libgfortran.h" + +#ifdef HAVE_STDLIB_H +#include +#endif + +/* SUBROUTINE EXIT(STATUS) + INTEGER, INTENT(IN), OPTIONAL :: STATUS */ + +extern void exit_i4 (GFC_INTEGER_4 *); +export_proto(exit_i4); + +void +exit_i4 (GFC_INTEGER_4 * status) +{ + exit (status ? *status : 0); +} + +extern void exit_i8 (GFC_INTEGER_8 *); +export_proto(exit_i8); + +void +exit_i8 (GFC_INTEGER_8 * status) +{ + exit (status ? *status : 0); +} diff --git a/libgfortran/intrinsics/extends_type_of.c b/libgfortran/intrinsics/extends_type_of.c new file mode 100644 index 000000000..2fd149c18 --- /dev/null +++ b/libgfortran/intrinsics/extends_type_of.c @@ -0,0 +1,61 @@ +/* Implementation of the EXTENDS_TYPE_OF intrinsic. + Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. + Contributed by Janus Weil . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +#include "libgfortran.h" + +#ifdef HAVE_STDLIB_H +#include +#endif + + +typedef struct vtype +{ + GFC_INTEGER_4 hash; + GFC_INTEGER_4 size; + struct vtype *extends; +} +vtype; + + +extern GFC_LOGICAL_4 is_extension_of (struct vtype *, struct vtype *); +export_proto(is_extension_of); + + +/* This is a helper function for the F2003 intrinsic EXTENDS_TYPE_OF. + While EXTENDS_TYPE_OF accepts CLASS or TYPE arguments, this one here gets + passed the corresponding vtabs. Each call to EXTENDS_TYPE_OF is translated + to a call to is_extension_of. */ + +GFC_LOGICAL_4 +is_extension_of (struct vtype *v1, struct vtype *v2) +{ + while (v1) + { + if (v1->hash == v2->hash) return 1; + v1 = v1->extends; + } + return 0; +} diff --git a/libgfortran/intrinsics/f2c_specifics.F90 b/libgfortran/intrinsics/f2c_specifics.F90 new file mode 100644 index 000000000..dd7713a68 --- /dev/null +++ b/libgfortran/intrinsics/f2c_specifics.F90 @@ -0,0 +1,197 @@ +! Copyright 2002, 2005, 2009 Free Software Foundation, Inc. +! Contributed by Tobias Schl"uter +! +!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 3 of the License, or (at your option) any later version. +! +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. + +! Specifics for the intrinsics whose calling conventions change if +! -ff2c is used. +! +! There are two annoyances WRT the preprocessor: +! - we're using -traditional-cpp, so we can't use the ## operator. +! - macros expand to a single line, and Fortran lines can't be wider +! than 132 characters, therefore we use two macros to split the lines +! +! The cases we need to implement are functions returning default REAL +! or COMPLEX. The former need to return DOUBLE PRECISION instead of REAL, +! the latter become subroutines returning via a hidden first argument. + +! one argument functions +#define REAL_HEAD(NAME) \ +elemental function _gfortran_f2c_specific__/**/NAME/**/_r4 (parm) result(res); + +#define REAL_BODY(NAME) \ + REAL, intent (in) :: parm; \ + DOUBLE PRECISION :: res; \ + res = NAME (parm); \ +end function + +#define COMPLEX_HEAD(NAME) \ +subroutine _gfortran_f2c_specific__/**/NAME/**/_c4 (res, parm); + +#define COMPLEX_BODY(NAME) \ + COMPLEX, intent (in) :: parm; \ + COMPLEX, intent (out) :: res; \ + res = NAME (parm); \ +end subroutine + +#define DCOMPLEX_HEAD(NAME) \ +subroutine _gfortran_f2c_specific__/**/NAME/**/_c8 (res, parm); + +#define DCOMPLEX_BODY(NAME) \ + DOUBLE COMPLEX, intent (in) :: parm; \ + DOUBLE COMPLEX, intent (out) :: res; \ + res = NAME (parm); \ +end subroutine + +REAL_HEAD(abs) +REAL_BODY(abs) + +! abs is special in that the result is real +elemental function _gfortran_f2c_specific__abs_c4 (parm) result (res) + COMPLEX, intent(in) :: parm + DOUBLE PRECISION :: res + res = abs(parm) +end function + + +! aimag is special in that the result is real +elemental function _gfortran_f2c_specific__aimag_c4 (parm) + complex(kind=4), intent(in) :: parm + double precision :: _gfortran_f2c_specific__aimag_c4 + _gfortran_f2c_specific__aimag_c4 = aimag(parm) +end function + +elemental function _gfortran_f2c_specific__aimag_c8 (parm) + complex(kind=8), intent(in) :: parm + double precision :: _gfortran_f2c_specific__aimag_c8 + _gfortran_f2c_specific__aimag_c8 = aimag(parm) +end function + + +REAL_HEAD(exp) +REAL_BODY(exp) +COMPLEX_HEAD(exp) +COMPLEX_BODY(exp) +DCOMPLEX_HEAD(exp) +DCOMPLEX_BODY(exp) + +REAL_HEAD(log) +REAL_BODY(log) +COMPLEX_HEAD(log) +COMPLEX_BODY(log) +DCOMPLEX_HEAD(log) +DCOMPLEX_BODY(log) + +REAL_HEAD(log10) +REAL_BODY(log10) + +REAL_HEAD(sqrt) +REAL_BODY(sqrt) +COMPLEX_HEAD(sqrt) +COMPLEX_BODY(sqrt) +DCOMPLEX_HEAD(sqrt) +DCOMPLEX_BODY(sqrt) + +REAL_HEAD(asin) +REAL_BODY(asin) + +REAL_HEAD(acos) +REAL_BODY(acos) + +REAL_HEAD(atan) +REAL_BODY(atan) + +REAL_HEAD(asinh) +REAL_BODY(asinh) + +REAL_HEAD(acosh) +REAL_BODY(acosh) + +REAL_HEAD(atanh) +REAL_BODY(atanh) + +REAL_HEAD(sin) +REAL_BODY(sin) +COMPLEX_HEAD(sin) +COMPLEX_BODY(sin) +DCOMPLEX_HEAD(sin) +DCOMPLEX_BODY(sin) + +REAL_HEAD(cos) +REAL_BODY(cos) +COMPLEX_HEAD(cos) +COMPLEX_BODY(cos) +DCOMPLEX_HEAD(cos) +DCOMPLEX_BODY(cos) + +REAL_HEAD(tan) +REAL_BODY(tan) + +REAL_HEAD(sinh) +REAL_BODY(sinh) + +REAL_HEAD(cosh) +REAL_BODY(cosh) + +REAL_HEAD(tanh) +REAL_BODY(tanh) + +REAL_HEAD(aint) +REAL_BODY(aint) + +REAL_HEAD(anint) +REAL_BODY(anint) + +! two argument functions +#define REAL2_HEAD(NAME) \ +elemental function _gfortran_f2c_specific__/**/NAME/**/_r4 (p1, p2) result(res); + +#define REAL2_BODY(NAME) \ + REAL, intent (in) :: p1, p2; \ + DOUBLE PRECISION :: res; \ + res = NAME (p1, p2); \ +end function + +REAL2_HEAD(sign) +REAL2_BODY(sign) + +REAL2_HEAD(dim) +REAL2_BODY(dim) + +REAL2_HEAD(atan2) +REAL2_BODY(atan2) + +REAL2_HEAD(mod) +REAL2_BODY(mod) + +! conjg is special-cased because it is not suffixed _c4 but _4 +subroutine _gfortran_f2c_specific__conjg_4 (res, parm) + COMPLEX, intent (in) :: parm + COMPLEX, intent (out) :: res + res = conjg (parm) +end subroutine +subroutine _gfortran_f2c_specific__conjg_8 (res, parm) + DOUBLE COMPLEX, intent (in) :: parm + DOUBLE COMPLEX, intent (out) :: res + res = conjg (parm) +end subroutine + diff --git a/libgfortran/intrinsics/fnum.c b/libgfortran/intrinsics/fnum.c new file mode 100644 index 000000000..f155042a5 --- /dev/null +++ b/libgfortran/intrinsics/fnum.c @@ -0,0 +1,48 @@ +/* Implementation of the FNUM intrinsics. + Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +/* FUNCTION FNUM(UNIT) + INTEGER FNUM + INTEGER, INTENT(IN), :: UNIT */ + +extern GFC_INTEGER_4 fnum_i4 (GFC_INTEGER_4 *); +export_proto(fnum_i4); + +GFC_INTEGER_4 +fnum_i4 (GFC_INTEGER_4 *unit) +{ + return unit_to_fd (*unit); +} + +extern GFC_INTEGER_8 fnum_i8 (GFC_INTEGER_8 *); +export_proto(fnum_i8); + +GFC_INTEGER_8 +fnum_i8 (GFC_INTEGER_8 * unit) +{ + return unit_to_fd (*unit); +} diff --git a/libgfortran/intrinsics/gerror.c b/libgfortran/intrinsics/gerror.c new file mode 100644 index 000000000..6feadc9b7 --- /dev/null +++ b/libgfortran/intrinsics/gerror.c @@ -0,0 +1,59 @@ +/* Implementation of the GERROR g77 intrinsic. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + + +/* GERROR (MESSAGE), g77 intrinsic for retrieving the system error + message corresponding to the last system error (C errno). + CHARACTER(len=*), INTENT(OUT) :: MESSAGE */ + +#ifdef HAVE_STRERROR +void PREFIX(gerror) (char *, gfc_charlen_type); +export_proto_np(PREFIX(gerror)); + +void +PREFIX(gerror) (char * msg, gfc_charlen_type msg_len) +{ + int p_len; + char *p; + + p = gf_strerror (errno, msg, msg_len); + p_len = strlen (p); + /* The returned pointer p might or might not be the same as the msg + argument. */ + if (p != msg) + { + if (msg_len < p_len) + p_len = msg_len; + memcpy (msg, p, p_len); + } + if (msg_len > p_len) + memset (&msg[p_len], ' ', msg_len - p_len); +} +#endif diff --git a/libgfortran/intrinsics/getXid.c b/libgfortran/intrinsics/getXid.c new file mode 100644 index 000000000..9eb60f039 --- /dev/null +++ b/libgfortran/intrinsics/getXid.c @@ -0,0 +1,67 @@ +/* Wrapper for the unix get{g,p,u}id functions. +Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#if HAVE_UNISTD_H +#include +#endif + +#ifdef __MINGW32__ +#define HAVE_GETPID 1 +#include +#endif + +#ifdef HAVE_GETGID +extern GFC_INTEGER_4 PREFIX(getgid) (void); +export_proto_np(PREFIX(getgid)); + +GFC_INTEGER_4 +PREFIX(getgid) (void) +{ + return getgid (); +} +#endif + +#ifdef HAVE_GETPID +extern GFC_INTEGER_4 PREFIX(getpid) (void); +export_proto_np(PREFIX(getpid)); + +GFC_INTEGER_4 +PREFIX(getpid) (void) +{ + return getpid (); +} +#endif + +#ifdef HAVE_GETUID +extern GFC_INTEGER_4 PREFIX(getuid) (void); +export_proto_np(PREFIX(getuid)); + +GFC_INTEGER_4 +PREFIX(getuid) (void) +{ + return getuid (); +} +#endif diff --git a/libgfortran/intrinsics/getcwd.c b/libgfortran/intrinsics/getcwd.c new file mode 100644 index 000000000..15e8e8f7b --- /dev/null +++ b/libgfortran/intrinsics/getcwd.c @@ -0,0 +1,83 @@ +/* Implementation of the GETCWD intrinsic. + Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +#ifdef HAVE_UNISTD_H +#include +#endif + +#ifdef HAVE_GETCWD + +extern void getcwd_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type); +iexport_proto(getcwd_i4_sub); + +void +getcwd_i4_sub (char *cwd, GFC_INTEGER_4 *status, gfc_charlen_type cwd_len) +{ + char str[cwd_len + 1]; + GFC_INTEGER_4 stat; + + memset(cwd, ' ', (size_t) cwd_len); + + if (!getcwd (str, (size_t) cwd_len + 1)) + stat = errno; + else + { + stat = 0; + memcpy (cwd, str, strlen (str)); + } + if (status != NULL) + *status = stat; +} +iexport(getcwd_i4_sub); + +extern void getcwd_i8_sub (char *, GFC_INTEGER_8 *, gfc_charlen_type); +export_proto(getcwd_i8_sub); + +void +getcwd_i8_sub (char *cwd, GFC_INTEGER_8 *status, gfc_charlen_type cwd_len) +{ + GFC_INTEGER_4 status4; + getcwd_i4_sub (cwd, &status4, cwd_len); + if (status) + *status = status4; +} + +extern GFC_INTEGER_4 PREFIX(getcwd) (char *, gfc_charlen_type); +export_proto_np(PREFIX(getcwd)); + +GFC_INTEGER_4 +PREFIX(getcwd) (char *cwd, gfc_charlen_type cwd_len) +{ + GFC_INTEGER_4 status; + getcwd_i4_sub (cwd, &status, cwd_len); + return status; +} + +#endif diff --git a/libgfortran/intrinsics/getlog.c b/libgfortran/intrinsics/getlog.c new file mode 100644 index 000000000..9e5c8de46 --- /dev/null +++ b/libgfortran/intrinsics/getlog.c @@ -0,0 +1,121 @@ +/* Implementation of the GETLOG g77 intrinsic. + Copyright (C) 2005, 2007, 2009, 2011 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include + +#ifdef HAVE_UNISTD_H +# if defined __MINGW32__ && defined HAVE_GETLOGIN +# define _POSIX 1 +# endif +#include +#endif +#ifdef HAVE_PWD_H +#include +#endif + +/* Windows32 version */ +#if defined __MINGW32__ && !defined HAVE_GETLOGIN +#define WIN32_LEAN_AND_MEAN +#include +#include /* for UNLEN */ + +static char * +w32_getlogin (void) +{ + static char name [UNLEN + 1]; + DWORD namelen = sizeof (name); + + GetUserName (name, &namelen); + return (name[0] == 0 ? NULL : name); +} + +#undef getlogin +#define getlogin w32_getlogin +#define HAVE_GETLOGIN 1 + +#endif + + +/* GETLOG (LOGIN), g77 intrinsic for retrieving the login name for the + process. + CHARACTER(len=*), INTENT(OUT) :: LOGIN */ + +void PREFIX(getlog) (char *, gfc_charlen_type); +export_proto_np(PREFIX(getlog)); + +void +PREFIX(getlog) (char * login, gfc_charlen_type login_len) +{ + int p_len; + char *p; + + memset (login, ' ', login_len); /* Blank the string. */ + +#if defined(HAVE_POSIX_GETPWUID_R) && defined(HAVE_GETEUID) + struct passwd pwd; + struct passwd *result; + char *buf; + int err; + /* To be pedantic, buflen should be determined by + sysconf(_SC_GETPW_R_SIZE_MAX), which is 1024 on some tested + targets; we do something simple in case the target doesn't + support sysconf. */ + static const size_t buflen = 1024; + buf = get_mem (buflen); + err = getpwuid_r (geteuid (), &pwd, buf, buflen, &result); + if (err != 0 || result == NULL) + goto cleanup; + p = pwd.pw_name; +#elif defined(HAVE_GETPWUID) && defined(HAVE_GETEUID) + { + struct passwd *pw = getpwuid (geteuid ()); + if (pw) + p = pw->pw_name; + else + return; + } +#elif HAVE_GETLOGIN + p = getlogin(); +# else + return; +#endif + + if (p == NULL) + goto cleanup; + + p_len = strlen (p); + if (login_len < p_len) + p_len = login_len; + memcpy (login, p, p_len); + + cleanup: +#if defined (HAVE_POSIX_GETPWUID_R) && defined(HAVE_GETEUID) + free (buf); +#else + ; +#endif +} diff --git a/libgfortran/intrinsics/hostnm.c b/libgfortran/intrinsics/hostnm.c new file mode 100644 index 000000000..99ab18dcb --- /dev/null +++ b/libgfortran/intrinsics/hostnm.c @@ -0,0 +1,144 @@ +/* Implementation of the HOSTNM intrinsic. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +#ifdef HAVE_UNISTD_H +#include +#endif + + +/* Windows32 version */ +#if defined __MINGW32__ && !defined HAVE_GETHOSTNAME +#define WIN32_LEAN_AND_MEAN +#include +#include + +static int +w32_gethostname (char *name, size_t len) +{ + /* We could try the WinSock API gethostname, but that will + fail if WSAStartup function has has not been called. We don't + really need a name that will be understood by socket API, so avoid + unnecessary dependence on WinSock libraries by using + GetComputerName instead. */ + + /* On Win9x GetComputerName fails if the input size is less + than MAX_COMPUTERNAME_LENGTH + 1. */ + char buffer[MAX_COMPUTERNAME_LENGTH + 1]; + DWORD size = sizeof (buffer); + + if (!GetComputerName (buffer, &size)) + return -1; + + if ((size = strlen (buffer) + 1) > len) + { + errno = EINVAL; + /* Truncate as per POSIX spec. We do not NUL-terminate. */ + size = len; + } + memcpy (name, buffer, (size_t) size); + + return 0; +} + +#undef gethostname +#define gethostname w32_gethostname +#define HAVE_GETHOSTNAME 1 + +#endif + + +/* SUBROUTINE HOSTNM(NAME, STATUS) + CHARACTER(len=*), INTENT(OUT) :: NAME + INTEGER, INTENT(OUT), OPTIONAL :: STATUS */ + +#ifdef HAVE_GETHOSTNAME +extern void hostnm_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type); +iexport_proto(hostnm_i4_sub); + +void +hostnm_i4_sub (char *name, GFC_INTEGER_4 *status, gfc_charlen_type name_len) +{ + int val, i; + char *p; + + memset (name, ' ', name_len); + p = gfc_alloca (name_len + 1); + + val = gethostname (p, name_len); + + if (val == 0) + { + i = -1; + while (i < name_len && p[++i] != '\0') + name[i] = p[i]; + } + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(hostnm_i4_sub); + +extern void hostnm_i8_sub (char *, GFC_INTEGER_8 *, gfc_charlen_type); +iexport_proto(hostnm_i8_sub); + +void +hostnm_i8_sub (char *name, GFC_INTEGER_8 *status, gfc_charlen_type name_len) +{ + int val, i; + char *p; + + memset (name, ' ', name_len); + p = gfc_alloca (name_len + 1); + + val = gethostname (p, name_len); + + if (val == 0) + { + i = -1; + while (i < name_len && p[++i] != '\0') + name[i] = p[i]; + } + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(hostnm_i8_sub); + +extern GFC_INTEGER_4 hostnm (char *, gfc_charlen_type); +export_proto(hostnm); + +GFC_INTEGER_4 +hostnm (char *name, gfc_charlen_type name_len) +{ + GFC_INTEGER_4 val; + hostnm_i4_sub (name, &val, name_len); + return val; +} +#endif diff --git a/libgfortran/intrinsics/ierrno.c b/libgfortran/intrinsics/ierrno.c new file mode 100644 index 000000000..2f5e44fa6 --- /dev/null +++ b/libgfortran/intrinsics/ierrno.c @@ -0,0 +1,49 @@ +/* Implementation of the IERRNO intrinsic. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include + + +/* INTEGER FUNCTION IERRNO() */ + +extern GFC_INTEGER_4 ierrno_i4 (void); +export_proto(ierrno_i4); + +GFC_INTEGER_4 +ierrno_i4 (void) +{ + return (GFC_INTEGER_4) errno; +} + +extern GFC_INTEGER_8 ierrno_i8 (void); +export_proto(ierrno_i8); + +GFC_INTEGER_8 +ierrno_i8 (void) +{ + return (GFC_INTEGER_8) errno; +} diff --git a/libgfortran/intrinsics/ishftc.c b/libgfortran/intrinsics/ishftc.c new file mode 100644 index 000000000..054c3167b --- /dev/null +++ b/libgfortran/intrinsics/ishftc.c @@ -0,0 +1,100 @@ +/* Implementation of ishftc intrinsic. + Copyright 2002, 2004, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +extern GFC_INTEGER_4 ishftc4 (GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(ishftc4); + +GFC_INTEGER_4 +ishftc4 (GFC_INTEGER_4 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size) +{ + GFC_UINTEGER_4 mask, bits; + + if (shift < 0) + shift = shift + size; + + if (shift == 0 || shift == size) + return i; + + /* In C, the result of the shift operator is undefined if the right operand + is greater than or equal to the number of bits in the left operand. So we + have to special case it for fortran. */ + mask = ~((size == 32) ? (GFC_UINTEGER_4)0 : (~(GFC_UINTEGER_4)0 << size)); + + bits = i & mask; + + return (i & ~mask) | ((bits << shift) & mask) | (bits >> (size - shift)); +} + +extern GFC_INTEGER_8 ishftc8 (GFC_INTEGER_8, GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(ishftc8); + +GFC_INTEGER_8 +ishftc8 (GFC_INTEGER_8 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size) +{ + GFC_UINTEGER_8 mask, bits; + + if (shift < 0) + shift = shift + size; + + if (shift == 0 || shift == size) + return i; + + /* In C, the result of the shift operator is undefined if the right operand + is greater than or equal to the number of bits in the left operand. So we + have to special case it for fortran. */ + mask = ~((size == 64) ? (GFC_UINTEGER_8)0 : (~(GFC_UINTEGER_8)0 << size)); + + bits = i & mask; + + return (i & ~mask) | ((bits << shift) & mask) | (bits >> (size - shift)); +} + +#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_UINTEGER_16 mask, bits; + + if (shift < 0) + shift = shift + size; + + if (shift == 0 || shift == size) + return i; + + /* In C, the result of the shift operator is undefined if the right operand + is greater than or equal to the number of bits in the left operand. So we + have to special case it for fortran. */ + mask = ~((size == 128) ? (GFC_UINTEGER_16)0 : (~(GFC_UINTEGER_16)0 << size)); + + bits = i & mask; + + return (i & ~mask) | ((bits << shift) & mask) | (bits >> (size - shift)); +} +#endif diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c new file mode 100644 index 000000000..327ad5128 --- /dev/null +++ b/libgfortran/intrinsics/iso_c_binding.c @@ -0,0 +1,189 @@ +/* Implementation of the ISO_C_BINDING library helper functions. + Copyright (C) 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Christopher Rickett. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* Implement the functions and subroutines provided by the intrinsic + iso_c_binding module. */ + +#include "libgfortran.h" +#include "iso_c_binding.h" + +#include + + +/* Set the fields of a Fortran pointer descriptor to point to the + given C address. It uses c_f_pointer_u0 for the common + fields, and will set up the information necessary if this C address + is to an array (i.e., offset, type, element size). The parameter + c_ptr_in represents the C address to have Fortran point to. The + parameter f_ptr_out is the Fortran pointer to associate with the C + address. The parameter shape is a one-dimensional array of integers + specifying the upper bound(s) of the array pointed to by the given C + address, if applicable. The shape parameter is optional in Fortran, + which will cause it to come in here as NULL. The parameter type is + the type of the data being pointed to (i.e.,libgfortran.h). The + elem_size parameter is the size, in bytes, of the data element being + pointed to. If the address is for an array, then the size needs to + be the size of a single element (i.e., for an array of doubles, it + needs to be the number of bytes for the size of one double). */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape, + int type, int elemSize) +{ + if (shape != NULL) + { + f_ptr_out->offset = 0; + + /* Set the necessary dtype field for all pointers. */ + f_ptr_out->dtype = 0; + + /* Put in the element size. */ + f_ptr_out->dtype = f_ptr_out->dtype | (elemSize << GFC_DTYPE_SIZE_SHIFT); + + /* Set the data type (e.g., BT_INTEGER). */ + f_ptr_out->dtype = f_ptr_out->dtype | (type << GFC_DTYPE_TYPE_SHIFT); + } + + /* Use the generic version of c_f_pointer to set common fields. */ + ISO_C_BINDING_PREFIX (c_f_pointer_u0) (c_ptr_in, f_ptr_out, shape); +} + + +/* A generic function to set the common fields of all descriptors, no + matter whether it's to a scalar or an array. Access is via the array + descrptor macros. Parameter shape is a rank 1 array of integers + containing the upper bound of each dimension of what f_ptr_out + points to. The length of this array must be EXACTLY the rank of + what f_ptr_out points to, as required by the draft (J3/04-007). If + f_ptr_out points to a scalar, then this parameter will be NULL. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + int i = 0; + int shapeSize = 0; + + GFC_DESCRIPTOR_DATA (f_ptr_out) = c_ptr_in; + + if (shape != NULL) + { + index_type source_stride, size; + index_type str = 1; + char *p; + + f_ptr_out->offset = str; + shapeSize = 0; + p = shape->data; + size = GFC_DESCRIPTOR_SIZE(shape); + + source_stride = GFC_DESCRIPTOR_STRIDE_BYTES(shape,0); + + /* shape's length (rank of the output array) */ + shapeSize = GFC_DESCRIPTOR_EXTENT(shape,0); + for (i = 0; i < shapeSize; i++) + { + index_type ub; + + /* Have to allow for the SHAPE array to be any valid kind for + an INTEGER type. */ + switch (size) + { +#ifdef HAVE_GFC_INTEGER_1 + case 1: + ub = *((GFC_INTEGER_1 *) p); + break; +#endif +#ifdef HAVE_GFC_INTEGER_2 + case 2: + ub = *((GFC_INTEGER_2 *) p); + break; +#endif +#ifdef HAVE_GFC_INTEGER_4 + case 4: + ub = *((GFC_INTEGER_4 *) p); + break; +#endif +#ifdef HAVE_GFC_INTEGER_8 + case 8: + ub = *((GFC_INTEGER_8 *) p); + break; +#endif +#ifdef HAVE_GFC_INTEGER_16 + case 16: + ub = *((GFC_INTEGER_16 *) p); + break; +#endif + default: + internal_error (NULL, "c_f_pointer_u0: Invalid size"); + } + p += source_stride; + + if (i != 0) + { + str = str * GFC_DESCRIPTOR_EXTENT(f_ptr_out,i-1); + f_ptr_out->offset += str; + } + + /* Lower bound is 1, as specified by the draft. */ + GFC_DIMENSION_SET(f_ptr_out->dim[i], 1, ub, str); + } + + f_ptr_out->offset *= -1; + + /* All we know is the rank, so set it, leaving the rest alone. + Make NO assumptions about the state of dtype coming in! If we + shift right by TYPE_SHIFT bits we'll throw away the existing + rank. Then, shift left by the same number to shift in zeros + and or with the new rank. */ + f_ptr_out->dtype = ((f_ptr_out->dtype >> GFC_DTYPE_TYPE_SHIFT) + << GFC_DTYPE_TYPE_SHIFT) | shapeSize; + } +} + + +/* Sets the descriptor fields for a Fortran pointer to a derived type, + using c_f_pointer_u0 for the majority of the work. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_d0) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Set the common fields. */ + ISO_C_BINDING_PREFIX (c_f_pointer_u0) (c_ptr_in, f_ptr_out, shape); + + /* Preserve the size and rank bits, but reset the type. */ + if (shape != NULL) + { + f_ptr_out->dtype = f_ptr_out->dtype & (~GFC_DTYPE_TYPE_MASK); + f_ptr_out->dtype = f_ptr_out->dtype + | (BT_DERIVED << GFC_DTYPE_TYPE_SHIFT); + } +} diff --git a/libgfortran/intrinsics/iso_c_binding.h b/libgfortran/intrinsics/iso_c_binding.h new file mode 100644 index 000000000..e09147a66 --- /dev/null +++ b/libgfortran/intrinsics/iso_c_binding.h @@ -0,0 +1,55 @@ +/* Copyright (C) 2007, 2009 Free Software Foundation, Inc. + Contributed by Christopher Rickett. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* Declarations for ISO_C_BINDING library helper functions. */ + +#ifndef GFOR_ISO_C_BINDING_H +#define GFOR_ISO_C_BINDING_H + +#include "libgfortran.h" + +typedef struct c_ptr +{ + void *c_address; +} +c_ptr_t; + +typedef struct c_funptr +{ + void *c_address; +} +c_funptr_t; + +#define ISO_C_BINDING_PREFIX(a) __iso_c_binding_##a + +void ISO_C_BINDING_PREFIX(c_f_pointer)(void *, gfc_array_void *, + const array_t *, int, int); + +void ISO_C_BINDING_PREFIX(c_f_pointer_u0) (void *, gfc_array_void *, + const array_t *); +void ISO_C_BINDING_PREFIX(c_f_pointer_d0) (void *, gfc_array_void *, + const array_t *); + +#endif diff --git a/libgfortran/intrinsics/iso_c_generated_procs.c b/libgfortran/intrinsics/iso_c_generated_procs.c new file mode 100644 index 000000000..8014f6436 --- /dev/null +++ b/libgfortran/intrinsics/iso_c_generated_procs.c @@ -0,0 +1,466 @@ +/* Implementation of the ISO_C_BINDING library helper generated functions. + Copyright (C) 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Christopher Rickett. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +#include "libgfortran.h" +#include "iso_c_binding.h" + + +/* TODO: This file needs to be finished so that a function is provided + for all possible type/kind combinations! */ + +#ifdef HAVE_GFC_INTEGER_1 +void ISO_C_BINDING_PREFIX (c_f_pointer_i1) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_INTEGER_2 +void ISO_C_BINDING_PREFIX (c_f_pointer_i2) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_INTEGER_4 +void ISO_C_BINDING_PREFIX (c_f_pointer_i4) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_INTEGER_8 +void ISO_C_BINDING_PREFIX (c_f_pointer_i8) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_INTEGER_16 +void ISO_C_BINDING_PREFIX (c_f_pointer_i16) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_REAL_4 +void ISO_C_BINDING_PREFIX (c_f_pointer_r4) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_REAL_8 +void ISO_C_BINDING_PREFIX (c_f_pointer_r8) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_REAL_10 +void ISO_C_BINDING_PREFIX (c_f_pointer_r10) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_REAL_16 +void ISO_C_BINDING_PREFIX (c_f_pointer_r16) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_COMPLEX_4 +void ISO_C_BINDING_PREFIX (c_f_pointer_c4) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_COMPLEX_8 +void ISO_C_BINDING_PREFIX (c_f_pointer_c8) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_COMPLEX_10 +void ISO_C_BINDING_PREFIX (c_f_pointer_c10) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_COMPLEX_16 +void ISO_C_BINDING_PREFIX (c_f_pointer_c16) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef GFC_DEFAULT_CHAR +void ISO_C_BINDING_PREFIX (c_f_pointer_s0) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_LOGICAL_1 +void ISO_C_BINDING_PREFIX (c_f_pointer_l1) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_LOGICAL_2 +void ISO_C_BINDING_PREFIX (c_f_pointer_l2) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_LOGICAL_4 +void ISO_C_BINDING_PREFIX (c_f_pointer_l4) (void *, gfc_array_void *, + const array_t *); +#endif + +#ifdef HAVE_GFC_LOGICAL_8 +void ISO_C_BINDING_PREFIX (c_f_pointer_l8) (void *, gfc_array_void *, + const array_t *); +#endif + + +#ifdef HAVE_GFC_INTEGER_1 +/* Set the given Fortran pointer, 'f_ptr_out', to point to the given C + address, 'c_ptr_in'. The Fortran pointer is of type integer and + kind=1. The function c_f_pointer is used to set up the pointer + descriptor. shape is a one-dimensional array of integers + specifying the upper bounds of the array pointed to by the given C + address, if applicable. 'shape' is an optional parameter in + Fortran, so if the user does not provide it, it will come in here + as NULL. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_i1) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an integer(kind=1). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_INTEGER, + (int) sizeof (GFC_INTEGER_1)); +} +#endif + + +#ifdef HAVE_GFC_INTEGER_2 +/* Set the given Fortran pointer, 'f_ptr_out', to point to the given C + address, 'c_ptr_in'. The Fortran pointer is of type integer and + kind=2. The function c_f_pointer is used to set up the pointer + descriptor. shape is a one-dimensional array of integers + specifying the upper bounds of the array pointed to by the given C + address, if applicable. 'shape' is an optional parameter in + Fortran, so if the user does not provide it, it will come in here + as NULL. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_i2) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an integer(kind=2). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_INTEGER, + (int) sizeof (GFC_INTEGER_2)); +} +#endif + + +#ifdef HAVE_GFC_INTEGER_4 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type integer and + kind=4. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_i4) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an integer(kind=4). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_INTEGER, + (int) sizeof (GFC_INTEGER_4)); +} +#endif + + +#ifdef HAVE_GFC_INTEGER_8 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type integer and + kind=8. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_i8) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an integer(kind=8). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_INTEGER, + (int) sizeof (GFC_INTEGER_8)); +} +#endif + + +#ifdef HAVE_GFC_INTEGER_16 +/* Set the given Fortran pointer, 'f_ptr_out', to point to the given C + address, 'c_ptr_in'. The Fortran pointer is of type integer and + kind=16. The function c_f_pointer is used to set up the pointer + descriptor. shape is a one-dimensional array of integers + specifying the upper bounds of the array pointed to by the given C + address, if applicable. 'shape' is an optional parameter in + Fortran, so if the user does not provide it, it will come in here + as NULL. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_i16) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an integer(kind=16). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_INTEGER, + (int) sizeof (GFC_INTEGER_16)); +} +#endif + + +#ifdef HAVE_GFC_REAL_4 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type real and + kind=4. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_r4) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an real(kind=4). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_REAL, + (int) sizeof (GFC_REAL_4)); +} +#endif + + +#ifdef HAVE_GFC_REAL_8 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type real and + kind=8. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_r8) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an real(kind=8). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_REAL, + (int) sizeof (GFC_REAL_8)); +} +#endif + + +#ifdef HAVE_GFC_REAL_10 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type real and + kind=10. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_r10) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an real(kind=10). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_REAL, + (int) sizeof (GFC_REAL_10)); +} +#endif + + +#ifdef HAVE_GFC_REAL_16 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type real and + kind=16. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_r16) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an real(kind=16). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_REAL, + (int) sizeof (GFC_REAL_16)); +} +#endif + + +#ifdef HAVE_GFC_COMPLEX_4 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type complex and + kind=4. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_c4) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an complex(kind=4). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_COMPLEX, + (int) sizeof (GFC_COMPLEX_4)); +} +#endif + + +#ifdef HAVE_GFC_COMPLEX_8 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type complex and + kind=8. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_c8) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an complex(kind=8). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_COMPLEX, + (int) sizeof (GFC_COMPLEX_8)); +} +#endif + + +#ifdef HAVE_GFC_COMPLEX_10 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type complex and + kind=10. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_c10) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an complex(kind=10). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_COMPLEX, + (int) sizeof (GFC_COMPLEX_10)); +} +#endif + + +#ifdef HAVE_GFC_COMPLEX_16 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type complex and + kind=16. The function c_f_pointer is used to set up the pointer + descriptor. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_c16) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have an complex(kind=16). */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_COMPLEX, + (int) sizeof (GFC_COMPLEX_16)); +} +#endif + + +#ifdef GFC_DEFAULT_CHAR +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type character. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_s0) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have a character string of len=1. */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_CHARACTER, + (int) sizeof (char)); +} +#endif + + +#ifdef HAVE_GFC_LOGICAL_1 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type logical, kind=1. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_l1) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have a logical of kind=1. */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_LOGICAL, + (int) sizeof (GFC_LOGICAL_1)); +} +#endif + + +#ifdef HAVE_GFC_LOGICAL_2 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type logical, kind=2. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_l2) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have a logical of kind=2. */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_LOGICAL, + (int) sizeof (GFC_LOGICAL_2)); +} +#endif + + +#ifdef HAVE_GFC_LOGICAL_4 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type logical, kind=4. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_l4) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have a logical of kind=4. */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_LOGICAL, + (int) sizeof (GFC_LOGICAL_4)); +} +#endif + + +#ifdef HAVE_GFC_LOGICAL_8 +/* Set the given Fortran pointer, f_ptr_out, to point to the given C + address, c_ptr_in. The Fortran pointer is of type logical, kind=8. */ + +void +ISO_C_BINDING_PREFIX (c_f_pointer_l8) (void *c_ptr_in, + gfc_array_void *f_ptr_out, + const array_t *shape) +{ + /* Here we have a logical of kind=8. */ + ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, + (int) BT_LOGICAL, + (int) sizeof (GFC_LOGICAL_8)); +} +#endif diff --git a/libgfortran/intrinsics/kill.c b/libgfortran/intrinsics/kill.c new file mode 100644 index 000000000..83e8b2838 --- /dev/null +++ b/libgfortran/intrinsics/kill.c @@ -0,0 +1,94 @@ +/* Implementation of the KILL g77 intrinsic. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + +#ifdef HAVE_SIGNAL_H +#include +#endif + +/* SUBROUTINE KILL(PID, SIGNAL, STATUS) + INTEGER, INTENT(IN) :: PID, SIGNAL + INTEGER(KIND=1), INTENT(OUT), OPTIONAL :: STATUS + + INTEGER(KIND=1) FUNCTION KILL(PID, SIGNAL) + INTEGER, INTENT(IN) :: PID, SIGNAL */ + +#ifdef HAVE_KILL +extern void kill_i4_sub (GFC_INTEGER_4 *, GFC_INTEGER_4 *, GFC_INTEGER_4 *); +iexport_proto(kill_i4_sub); + +void +kill_i4_sub (GFC_INTEGER_4 *pid, GFC_INTEGER_4 *signal, + GFC_INTEGER_4 *status) +{ + int val; + + val = kill (*pid, *signal); + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(kill_i4_sub); + +extern void kill_i8_sub (GFC_INTEGER_8 *, GFC_INTEGER_8 *, GFC_INTEGER_8 *); +iexport_proto(kill_i8_sub); + +void +kill_i8_sub (GFC_INTEGER_8 *pid, GFC_INTEGER_8 *signal, + GFC_INTEGER_8 *status) +{ + int val; + + val = kill (*pid, *signal); + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(kill_i8_sub); + +extern GFC_INTEGER_4 kill_i4 (GFC_INTEGER_4 *, GFC_INTEGER_4 *); +export_proto(kill_i4); + +GFC_INTEGER_4 +kill_i4 (GFC_INTEGER_4 *pid, GFC_INTEGER_4 *signal) +{ + GFC_INTEGER_4 val; + kill_i4_sub (pid, signal, &val); + return val; +} + +extern GFC_INTEGER_8 kill_i8 (GFC_INTEGER_8 *, GFC_INTEGER_8 *); +export_proto(kill_i8); + +GFC_INTEGER_8 +kill_i8 (GFC_INTEGER_8 *pid, GFC_INTEGER_8 *signal) +{ + GFC_INTEGER_8 val; + kill_i8_sub (pid, signal, &val); + return val; +} +#endif diff --git a/libgfortran/intrinsics/link.c b/libgfortran/intrinsics/link.c new file mode 100644 index 000000000..21bae400a --- /dev/null +++ b/libgfortran/intrinsics/link.c @@ -0,0 +1,131 @@ +/* Implementation of the LINK intrinsic. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +#ifdef HAVE_UNISTD_H +#include +#endif + +/* SUBROUTINE LINK(PATH1, PATH2, STATUS) + CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2 + INTEGER, INTENT(OUT), OPTIONAL :: STATUS */ + +#ifdef HAVE_LINK +extern void link_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type, + gfc_charlen_type); +iexport_proto(link_i4_sub); + +void +link_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status, + gfc_charlen_type path1_len, gfc_charlen_type path2_len) +{ + int val; + char *str1, *str2; + + /* Trim trailing spaces from paths. */ + while (path1_len > 0 && path1[path1_len - 1] == ' ') + path1_len--; + while (path2_len > 0 && path2[path2_len - 1] == ' ') + path2_len--; + + /* Make a null terminated copy of the strings. */ + str1 = gfc_alloca (path1_len + 1); + memcpy (str1, path1, path1_len); + str1[path1_len] = '\0'; + + str2 = gfc_alloca (path2_len + 1); + memcpy (str2, path2, path2_len); + str2[path2_len] = '\0'; + + val = link (str1, str2); + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(link_i4_sub); + +extern void link_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type, + gfc_charlen_type); +iexport_proto(link_i8_sub); + +void +link_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status, + gfc_charlen_type path1_len, gfc_charlen_type path2_len) +{ + int val; + char *str1, *str2; + + /* Trim trailing spaces from paths. */ + while (path1_len > 0 && path1[path1_len - 1] == ' ') + path1_len--; + while (path2_len > 0 && path2[path2_len - 1] == ' ') + path2_len--; + + /* Make a null terminated copy of the strings. */ + str1 = gfc_alloca (path1_len + 1); + memcpy (str1, path1, path1_len); + str1[path1_len] = '\0'; + + str2 = gfc_alloca (path2_len + 1); + memcpy (str2, path2, path2_len); + str2[path2_len] = '\0'; + + val = link (str1, str2); + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(link_i8_sub); + +extern GFC_INTEGER_4 link_i4 (char *, char *, gfc_charlen_type, + gfc_charlen_type); +export_proto(link_i4); + +GFC_INTEGER_4 +link_i4 (char *path1, char *path2, gfc_charlen_type path1_len, + gfc_charlen_type path2_len) +{ + GFC_INTEGER_4 val; + link_i4_sub (path1, path2, &val, path1_len, path2_len); + return val; +} + +extern GFC_INTEGER_8 link_i8 (char *, char *, gfc_charlen_type, + gfc_charlen_type); +export_proto(link_i8); + +GFC_INTEGER_8 +link_i8 (char *path1, char *path2, gfc_charlen_type path1_len, + gfc_charlen_type path2_len) +{ + GFC_INTEGER_8 val; + link_i8_sub (path1, path2, &val, path1_len, path2_len); + return val; +} +#endif diff --git a/libgfortran/intrinsics/malloc.c b/libgfortran/intrinsics/malloc.c new file mode 100644 index 000000000..19001aef8 --- /dev/null +++ b/libgfortran/intrinsics/malloc.c @@ -0,0 +1,49 @@ +/* Implementation of the MALLOC and FREE intrinsics + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#ifdef HAVE_STDLIB_H +#include +#endif + +extern void PREFIX(free) (void **); +export_proto_np(PREFIX(free)); + +void +PREFIX(free) (void ** ptr) +{ + free (*ptr); +} + + +extern void * PREFIX(malloc) (size_t *); +export_proto_np(PREFIX(malloc)); + +void * +PREFIX(malloc) (size_t * size) +{ + return malloc (*size); +} diff --git a/libgfortran/intrinsics/move_alloc.c b/libgfortran/intrinsics/move_alloc.c new file mode 100644 index 000000000..9b5497c9b --- /dev/null +++ b/libgfortran/intrinsics/move_alloc.c @@ -0,0 +1,69 @@ +/* Generic implementation of the MOVE_ALLOC intrinsic + Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Paul Thomas + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#ifdef HAVE_STDLIB_H +#include +#endif + +extern void move_alloc (gfc_array_char *, gfc_array_char *); +export_proto(move_alloc); + +void +move_alloc (gfc_array_char * from, gfc_array_char * to) +{ + int i; + + if (to->data) + free (to->data); + + for (i = 0; i < GFC_DESCRIPTOR_RANK (from); i++) + { + GFC_DIMENSION_SET(to->dim[i],GFC_DESCRIPTOR_LBOUND(from,i), + GFC_DESCRIPTOR_UBOUND(from,i), + GFC_DESCRIPTOR_STRIDE(from,i)); + GFC_DIMENSION_SET(from->dim[i],GFC_DESCRIPTOR_LBOUND(from,i), + GFC_DESCRIPTOR_LBOUND(from,i), 0); + } + + to->offset = from->offset; + to->dtype = from->dtype; + to->data = from->data; + from->data = NULL; +} + +extern void move_alloc_c (gfc_array_char *, GFC_INTEGER_4, + gfc_array_char *, GFC_INTEGER_4); +export_proto(move_alloc_c); + +void +move_alloc_c (gfc_array_char * from, + GFC_INTEGER_4 from_length __attribute__((unused)), + gfc_array_char * to, + GFC_INTEGER_4 to_length __attribute__((unused))) +{ + move_alloc (from, to); +} diff --git a/libgfortran/intrinsics/mvbits.c b/libgfortran/intrinsics/mvbits.c new file mode 100644 index 000000000..7c45bfa41 --- /dev/null +++ b/libgfortran/intrinsics/mvbits.c @@ -0,0 +1,86 @@ +/* Implementation of the MVBITS intrinsic + Copyright (C) 2004, 2006, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +/* TODO: This should be replaced by a compiler builtin. */ + +#ifndef SUB_NAME +#include +#endif + +#ifdef SUB_NAME +/* MVBITS copies LEN bits starting at bit position FROMPOS from FROM + into TO, starting at bit position TOPOS. */ + +extern void SUB_NAME (const TYPE *, const int *, const int *, TYPE *, + const int *); +export_proto(SUB_NAME); + +void +SUB_NAME (const TYPE *from, const int *frompos, const int *len, TYPE *to, + const int *topos) +{ + TYPE oldbits, newbits, lenmask; + + lenmask = (*len == sizeof (TYPE)*8) ? ~(TYPE)0 : ((TYPE)1 << *len) - 1; + newbits = (((UTYPE)(*from) >> *frompos) & lenmask) << *topos; + oldbits = *to & (~(lenmask << *topos)); + + *to = newbits | oldbits; +} +#endif + +#ifndef SUB_NAME +# define TYPE GFC_INTEGER_1 +# define UTYPE GFC_UINTEGER_1 +# define SUB_NAME mvbits_i1 +# include "mvbits.c" +# undef SUB_NAME +# undef TYPE +# undef UTYPE + +# define TYPE GFC_INTEGER_2 +# define UTYPE GFC_UINTEGER_2 +# define SUB_NAME mvbits_i2 +# include "mvbits.c" +# undef SUB_NAME +# undef TYPE +# undef UTYPE + +# define TYPE GFC_INTEGER_4 +# define UTYPE GFC_UINTEGER_4 +# define SUB_NAME mvbits_i4 +# include "mvbits.c" +# undef SUB_NAME +# undef TYPE +# undef UTYPE + +# define TYPE GFC_INTEGER_8 +# define UTYPE GFC_UINTEGER_8 +# define SUB_NAME mvbits_i8 +# include "mvbits.c" +# undef SUB_NAME +# undef TYPE +# undef UTYPE +#endif diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c new file mode 100644 index 000000000..c15bdd08f --- /dev/null +++ b/libgfortran/intrinsics/pack_generic.c @@ -0,0 +1,649 @@ +/* Generic implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2009, 2010 + 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +static void +pack_internal (gfc_array_char *ret, const gfc_array_char *array, + const gfc_array_l1 *mask, const gfc_array_char *vector, + index_type size) +{ + /* r.* indicates the return array. */ + index_type rstride0; + char * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const char *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + sptr = array->data; + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Don't convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = size; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + } + else + { + /* We have to count the true elements in MASK. */ + + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (size * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0); + if (rstride0 == 0) + rstride0 = size; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + memcpy (rptr, sptr, size); + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0); + if (sstride0 == 0) + sstride0 = size; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + memcpy (rptr, sptr, size); + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +extern void pack (gfc_array_char *, const gfc_array_char *, + const gfc_array_l1 *, const gfc_array_char *); +export_proto(pack); + +void +pack (gfc_array_char *ret, const gfc_array_char *array, + const gfc_array_l1 *mask, const gfc_array_char *vector) +{ + index_type type_size; + index_type size; + + type_size = GFC_DTYPE_TYPE_SIZE(array); + + switch(type_size) + { + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_INTEGER_1: + case GFC_DTYPE_DERIVED_1: + pack_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) array, + (gfc_array_l1 *) mask, (gfc_array_i1 *) vector); + return; + + case GFC_DTYPE_LOGICAL_2: + case GFC_DTYPE_INTEGER_2: + pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array, + (gfc_array_l1 *) mask, (gfc_array_i2 *) vector); + return; + + case GFC_DTYPE_LOGICAL_4: + case GFC_DTYPE_INTEGER_4: + pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array, + (gfc_array_l1 *) mask, (gfc_array_i4 *) vector); + return; + + case GFC_DTYPE_LOGICAL_8: + case GFC_DTYPE_INTEGER_8: + pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array, + (gfc_array_l1 *) mask, (gfc_array_i8 *) vector); + return; + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_LOGICAL_16: + case GFC_DTYPE_INTEGER_16: + pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array, + (gfc_array_l1 *) mask, (gfc_array_i16 *) vector); + return; +#endif + + case GFC_DTYPE_REAL_4: + pack_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) array, + (gfc_array_l1 *) mask, (gfc_array_r4 *) vector); + return; + + case GFC_DTYPE_REAL_8: + pack_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) array, + (gfc_array_l1 *) mask, (gfc_array_r8 *) vector); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef HAVE_GFC_REAL_10 + case GFC_DTYPE_REAL_10: + pack_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) array, + (gfc_array_l1 *) mask, (gfc_array_r10 *) vector); + return; +# endif + +# ifdef HAVE_GFC_REAL_16 + case GFC_DTYPE_REAL_16: + pack_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) array, + (gfc_array_l1 *) mask, (gfc_array_r16 *) vector); + return; +# endif +#endif + + case GFC_DTYPE_COMPLEX_4: + pack_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) array, + (gfc_array_l1 *) mask, (gfc_array_c4 *) vector); + return; + + case GFC_DTYPE_COMPLEX_8: + pack_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) array, + (gfc_array_l1 *) mask, (gfc_array_c8 *) vector); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef HAVE_GFC_COMPLEX_10 + case GFC_DTYPE_COMPLEX_10: + pack_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) array, + (gfc_array_l1 *) mask, (gfc_array_c10 *) vector); + return; +# endif + +# ifdef HAVE_GFC_COMPLEX_16 + case GFC_DTYPE_COMPLEX_16: + pack_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) array, + (gfc_array_l1 *) mask, (gfc_array_c16 *) vector); + return; +# endif +#endif + + /* For derived types, let's check the actual alignment of the + data pointers. If they are aligned, we can safely call + the unpack functions. */ + + case GFC_DTYPE_DERIVED_2: + if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(array->data) + || (vector && GFC_UNALIGNED_2(vector->data))) + break; + else + { + pack_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) array, + (gfc_array_l1 *) mask, (gfc_array_i2 *) vector); + return; + } + + case GFC_DTYPE_DERIVED_4: + if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(array->data) + || (vector && GFC_UNALIGNED_4(vector->data))) + break; + else + { + pack_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) array, + (gfc_array_l1 *) mask, (gfc_array_i4 *) vector); + return; + } + + case GFC_DTYPE_DERIVED_8: + if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(array->data) + || (vector && GFC_UNALIGNED_8(vector->data))) + break; + else + { + pack_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) array, + (gfc_array_l1 *) mask, (gfc_array_i8 *) vector); + return; + } + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_DERIVED_16: + if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(array->data) + || (vector && GFC_UNALIGNED_16(vector->data))) + break; + else + { + pack_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) array, + (gfc_array_l1 *) mask, (gfc_array_i16 *) vector); + return; + } +#endif + + } + + size = GFC_DESCRIPTOR_SIZE (array); + pack_internal (ret, array, mask, vector, size); +} + + +extern void pack_char (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *, + const gfc_array_l1 *, const gfc_array_char *, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(pack_char); + +void +pack_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const gfc_array_l1 *mask, + const gfc_array_char *vector, GFC_INTEGER_4 array_length, + GFC_INTEGER_4 vector_length __attribute__((unused))) +{ + pack_internal (ret, array, mask, vector, array_length); +} + + +extern void pack_char4 (gfc_array_char *, GFC_INTEGER_4, const gfc_array_char *, + const gfc_array_l1 *, const gfc_array_char *, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(pack_char4); + +void +pack_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const gfc_array_l1 *mask, + const gfc_array_char *vector, GFC_INTEGER_4 array_length, + GFC_INTEGER_4 vector_length __attribute__((unused))) +{ + pack_internal (ret, array, mask, vector, array_length * sizeof (gfc_char4_t)); +} + + +static void +pack_s_internal (gfc_array_char *ret, const gfc_array_char *array, + const GFC_LOGICAL_4 *mask, const gfc_array_char *vector, + index_type size) +{ + /* r.* indicates the return array. */ + index_type rstride0; + char *rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const char *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ssize; + index_type nelem; + index_type total; + + dim = GFC_DESCRIPTOR_RANK (array); + ssize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] < 0) + extent[n] = 0; + + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + ssize *= extent[n]; + } + if (sstride[0] == 0) + sstride[0] = size; + + sstride0 = sstride[0]; + + if (ssize != 0) + sptr = array->data; + else + sptr = NULL; + + if (ret->data == NULL) + { + /* Allocate the memory for the result. */ + + if (vector != NULL) + { + /* The return array will have as many elements as there are + in vector. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total <= 0) + { + total = 0; + vector = NULL; + } + } + else + { + if (*mask) + { + /* The result array will have as many elements as the input + array. */ + total = extent[0]; + for (n = 1; n < dim; n++) + total *= extent[n]; + } + else + /* The result array will be empty. */ + total = 0; + } + + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0],0,total-1,1); + + ret->offset = 0; + + if (total == 0) + { + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (size * total); + } + + rstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0); + if (rstride0 == 0) + rstride0 = size; + rptr = ret->data; + + /* The remaining possibilities are now: + If MASK is .TRUE., we have to copy the source array into the + result array. We then have to fill it up with elements from VECTOR. + If MASK is .FALSE., we have to copy VECTOR into the result + array. If VECTOR were not present we would have already returned. */ + + if (*mask && ssize != 0) + { + while (sptr) + { + /* Add this element. */ + memcpy (rptr, sptr, size); + rptr += rstride0; + + /* Advance to the next element. */ + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and + increment the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a + less frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + } + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0); + if (sstride0 == 0) + sstride0 = size; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + memcpy (rptr, sptr, size); + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +extern void pack_s (gfc_array_char *ret, const gfc_array_char *array, + const GFC_LOGICAL_4 *, const gfc_array_char *); +export_proto(pack_s); + +void +pack_s (gfc_array_char *ret, const gfc_array_char *array, + const GFC_LOGICAL_4 *mask, const gfc_array_char *vector) +{ + pack_s_internal (ret, array, mask, vector, GFC_DESCRIPTOR_SIZE (array)); +} + + +extern void pack_s_char (gfc_array_char *ret, GFC_INTEGER_4, + const gfc_array_char *array, const GFC_LOGICAL_4 *, + const gfc_array_char *, GFC_INTEGER_4, + GFC_INTEGER_4); +export_proto(pack_s_char); + +void +pack_s_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const GFC_LOGICAL_4 *mask, + const gfc_array_char *vector, GFC_INTEGER_4 array_length, + GFC_INTEGER_4 vector_length __attribute__((unused))) +{ + pack_s_internal (ret, array, mask, vector, array_length); +} + + +extern void pack_s_char4 (gfc_array_char *ret, GFC_INTEGER_4, + const gfc_array_char *array, const GFC_LOGICAL_4 *, + const gfc_array_char *, GFC_INTEGER_4, + GFC_INTEGER_4); +export_proto(pack_s_char4); + +void +pack_s_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *array, const GFC_LOGICAL_4 *mask, + const gfc_array_char *vector, GFC_INTEGER_4 array_length, + GFC_INTEGER_4 vector_length __attribute__((unused))) +{ + pack_s_internal (ret, array, mask, vector, + array_length * sizeof (gfc_char4_t)); +} diff --git a/libgfortran/intrinsics/perror.c b/libgfortran/intrinsics/perror.c new file mode 100644 index 000000000..10348bd08 --- /dev/null +++ b/libgfortran/intrinsics/perror.c @@ -0,0 +1,55 @@ +/* Implementation of the PERROR intrinsic. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +/* SUBROUTINE PERROR(STRING) + CHARACTER(len=*), INTENT(IN) :: STRING */ + +#ifdef HAVE_PERROR +extern void perror_sub (char *, gfc_charlen_type); +iexport_proto(perror_sub); + +void +perror_sub (char *string, gfc_charlen_type string_len) +{ + char * str; + + /* Trim trailing spaces from paths. */ + while (string_len > 0 && string[string_len - 1] == ' ') + string_len--; + + /* Make a null terminated copy of the strings. */ + str = gfc_alloca (string_len + 1); + memcpy (str, string, string_len); + str[string_len] = '\0'; + + perror (str); +} +iexport(perror_sub); +#endif diff --git a/libgfortran/intrinsics/rand.c b/libgfortran/intrinsics/rand.c new file mode 100644 index 000000000..369feaeaf --- /dev/null +++ b/libgfortran/intrinsics/rand.c @@ -0,0 +1,136 @@ +/* Implementation of the IRAND, RAND, and SRAND intrinsics. + Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +/* Simple multiplicative congruent algorithm. + The period of this generator is approximately 2^31-1, which means that + it should not be used for anything serious. The implementation here + is based of an algorithm from S.K. Park and K.W. Miller, Comm. ACM, + 31, 1192-1201 (1988). It is also provided solely for compatibility + with G77. */ + +#include "libgfortran.h" +#include + +#define GFC_RAND_A 16807 +#define GFC_RAND_M 2147483647 +#define GFC_RAND_M1 (GFC_RAND_M - 1) + +static GFC_UINTEGER_8 rand_seed = 1; +#ifdef __GTHREAD_MUTEX_INIT +static __gthread_mutex_t rand_seed_lock = __GTHREAD_MUTEX_INIT; +#else +static __gthread_mutex_t rand_seed_lock; +#endif + + +/* Set the seed of the irand generator. Note 0 is a bad seed. */ + +static void +srand_internal (GFC_INTEGER_8 i) +{ + rand_seed = i ? i : 123459876; +} + +extern void PREFIX(srand) (GFC_INTEGER_4 *i); +export_proto_np(PREFIX(srand)); + +void +PREFIX(srand) (GFC_INTEGER_4 *i) +{ + __gthread_mutex_lock (&rand_seed_lock); + srand_internal (*i); + __gthread_mutex_unlock (&rand_seed_lock); +} + +/* Return an INTEGER in the range [1,GFC_RAND_M-1]. */ + +extern GFC_INTEGER_4 irand (GFC_INTEGER_4 *); +iexport_proto(irand); + +GFC_INTEGER_4 +irand (GFC_INTEGER_4 *i) +{ + GFC_INTEGER_4 j; + if (i) + j = *i; + else + j = 0; + + __gthread_mutex_lock (&rand_seed_lock); + + switch (j) + { + /* Return the next RN. */ + case 0: + break; + + /* Reset the RN sequence to system-dependent sequence and return the + first value. */ + case 1: + srand_internal (0); + break; + + /* Seed the RN sequence with j and return the first value. */ + default: + srand_internal (j); + break; + } + + rand_seed = GFC_RAND_A * rand_seed % GFC_RAND_M; + j = (GFC_INTEGER_4) rand_seed; + + __gthread_mutex_unlock (&rand_seed_lock); + + return j; +} +iexport(irand); + + +/* Return a random REAL in the range [0,1). */ + +extern GFC_REAL_4 PREFIX(rand) (GFC_INTEGER_4 *i); +export_proto_np(PREFIX(rand)); + +GFC_REAL_4 +PREFIX(rand) (GFC_INTEGER_4 *i) +{ + GFC_UINTEGER_4 mask; +#if GFC_REAL_4_RADIX == 2 + mask = ~ (GFC_UINTEGER_4) 0u << (32 - GFC_REAL_4_DIGITS + 1); +#elif GFC_REAL_4_RADIX == 16 + mask = ~ (GFC_UINTEGER_4) 0u << ((8 - GFC_REAL_4_DIGITS) * 4 + 1); +#else +#error "GFC_REAL_4_RADIX has unknown value" +#endif + return ((GFC_UINTEGER_4) (irand(i) -1) & mask) * (GFC_REAL_4) 0x1.p-31f; +} + +#ifndef __GTHREAD_MUTEX_INIT +static void __attribute__((constructor)) +init (void) +{ + __GTHREAD_MUTEX_INIT_FUNCTION (&rand_seed_lock); +} +#endif diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c new file mode 100644 index 000000000..8c16b855d --- /dev/null +++ b/libgfortran/intrinsics/random.c @@ -0,0 +1,798 @@ +/* Implementation of the RANDOM intrinsics + Copyright 2002, 2004, 2005, 2006, 2007, 2009, 2010 + Free Software Foundation, Inc. + Contributed by Lars Segerlund + and Steve Kargl. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include + +extern void random_r4 (GFC_REAL_4 *); +iexport_proto(random_r4); + +extern void random_r8 (GFC_REAL_8 *); +iexport_proto(random_r8); + +extern void arandom_r4 (gfc_array_r4 *); +export_proto(arandom_r4); + +extern void arandom_r8 (gfc_array_r8 *); +export_proto(arandom_r8); + +#ifdef HAVE_GFC_REAL_10 + +extern void random_r10 (GFC_REAL_10 *); +iexport_proto(random_r10); + +extern void arandom_r10 (gfc_array_r10 *); +export_proto(arandom_r10); + +#endif + +#ifdef HAVE_GFC_REAL_16 + +extern void random_r16 (GFC_REAL_16 *); +iexport_proto(random_r16); + +extern void arandom_r16 (gfc_array_r16 *); +export_proto(arandom_r16); + +#endif + +#ifdef __GTHREAD_MUTEX_INIT +static __gthread_mutex_t random_lock = __GTHREAD_MUTEX_INIT; +#else +static __gthread_mutex_t random_lock; +#endif + +/* Helper routines to map a GFC_UINTEGER_* to the corresponding + GFC_REAL_* types in the range of [0,1). If GFC_REAL_*_RADIX are 2 + or 16, respectively, we mask off the bits that don't fit into the + correct GFC_REAL_*, convert to the real type, then multiply by the + correct offset. */ + + +static inline void +rnumber_4 (GFC_REAL_4 *f, GFC_UINTEGER_4 v) +{ + GFC_UINTEGER_4 mask; +#if GFC_REAL_4_RADIX == 2 + mask = ~ (GFC_UINTEGER_4) 0u << (32 - GFC_REAL_4_DIGITS); +#elif GFC_REAL_4_RADIX == 16 + mask = ~ (GFC_UINTEGER_4) 0u << ((8 - GFC_REAL_4_DIGITS) * 4); +#else +#error "GFC_REAL_4_RADIX has unknown value" +#endif + v = v & mask; + *f = (GFC_REAL_4) v * GFC_REAL_4_LITERAL(0x1.p-32); +} + +static inline void +rnumber_8 (GFC_REAL_8 *f, GFC_UINTEGER_8 v) +{ + GFC_UINTEGER_8 mask; +#if GFC_REAL_8_RADIX == 2 + mask = ~ (GFC_UINTEGER_8) 0u << (64 - GFC_REAL_8_DIGITS); +#elif GFC_REAL_8_RADIX == 16 + mask = ~ (GFC_UINTEGER_8) 0u << (16 - GFC_REAL_8_DIGITS) * 4); +#else +#error "GFC_REAL_8_RADIX has unknown value" +#endif + v = v & mask; + *f = (GFC_REAL_8) v * GFC_REAL_8_LITERAL(0x1.p-64); +} + +#ifdef HAVE_GFC_REAL_10 + +static inline void +rnumber_10 (GFC_REAL_10 *f, GFC_UINTEGER_8 v) +{ + GFC_UINTEGER_8 mask; +#if GFC_REAL_10_RADIX == 2 + mask = ~ (GFC_UINTEGER_8) 0u << (64 - GFC_REAL_10_DIGITS); +#elif GFC_REAL_10_RADIX == 16 + mask = ~ (GFC_UINTEGER_10) 0u << ((16 - GFC_REAL_10_DIGITS) * 4); +#else +#error "GFC_REAL_10_RADIX has unknown value" +#endif + v = v & mask; + *f = (GFC_REAL_10) v * GFC_REAL_10_LITERAL(0x1.p-64); +} +#endif + +#ifdef HAVE_GFC_REAL_16 + +/* For REAL(KIND=16), we only need to mask off the lower bits. */ + +static inline void +rnumber_16 (GFC_REAL_16 *f, GFC_UINTEGER_8 v1, GFC_UINTEGER_8 v2) +{ + GFC_UINTEGER_8 mask; +#if GFC_REAL_16_RADIX == 2 + mask = ~ (GFC_UINTEGER_8) 0u << (128 - GFC_REAL_16_DIGITS); +#elif GFC_REAL_16_RADIX == 16 + mask = ~ (GFC_UINTEGER_8) 0u << ((32 - GFC_REAL_16_DIGITS) * 4); +#else +#error "GFC_REAL_16_RADIX has unknown value" +#endif + v2 = v2 & mask; + *f = (GFC_REAL_16) v1 * GFC_REAL_16_LITERAL(0x1.p-64) + + (GFC_REAL_16) v2 * GFC_REAL_16_LITERAL(0x1.p-128); +} +#endif +/* libgfortran previously had a Mersenne Twister, taken from the paper: + + Mersenne Twister: 623-dimensionally equidistributed + uniform pseudorandom generator. + + by Makoto Matsumoto & Takuji Nishimura + which appeared in the: ACM Transactions on Modelling and Computer + Simulations: Special Issue on Uniform Random Number + Generation. ( Early in 1998 ). + + The Mersenne Twister code was replaced due to + + (1) Simple user specified seeds lead to really bad sequences for + nearly 100000 random numbers. + (2) open(), read(), and close() were not properly declared via header + files. + (3) The global index i was abused and caused unexpected behavior with + GET and PUT. + (4) See PR 15619. + + + libgfortran currently uses George Marsaglia's KISS (Keep It Simple Stupid) + random number generator. This PRNG combines: + + (1) The congruential generator x(n)=69069*x(n-1)+1327217885 with a period + of 2^32, + (2) A 3-shift shift-register generator with a period of 2^32-1, + (3) Two 16-bit multiply-with-carry generators with a period of + 597273182964842497 > 2^59. + + The overall period exceeds 2^123. + + http://www.ciphersbyritter.com/NEWS4/RANDC.HTM#369F6FCA.74C7C041@stat.fsu.edu + + The above web site has an archive of a newsgroup posting from George + Marsaglia with the statement: + + Subject: Random numbers for C: Improvements. + Date: Fri, 15 Jan 1999 11:41:47 -0500 + From: George Marsaglia + Message-ID: <369F6FCA.74C7C041@stat.fsu.edu> + References: <369B5E30.65A55FD1@stat.fsu.edu> + Newsgroups: sci.stat.math,sci.math,sci.math.numer-analysis + Lines: 93 + + As I hoped, several suggestions have led to + improvements in the code for RNG's I proposed for + use in C. (See the thread "Random numbers for C: Some + suggestions" in previous postings.) The improved code + is listed below. + + A question of copyright has also been raised. Unlike + DIEHARD, there is no copyright on the code below. You + are free to use it in any way you want, but you may + wish to acknowledge the source, as a courtesy. + +"There is no copyright on the code below." included the original +KISS algorithm. */ + +/* We use three KISS random number generators, with different + seeds. + As a matter of Quality of Implementation, the random numbers + we generate for different REAL kinds, starting from the same + seed, are always the same up to the precision of these types. + We do this by using three generators with different seeds, the + first one always for the most significant bits, the second one + for bits 33..64 (if present in the REAL kind), and the third one + (called twice) for REAL(16). */ + +#define GFC_SL(k, n) ((k)^((k)<<(n))) +#define GFC_SR(k, n) ((k)^((k)>>(n))) + +/* Reference for the seed: + From: "George Marsaglia" + Newsgroups: sci.math + Message-ID: + + The KISS RNG uses four seeds, x, y, z, c, + with 0<=x<2^32, 0> 16); + seed[3] = 30903 * (seed[3] & 65535) + (seed[3] >> 16); + kiss = seed[0] + seed[1] + (seed[2] << 16) + seed[3]; + + return kiss; +} + +/* This function produces a REAL(4) value from the uniform distribution + with range [0,1). */ + +void +random_r4 (GFC_REAL_4 *x) +{ + GFC_UINTEGER_4 kiss; + + __gthread_mutex_lock (&random_lock); + kiss = kiss_random_kernel (kiss_seed_1); + rnumber_4 (x, kiss); + __gthread_mutex_unlock (&random_lock); +} +iexport(random_r4); + +/* This function produces a REAL(8) value from the uniform distribution + with range [0,1). */ + +void +random_r8 (GFC_REAL_8 *x) +{ + GFC_UINTEGER_8 kiss; + + __gthread_mutex_lock (&random_lock); + kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32; + kiss += kiss_random_kernel (kiss_seed_2); + rnumber_8 (x, kiss); + __gthread_mutex_unlock (&random_lock); +} +iexport(random_r8); + +#ifdef HAVE_GFC_REAL_10 + +/* This function produces a REAL(10) value from the uniform distribution + with range [0,1). */ + +void +random_r10 (GFC_REAL_10 *x) +{ + GFC_UINTEGER_8 kiss; + + __gthread_mutex_lock (&random_lock); + kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32; + kiss += kiss_random_kernel (kiss_seed_2); + rnumber_10 (x, kiss); + __gthread_mutex_unlock (&random_lock); +} +iexport(random_r10); + +#endif + +/* This function produces a REAL(16) value from the uniform distribution + with range [0,1). */ + +#ifdef HAVE_GFC_REAL_16 + +void +random_r16 (GFC_REAL_16 *x) +{ + GFC_UINTEGER_8 kiss1, kiss2; + + __gthread_mutex_lock (&random_lock); + kiss1 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32; + kiss1 += kiss_random_kernel (kiss_seed_2); + + kiss2 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_3)) << 32; + kiss2 += kiss_random_kernel (kiss_seed_3); + + rnumber_16 (x, kiss1, kiss2); + __gthread_mutex_unlock (&random_lock); +} +iexport(random_r16); + + +#endif +/* This function fills a REAL(4) array with values from the uniform + distribution with range [0,1). */ + +void +arandom_r4 (gfc_array_r4 *x) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + GFC_REAL_4 *dest; + GFC_UINTEGER_4 kiss; + int n; + + dest = x->data; + + dim = GFC_DESCRIPTOR_RANK (x); + + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); + if (extent[n] <= 0) + return; + } + + stride0 = stride[0]; + + __gthread_mutex_lock (&random_lock); + + while (dest) + { + /* random_r4 (dest); */ + kiss = kiss_random_kernel (kiss_seed_1); + rnumber_4 (dest, kiss); + + /* 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 probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + __gthread_mutex_unlock (&random_lock); +} + +/* This function fills a REAL(8) array with values from the uniform + distribution with range [0,1). */ + +void +arandom_r8 (gfc_array_r8 *x) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + GFC_REAL_8 *dest; + GFC_UINTEGER_8 kiss; + int n; + + dest = x->data; + + dim = GFC_DESCRIPTOR_RANK (x); + + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); + if (extent[n] <= 0) + return; + } + + stride0 = stride[0]; + + __gthread_mutex_lock (&random_lock); + + while (dest) + { + /* random_r8 (dest); */ + kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32; + kiss += kiss_random_kernel (kiss_seed_2); + rnumber_8 (dest, kiss); + + /* 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 probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + __gthread_mutex_unlock (&random_lock); +} + +#ifdef HAVE_GFC_REAL_10 + +/* This function fills a REAL(10) array with values from the uniform + distribution with range [0,1). */ + +void +arandom_r10 (gfc_array_r10 *x) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + GFC_REAL_10 *dest; + GFC_UINTEGER_8 kiss; + int n; + + dest = x->data; + + dim = GFC_DESCRIPTOR_RANK (x); + + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); + if (extent[n] <= 0) + return; + } + + stride0 = stride[0]; + + __gthread_mutex_lock (&random_lock); + + while (dest) + { + /* random_r10 (dest); */ + kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32; + kiss += kiss_random_kernel (kiss_seed_2); + rnumber_10 (dest, kiss); + + /* 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 probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + __gthread_mutex_unlock (&random_lock); +} + +#endif + +#ifdef HAVE_GFC_REAL_16 + +/* This function fills a REAL(16) array with values from the uniform + distribution with range [0,1). */ + +void +arandom_r16 (gfc_array_r16 *x) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0; + index_type dim; + GFC_REAL_16 *dest; + GFC_UINTEGER_8 kiss1, kiss2; + int n; + + dest = x->data; + + dim = GFC_DESCRIPTOR_RANK (x); + + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(x,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(x,n); + if (extent[n] <= 0) + return; + } + + stride0 = stride[0]; + + __gthread_mutex_lock (&random_lock); + + while (dest) + { + /* random_r16 (dest); */ + kiss1 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32; + kiss1 += kiss_random_kernel (kiss_seed_2); + + kiss2 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_3)) << 32; + kiss2 += kiss_random_kernel (kiss_seed_3); + + rnumber_16 (dest, kiss1, kiss2); + + /* 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 probably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } + __gthread_mutex_unlock (&random_lock); +} + +#endif + + + +static void +scramble_seed (unsigned char *dest, unsigned char *src, int size) +{ + int i; + + for (i = 0; i < size; i++) + dest[(i % 2) * (size / 2) + i / 2] = src[i]; +} + + +static void +unscramble_seed (unsigned char *dest, unsigned char *src, int size) +{ + int i; + + for (i = 0; i < size; i++) + dest[i] = src[(i % 2) * (size / 2) + i / 2]; +} + + + +/* random_seed is used to seed the PRNG with either a default + set of seeds or user specified set of seeds. random_seed + must be called with no argument or exactly one argument. */ + +void +random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get) +{ + int i; + unsigned char seed[4*kiss_size]; + + __gthread_mutex_lock (&random_lock); + + /* Check that we only have one argument present. */ + if ((size ? 1 : 0) + (put ? 1 : 0) + (get ? 1 : 0) > 1) + runtime_error ("RANDOM_SEED should have at most one argument present."); + + /* From the standard: "If no argument is present, the processor assigns + a processor-dependent value to the seed." */ + if (size == NULL && put == NULL && get == NULL) + for (i = 0; i < kiss_size; i++) + kiss_seed[i] = kiss_default_seed[i]; + + if (size != NULL) + *size = kiss_size; + + if (put != NULL) + { + /* If the rank of the array is not 1, abort. */ + if (GFC_DESCRIPTOR_RANK (put) != 1) + runtime_error ("Array rank of PUT is not 1."); + + /* If the array is too small, abort. */ + if (GFC_DESCRIPTOR_EXTENT(put,0) < kiss_size) + runtime_error ("Array size of PUT is too small."); + + /* We copy the seed given by the user. */ + for (i = 0; i < kiss_size; i++) + memcpy (seed + i * sizeof(GFC_UINTEGER_4), + &(put->data[(kiss_size - 1 - i) * GFC_DESCRIPTOR_STRIDE(put,0)]), + sizeof(GFC_UINTEGER_4)); + + /* We put it after scrambling the bytes, to paper around users who + provide seeds with quality only in the lower or upper part. */ + scramble_seed ((unsigned char *) kiss_seed, seed, 4*kiss_size); + } + + /* Return the seed to GET data. */ + if (get != NULL) + { + /* If the rank of the array is not 1, abort. */ + if (GFC_DESCRIPTOR_RANK (get) != 1) + runtime_error ("Array rank of GET is not 1."); + + /* If the array is too small, abort. */ + if (GFC_DESCRIPTOR_EXTENT(get,0) < kiss_size) + runtime_error ("Array size of GET is too small."); + + /* Unscramble the seed. */ + unscramble_seed (seed, (unsigned char *) kiss_seed, 4*kiss_size); + + /* Then copy it back to the user variable. */ + for (i = 0; i < kiss_size; i++) + memcpy (&(get->data[(kiss_size - 1 - i) * GFC_DESCRIPTOR_STRIDE(get,0)]), + seed + i * sizeof(GFC_UINTEGER_4), + sizeof(GFC_UINTEGER_4)); + } + + __gthread_mutex_unlock (&random_lock); +} +iexport(random_seed_i4); + + +void +random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get) +{ + int i; + + __gthread_mutex_lock (&random_lock); + + /* Check that we only have one argument present. */ + if ((size ? 1 : 0) + (put ? 1 : 0) + (get ? 1 : 0) > 1) + runtime_error ("RANDOM_SEED should have at most one argument present."); + + /* From the standard: "If no argument is present, the processor assigns + a processor-dependent value to the seed." */ + if (size == NULL && put == NULL && get == NULL) + for (i = 0; i < kiss_size; i++) + kiss_seed[i] = kiss_default_seed[i]; + + if (size != NULL) + *size = kiss_size / 2; + + if (put != NULL) + { + /* If the rank of the array is not 1, abort. */ + if (GFC_DESCRIPTOR_RANK (put) != 1) + runtime_error ("Array rank of PUT is not 1."); + + /* If the array is too small, abort. */ + if (GFC_DESCRIPTOR_EXTENT(put,0) < kiss_size / 2) + runtime_error ("Array size of PUT is too small."); + + /* This code now should do correct strides. */ + for (i = 0; i < kiss_size / 2; i++) + memcpy (&kiss_seed[2*i], &(put->data[i * GFC_DESCRIPTOR_STRIDE(put,0)]), + sizeof (GFC_UINTEGER_8)); + } + + /* Return the seed to GET data. */ + if (get != NULL) + { + /* If the rank of the array is not 1, abort. */ + if (GFC_DESCRIPTOR_RANK (get) != 1) + runtime_error ("Array rank of GET is not 1."); + + /* If the array is too small, abort. */ + if (GFC_DESCRIPTOR_EXTENT(get,0) < kiss_size / 2) + runtime_error ("Array size of GET is too small."); + + /* This code now should do correct strides. */ + for (i = 0; i < kiss_size / 2; i++) + memcpy (&(get->data[i * GFC_DESCRIPTOR_STRIDE(get,0)]), &kiss_seed[2*i], + sizeof (GFC_UINTEGER_8)); + } + + __gthread_mutex_unlock (&random_lock); +} +iexport(random_seed_i8); + + +#ifndef __GTHREAD_MUTEX_INIT +static void __attribute__((constructor)) +init (void) +{ + __GTHREAD_MUTEX_INIT_FUNCTION (&random_lock); +} +#endif diff --git a/libgfortran/intrinsics/rename.c b/libgfortran/intrinsics/rename.c new file mode 100644 index 000000000..0d7dd166b --- /dev/null +++ b/libgfortran/intrinsics/rename.c @@ -0,0 +1,125 @@ +/* Implementation of the RENAME intrinsic. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +/* SUBROUTINE RENAME(PATH1, PATH2, STATUS) + CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2 + INTEGER, INTENT(OUT), OPTIONAL :: STATUS */ + +extern void rename_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type, + gfc_charlen_type); +iexport_proto(rename_i4_sub); + +void +rename_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status, + gfc_charlen_type path1_len, gfc_charlen_type path2_len) +{ + int val; + char *str1, *str2; + + /* Trim trailing spaces from paths. */ + while (path1_len > 0 && path1[path1_len - 1] == ' ') + path1_len--; + while (path2_len > 0 && path2[path2_len - 1] == ' ') + path2_len--; + + /* Make a null terminated copy of the strings. */ + str1 = gfc_alloca (path1_len + 1); + memcpy (str1, path1, path1_len); + str1[path1_len] = '\0'; + + str2 = gfc_alloca (path2_len + 1); + memcpy (str2, path2, path2_len); + str2[path2_len] = '\0'; + + val = rename (str1, str2); + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(rename_i4_sub); + +extern void rename_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type, + gfc_charlen_type); +iexport_proto(rename_i8_sub); + +void +rename_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status, + gfc_charlen_type path1_len, gfc_charlen_type path2_len) +{ + int val; + char *str1, *str2; + + /* Trim trailing spaces from paths. */ + while (path1_len > 0 && path1[path1_len - 1] == ' ') + path1_len--; + while (path2_len > 0 && path2[path2_len - 1] == ' ') + path2_len--; + + /* Make a null terminated copy of the strings. */ + str1 = gfc_alloca (path1_len + 1); + memcpy (str1, path1, path1_len); + str1[path1_len] = '\0'; + + str2 = gfc_alloca (path2_len + 1); + memcpy (str2, path2, path2_len); + str2[path2_len] = '\0'; + + val = rename (str1, str2); + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(rename_i8_sub); + +extern GFC_INTEGER_4 rename_i4 (char *, char *, gfc_charlen_type, + gfc_charlen_type); +export_proto(rename_i4); + +GFC_INTEGER_4 +rename_i4 (char *path1, char *path2, gfc_charlen_type path1_len, + gfc_charlen_type path2_len) +{ + GFC_INTEGER_4 val; + rename_i4_sub (path1, path2, &val, path1_len, path2_len); + return val; +} + +extern GFC_INTEGER_8 rename_i8 (char *, char *, gfc_charlen_type, + gfc_charlen_type); +export_proto(rename_i8); + +GFC_INTEGER_8 +rename_i8 (char *path1, char *path2, gfc_charlen_type path1_len, + gfc_charlen_type path2_len) +{ + GFC_INTEGER_8 val; + rename_i8_sub (path1, path2, &val, path1_len, path2_len); + return val; +} diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c new file mode 100644 index 000000000..bb1552aa4 --- /dev/null +++ b/libgfortran/intrinsics/reshape_generic.c @@ -0,0 +1,379 @@ +/* Generic implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; +typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) parray; + +static void +reshape_internal (parray *ret, parray *source, shape_type *shape, + parray *pad, shape_type *order, index_type size) +{ + /* 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; + char * restrict 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 char *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 char *pptr; + + const char *src; + int n; + int dim; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n],0,rex - 1,rs); + + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * size ); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= size; + ssize *= size; + psize *= size; + reshape_packed (ret->data, rsize, source->data, ssize, + pad ? pad->data : NULL, psize); + return; + } + rptr = ret->data; + src = sptr = source->data; + rstride0 = rstride[0] * size; + sstride0 = sstride[0] * size; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[0] * size; + } + } + + while (rptr) + { + /* Select between the source and pad arrays. */ + memcpy(rptr, src, size); + /* 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 probably not worth it. */ + rptr -= rstride[n] * rextent[n] * size; + n++; + if (n == rdim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + rcount[n]++; + rptr += rstride[n] * size; + } + } + + /* 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 probably not worth it. */ + src -= sstride[n] * sextent[n] * size; + 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] * size; + } + } + /* We now start again from the beginning of the pad array. */ + src = pptr; + break; + } + else + { + scount[n]++; + src += sstride[n] * size; + } + } + } +} + +extern void reshape (parray *, parray *, shape_type *, parray *, shape_type *); +export_proto(reshape); + +void +reshape (parray *ret, parray *source, shape_type *shape, parray *pad, + shape_type *order) +{ + reshape_internal (ret, source, shape, pad, order, + GFC_DESCRIPTOR_SIZE (source)); +} + + +extern void reshape_char (parray *, gfc_charlen_type, parray *, shape_type *, + parray *, shape_type *, gfc_charlen_type, + gfc_charlen_type); +export_proto(reshape_char); + +void +reshape_char (parray *ret, gfc_charlen_type ret_length __attribute__((unused)), + parray *source, shape_type *shape, parray *pad, + shape_type *order, gfc_charlen_type source_length, + gfc_charlen_type pad_length __attribute__((unused))) +{ + reshape_internal (ret, source, shape, pad, order, source_length); +} + + +extern void reshape_char4 (parray *, gfc_charlen_type, parray *, shape_type *, + parray *, shape_type *, gfc_charlen_type, + gfc_charlen_type); +export_proto(reshape_char4); + +void +reshape_char4 (parray *ret, gfc_charlen_type ret_length __attribute__((unused)), + parray *source, shape_type *shape, parray *pad, + shape_type *order, gfc_charlen_type source_length, + gfc_charlen_type pad_length __attribute__((unused))) +{ + reshape_internal (ret, source, shape, pad, order, + source_length * sizeof (gfc_char4_t)); +} diff --git a/libgfortran/intrinsics/reshape_packed.c b/libgfortran/intrinsics/reshape_packed.c new file mode 100644 index 000000000..25cbcf7db --- /dev/null +++ b/libgfortran/intrinsics/reshape_packed.c @@ -0,0 +1,49 @@ +/* Implementation of the RESHAPE intrinsic for packed arrays + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include + +/* Reshape function where all arrays are packed. Basically just memcpy. */ + +void +reshape_packed (char * restrict ret, index_type rsize, const char * source, + index_type ssize, const char * pad, index_type psize) +{ + index_type size; + + size = (rsize > ssize) ? ssize : rsize; + memcpy (ret, source, size); + ret += size; + rsize -= size; + while (rsize > 0) + { + size = (rsize > psize) ? psize : rsize; + memcpy (ret, pad, size); + ret += size; + rsize -= size; + } +} diff --git a/libgfortran/intrinsics/selected_char_kind.c b/libgfortran/intrinsics/selected_char_kind.c new file mode 100644 index 000000000..541c0735e --- /dev/null +++ b/libgfortran/intrinsics/selected_char_kind.c @@ -0,0 +1,46 @@ +/* Copyright 2008, 2009, 2010 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +#include "libgfortran.h" + +#include + + +extern GFC_INTEGER_4 selected_char_kind (gfc_charlen_type, char *); +export_proto(selected_char_kind); + +GFC_INTEGER_4 +selected_char_kind (gfc_charlen_type name_len, char *name) +{ + gfc_charlen_type len = fstrlen (name, name_len); + + if ((len == 5 && strncasecmp (name, "ascii", 5) == 0) + || (len == 7 && strncasecmp (name, "default", 7) == 0)) + return 1; + else if (len == 9 && strncasecmp (name, "iso_10646", 9) == 0) + return 4; + else + return -1; +} diff --git a/libgfortran/intrinsics/selected_int_kind.f90 b/libgfortran/intrinsics/selected_int_kind.f90 new file mode 100644 index 000000000..8b5aa5466 --- /dev/null +++ b/libgfortran/intrinsics/selected_int_kind.f90 @@ -0,0 +1,46 @@ +! Copyright 2003, 2004, 2009 Free Software Foundation, Inc. +! Contributed by Kejia Zhao +! +!This file is part of the GNU Fortran 95 runtime library (libgfortran). +! +!Libgfortran is free software; you can redistribute it and/or +!modify it under the terms of the GNU General Public +!License as published by the Free Software Foundation; either +!version 3 of the License, or (at your option) any later version. +! +!Libgfortran is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU General Public License for more details. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. + +function _gfortran_selected_int_kind (r) + implicit none + integer, intent (in) :: r + integer :: _gfortran_selected_int_kind + integer :: i + ! Integer kind_range table + type :: int_info + integer :: kind + integer :: range + end type int_info + + include "selected_int_kind.inc" + + do i = 1, c + if (r <= int_infos (i) % range) then + _gfortran_selected_int_kind = int_infos (i) % kind + return + end if + end do + _gfortran_selected_int_kind = -1 + return +end function diff --git a/libgfortran/intrinsics/selected_real_kind.f90 b/libgfortran/intrinsics/selected_real_kind.f90 new file mode 100644 index 000000000..92708d720 --- /dev/null +++ b/libgfortran/intrinsics/selected_real_kind.f90 @@ -0,0 +1,95 @@ +! Copyright 2003, 2004, 2009, 2010 Free Software Foundation, Inc. +! Contributed by Kejia Zhao +! +!This file is part of the GNU Fortran runtime library (libgfortran). +! +!Libgfortran is free software; you can redistribute it and/or +!modify it under the terms of the GNU General Public +!License as published by the Free Software Foundation; either +!version 3 of the License, or (at your option) any later version. +! +!Libgfortran is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU General Public License for more details. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. + +function _gfortran_selected_real_kind2008 (p, r, rdx) + implicit none + integer, optional, intent (in) :: p, r, rdx + integer :: _gfortran_selected_real_kind2008 + integer :: i, p2, r2, radix2 + logical :: found_p, found_r, found_radix + ! Real kind_precision_range table + type :: real_info + integer :: kind + integer :: precision + integer :: range + integer :: radix + end type real_info + + include "selected_real_kind.inc" + + _gfortran_selected_real_kind2008 = 0 + p2 = 0 + r2 = 0 + radix2 = 0 + found_p = .false. + found_r = .false. + found_radix = .false. + + if (present (p)) p2 = p + if (present (r)) r2 = r + if (present (rdx)) radix2 = rdx + + ! Assumes each type has a greater precision and range than previous one. + + do i = 1, c + if (p2 <= real_infos (i) % precision) found_p = .true. + if (r2 <= real_infos (i) % range) found_r = .true. + if (radix2 <= real_infos (i) % radix) found_radix = .true. + + if (p2 <= real_infos (i) % precision & + .and. r2 <= real_infos (i) % range & + .and. radix2 <= real_infos (i) % radix) then + _gfortran_selected_real_kind2008 = real_infos (i) % kind + return + end if + end do + + if (found_radix .and. found_r .and. .not. found_p) then + _gfortran_selected_real_kind2008 = -1 + elseif (found_radix .and. found_p .and. .not. found_r) then + _gfortran_selected_real_kind2008 = -2 + elseif (found_radix .and. .not. found_p .and. .not. found_r) then + _gfortran_selected_real_kind2008 = -3 + elseif (found_radix) then + _gfortran_selected_real_kind2008 = -4 + else + _gfortran_selected_real_kind2008 = -5 + end if +end function _gfortran_selected_real_kind2008 + +function _gfortran_selected_real_kind (p, r) + implicit none + integer, optional, intent (in) :: p, r + integer :: _gfortran_selected_real_kind + + interface + function _gfortran_selected_real_kind2008 (p, r, rdx) + implicit none + integer, optional, intent (in) :: p, r, rdx + integer :: _gfortran_selected_real_kind2008 + end function _gfortran_selected_real_kind2008 + end interface + + _gfortran_selected_real_kind = _gfortran_selected_real_kind2008 (p, r) +end function diff --git a/libgfortran/intrinsics/signal.c b/libgfortran/intrinsics/signal.c new file mode 100644 index 000000000..66e54f33a --- /dev/null +++ b/libgfortran/intrinsics/signal.c @@ -0,0 +1,243 @@ +/* Implementation of the SIGNAL and ALARM g77 intrinsics + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#ifdef HAVE_UNISTD_H +#include +#endif + +#ifdef HAVE_SIGNAL_H +#include +#endif + +#ifdef HAVE_INTTYPES_H +#include +#endif + +#include + +/* SIGNAL subroutine with PROCEDURE as handler */ +extern void signal_sub (int *, void (*)(int), int *); +iexport_proto(signal_sub); + +void +signal_sub (int *number, void (*handler)(int), int *status) +{ +#ifdef HAVE_SIGNAL + intptr_t ret; + + if (status != NULL) + { + ret = (intptr_t) signal (*number, handler); + *status = (int) ret; + } + else + signal (*number, handler); +#else + errno = ENOSYS; + if (status != NULL) + *status = -1; +#endif +} +iexport(signal_sub); + + +/* SIGNAL subroutine with INTEGER as handler */ +extern void signal_sub_int (int *, int *, int *); +iexport_proto(signal_sub_int); + +void +signal_sub_int (int *number, int *handler, int *status) +{ +#ifdef HAVE_SIGNAL + intptr_t ptr = *handler, ret; + + if (status != NULL) + { + ret = (intptr_t) signal (*number, (void (*)(int)) ptr); + *status = (int) ret; + } + else + signal (*number, (void (*)(int)) ptr); +#else + errno = ENOSYS; + if (status != NULL) + *status = -1; +#endif +} +iexport(signal_sub_int); + + +/* SIGNAL function with PROCEDURE as handler */ +extern int signal_func (int *, void (*)(int)); +iexport_proto(signal_func); + +int +signal_func (int *number, void (*handler)(int)) +{ + int status; + signal_sub (number, handler, &status); + return status; +} +iexport(signal_func); + + +/* SIGNAL function with INTEGER as handler */ +extern int signal_func_int (int *, int *); +iexport_proto(signal_func_int); + +int +signal_func_int (int *number, int *handler) +{ + int status; + signal_sub_int (number, handler, &status); + return status; +} +iexport(signal_func_int); + + + +/* ALARM intrinsic with PROCEDURE as handler */ +extern void alarm_sub_i4 (int *, void (*)(int), GFC_INTEGER_4 *); +iexport_proto(alarm_sub_i4); + +void +alarm_sub_i4 (int * seconds __attribute__ ((unused)), + void (*handler)(int) __attribute__ ((unused)), + GFC_INTEGER_4 *status) +{ +#if defined (SIGALRM) && defined (HAVE_ALARM) && defined (HAVE_SIGNAL) + if (status != NULL) + { + if (signal (SIGALRM, handler) == SIG_ERR) + *status = -1; + else + *status = alarm (*seconds); + } + else + { + signal (SIGALRM, handler); + alarm (*seconds); + } +#else + errno = ENOSYS; + if (status != NULL) + *status = -1; +#endif +} +iexport(alarm_sub_i4); + + +extern void alarm_sub_i8 (int *, void (*)(int), GFC_INTEGER_8 *); +iexport_proto(alarm_sub_i8); + +void +alarm_sub_i8 (int *seconds __attribute__ ((unused)), + void (*handler)(int) __attribute__ ((unused)), + GFC_INTEGER_8 *status) +{ +#if defined (SIGALRM) && defined (HAVE_ALARM) && defined (HAVE_SIGNAL) + if (status != NULL) + { + if (signal (SIGALRM, handler) == SIG_ERR) + *status = -1; + else + *status = alarm (*seconds); + } + else + { + signal (SIGALRM, handler); + alarm (*seconds); + } +#else + errno = ENOSYS; + if (status != NULL) + *status = -1; +#endif +} +iexport(alarm_sub_i8); + + +/* ALARM intrinsic with INTEGER as handler */ +extern void alarm_sub_int_i4 (int *, int *, GFC_INTEGER_4 *); +iexport_proto(alarm_sub_int_i4); + +void +alarm_sub_int_i4 (int *seconds __attribute__ ((unused)), + int *handler __attribute__ ((unused)), + GFC_INTEGER_4 *status) +{ +#if defined (SIGALRM) && defined (HAVE_ALARM) && defined (HAVE_SIGNAL) + if (status != NULL) + { + if (signal (SIGALRM, (void (*)(int)) (intptr_t) *handler) == SIG_ERR) + *status = -1; + else + *status = alarm (*seconds); + } + else + { + signal (SIGALRM, (void (*)(int)) (intptr_t) *handler); + alarm (*seconds); + } +#else + errno = ENOSYS; + if (status != NULL) + *status = -1; +#endif +} +iexport(alarm_sub_int_i4); + + +extern void alarm_sub_int_i8 (int *, int *, GFC_INTEGER_8 *); +iexport_proto(alarm_sub_int_i8); + +void +alarm_sub_int_i8 (int *seconds __attribute__ ((unused)), + int *handler __attribute__ ((unused)), + GFC_INTEGER_8 *status) +{ +#if defined (SIGALRM) && defined (HAVE_ALARM) && defined (HAVE_SIGNAL) + if (status != NULL) + { + if (signal (SIGALRM, (void (*)(int)) (intptr_t) *handler) == SIG_ERR) + *status = -1; + else + *status = alarm (*seconds); + } + else + { + signal (SIGALRM, (void (*)(int)) (intptr_t) *handler); + alarm (*seconds); + } +#else + errno = ENOSYS; + if (status != NULL) + *status = -1; +#endif +} +iexport(alarm_sub_int_i8); + diff --git a/libgfortran/intrinsics/size.c b/libgfortran/intrinsics/size.c new file mode 100644 index 000000000..6127c4ef3 --- /dev/null +++ b/libgfortran/intrinsics/size.c @@ -0,0 +1,61 @@ +/* Implementation of the size intrinsic. + Copyright 2002, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +index_type +size0 (const array_t * array) +{ + int n; + index_type size; + index_type len; + + size = 1; + for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) + { + len = GFC_DESCRIPTOR_EXTENT(array,n); + if (len < 0) + len = 0; + size *= len; + } + return size; +} +iexport(size0); + +extern index_type size1 (const array_t * array, index_type dim); +export_proto(size1); + +index_type +size1 (const array_t * array, index_type dim) +{ + index_type size; + + dim--; + + size = GFC_DESCRIPTOR_EXTENT(array,dim); + if (size < 0) + size = 0; + return size; +} diff --git a/libgfortran/intrinsics/sleep.c b/libgfortran/intrinsics/sleep.c new file mode 100644 index 000000000..6f7ea227d --- /dev/null +++ b/libgfortran/intrinsics/sleep.c @@ -0,0 +1,67 @@ +/* Implementation of the SLEEP intrinsic. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include + +#ifdef HAVE_UNISTD_H +#include +#endif + +#ifdef __MINGW32__ +# include +# undef sleep +# define sleep(x) Sleep(1000*(x)) +# define HAVE_SLEEP 1 +#endif + +/* SUBROUTINE SLEEP(SECONDS) + INTEGER, INTENT(IN) :: SECONDS + + A choice had to be made if SECONDS is negative. For g77, this is + equivalent to SLEEP(0). */ + +#ifdef HAVE_SLEEP +extern void sleep_i4_sub (GFC_INTEGER_4 *); +iexport_proto(sleep_i4_sub); + +void +sleep_i4_sub (GFC_INTEGER_4 *seconds) +{ + sleep (*seconds < 0 ? 0 : (unsigned int) *seconds); +} +iexport(sleep_i4_sub); + +extern void sleep_i8_sub (GFC_INTEGER_8 *); +iexport_proto(sleep_i8_sub); + +void +sleep_i8_sub (GFC_INTEGER_8 *seconds) +{ + sleep (*seconds < 0 ? 0 : (unsigned int) *seconds); +} +iexport(sleep_i8_sub); +#endif diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c new file mode 100644 index 000000000..29671ce4c --- /dev/null +++ b/libgfortran/intrinsics/spread_generic.c @@ -0,0 +1,655 @@ +/* Generic implementation of the SPREAD intrinsic + Copyright 2002, 2005, 2006, 2007, 2009, 2010 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +static void +spread_internal (gfc_array_char *ret, const gfc_array_char *source, + const index_type *along, const index_type *pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + char *rptr; + char *dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const char *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + index_type size; + + size = GFC_DESCRIPTOR_SIZE(source); + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (*along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = *pncopies; + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + + size_t ub, stride; + + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == *along - 1) + { + ub = ncopies - 1; + rdelta = rs * size; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim); + rstride[dim] = rs * size; + + ub = extent[dim]-1; + rs *= extent[dim]; + dim++; + } + + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * size); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (compile_options.bounds_check) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == *along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == *along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = size; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + memcpy (dest, sptr, size); + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +static void +spread_internal_scalar (gfc_array_char *ret, const char *source, + const index_type *along, const index_type *pncopies) +{ + int n; + int ncopies = *pncopies; + char * dest; + size_t size; + + size = GFC_DESCRIPTOR_SIZE(ret); + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (*along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * size); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + for (n = 0; n < ncopies; n++) + { + dest = (char*)(ret->data + n * GFC_DESCRIPTOR_STRIDE_BYTES(ret,0)); + memcpy (dest , source, size); + } +} + +extern void spread (gfc_array_char *, const gfc_array_char *, + const index_type *, const index_type *); +export_proto(spread); + +void +spread (gfc_array_char *ret, const gfc_array_char *source, + const index_type *along, const index_type *pncopies) +{ + index_type type_size; + + type_size = GFC_DTYPE_TYPE_SIZE(ret); + switch(type_size) + { + case GFC_DTYPE_DERIVED_1: + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_INTEGER_1: + spread_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_2: + case GFC_DTYPE_INTEGER_2: + spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_4: + case GFC_DTYPE_INTEGER_4: + spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_8: + case GFC_DTYPE_INTEGER_8: + spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source, + *along, *pncopies); + return; + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_LOGICAL_16: + case GFC_DTYPE_INTEGER_16: + spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source, + *along, *pncopies); + return; +#endif + + case GFC_DTYPE_REAL_4: + spread_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_REAL_8: + spread_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) source, + *along, *pncopies); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef GFC_HAVE_REAL_10 + case GFC_DTYPE_REAL_10: + spread_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) source, + *along, *pncopies); + return; +# endif + +# ifdef GFC_HAVE_REAL_16 + case GFC_DTYPE_REAL_16: + spread_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) source, + *along, *pncopies); + return; +# endif +#endif + + case GFC_DTYPE_COMPLEX_4: + spread_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_COMPLEX_8: + spread_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) source, + *along, *pncopies); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef GFC_HAVE_COMPLEX_10 + case GFC_DTYPE_COMPLEX_10: + spread_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) source, + *along, *pncopies); + return; +# endif + +# ifdef GFC_HAVE_COMPLEX_16 + case GFC_DTYPE_COMPLEX_16: + spread_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) source, + *along, *pncopies); + return; +# endif +#endif + + case GFC_DTYPE_DERIVED_2: + if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(source->data)) + break; + else + { + spread_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) source, + *along, *pncopies); + return; + } + + case GFC_DTYPE_DERIVED_4: + if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(source->data)) + break; + else + { + spread_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) source, + *along, *pncopies); + return; + } + + case GFC_DTYPE_DERIVED_8: + if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(source->data)) + break; + else + { + spread_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) source, + *along, *pncopies); + return; + } + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_DERIVED_16: + if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(source->data)) + break; + else + { + spread_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) source, + *along, *pncopies); + return; + } +#endif + } + + spread_internal (ret, source, along, pncopies); +} + + +extern void spread_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const index_type *, + const index_type *, GFC_INTEGER_4); +export_proto(spread_char); + +void +spread_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *source, const index_type *along, + const index_type *pncopies, + GFC_INTEGER_4 source_length __attribute__((unused))) +{ + spread_internal (ret, source, along, pncopies); +} + + +extern void spread_char4 (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const index_type *, + const index_type *, GFC_INTEGER_4); +export_proto(spread_char4); + +void +spread_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *source, const index_type *along, + const index_type *pncopies, + GFC_INTEGER_4 source_length __attribute__((unused))) +{ + spread_internal (ret, source, along, pncopies); +} + + +/* The following are the prototypes for the versions of spread with a + scalar source. */ + +extern void spread_scalar (gfc_array_char *, const char *, + const index_type *, const index_type *); +export_proto(spread_scalar); + +void +spread_scalar (gfc_array_char *ret, const char *source, + const index_type *along, const index_type *pncopies) +{ + index_type type_size; + + if (!ret->dtype) + runtime_error ("return array missing descriptor in spread()"); + + type_size = GFC_DTYPE_TYPE_SIZE(ret); + switch(type_size) + { + case GFC_DTYPE_DERIVED_1: + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_INTEGER_1: + spread_scalar_i1 ((gfc_array_i1 *) ret, (GFC_INTEGER_1 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_2: + case GFC_DTYPE_INTEGER_2: + spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_4: + case GFC_DTYPE_INTEGER_4: + spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_LOGICAL_8: + case GFC_DTYPE_INTEGER_8: + spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source, + *along, *pncopies); + return; + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_LOGICAL_16: + case GFC_DTYPE_INTEGER_16: + spread_scalar_i16 ((gfc_array_i16 *) ret, (GFC_INTEGER_16 *) source, + *along, *pncopies); + return; +#endif + + case GFC_DTYPE_REAL_4: + spread_scalar_r4 ((gfc_array_r4 *) ret, (GFC_REAL_4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_REAL_8: + spread_scalar_r8 ((gfc_array_r8 *) ret, (GFC_REAL_8 *) source, + *along, *pncopies); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef HAVE_GFC_REAL_10 + case GFC_DTYPE_REAL_10: + spread_scalar_r10 ((gfc_array_r10 *) ret, (GFC_REAL_10 *) source, + *along, *pncopies); + return; +# endif + +# ifdef HAVE_GFC_REAL_16 + case GFC_DTYPE_REAL_16: + spread_scalar_r16 ((gfc_array_r16 *) ret, (GFC_REAL_16 *) source, + *along, *pncopies); + return; +# endif +#endif + + case GFC_DTYPE_COMPLEX_4: + spread_scalar_c4 ((gfc_array_c4 *) ret, (GFC_COMPLEX_4 *) source, + *along, *pncopies); + return; + + case GFC_DTYPE_COMPLEX_8: + spread_scalar_c8 ((gfc_array_c8 *) ret, (GFC_COMPLEX_8 *) source, + *along, *pncopies); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef HAVE_GFC_COMPLEX_10 + case GFC_DTYPE_COMPLEX_10: + spread_scalar_c10 ((gfc_array_c10 *) ret, (GFC_COMPLEX_10 *) source, + *along, *pncopies); + return; +# endif + +# ifdef HAVE_GFC_COMPLEX_16 + case GFC_DTYPE_COMPLEX_16: + spread_scalar_c16 ((gfc_array_c16 *) ret, (GFC_COMPLEX_16 *) source, + *along, *pncopies); + return; +# endif +#endif + + case GFC_DTYPE_DERIVED_2: + if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(source)) + break; + else + { + spread_scalar_i2 ((gfc_array_i2 *) ret, (GFC_INTEGER_2 *) source, + *along, *pncopies); + return; + } + + case GFC_DTYPE_DERIVED_4: + if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(source)) + break; + else + { + spread_scalar_i4 ((gfc_array_i4 *) ret, (GFC_INTEGER_4 *) source, + *along, *pncopies); + return; + } + + case GFC_DTYPE_DERIVED_8: + if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(source)) + break; + else + { + spread_scalar_i8 ((gfc_array_i8 *) ret, (GFC_INTEGER_8 *) source, + *along, *pncopies); + return; + } +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_DERIVED_16: + if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(source)) + break; + else + { + spread_scalar_i16 ((gfc_array_i16 *) ret, (GFC_INTEGER_16 *) source, + *along, *pncopies); + return; + } +#endif + } + + spread_internal_scalar (ret, source, along, pncopies); +} + + +extern void spread_char_scalar (gfc_array_char *, GFC_INTEGER_4, + const char *, const index_type *, + const index_type *, GFC_INTEGER_4); +export_proto(spread_char_scalar); + +void +spread_char_scalar (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const char *source, const index_type *along, + const index_type *pncopies, + GFC_INTEGER_4 source_length __attribute__((unused))) +{ + if (!ret->dtype) + runtime_error ("return array missing descriptor in spread()"); + spread_internal_scalar (ret, source, along, pncopies); +} + + +extern void spread_char4_scalar (gfc_array_char *, GFC_INTEGER_4, + const char *, const index_type *, + const index_type *, GFC_INTEGER_4); +export_proto(spread_char4_scalar); + +void +spread_char4_scalar (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const char *source, const index_type *along, + const index_type *pncopies, + GFC_INTEGER_4 source_length __attribute__((unused))) +{ + if (!ret->dtype) + runtime_error ("return array missing descriptor in spread()"); + spread_internal_scalar (ret, source, along, pncopies); + +} + diff --git a/libgfortran/intrinsics/stat.c b/libgfortran/intrinsics/stat.c new file mode 100644 index 000000000..22d4f7979 --- /dev/null +++ b/libgfortran/intrinsics/stat.c @@ -0,0 +1,557 @@ +/* Implementation of the STAT and FSTAT intrinsics. + Copyright (C) 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +#ifdef HAVE_SYS_STAT_H +#include +#endif + +#ifdef HAVE_STDLIB_H +#include +#endif + + +#ifdef HAVE_STAT + +/* SUBROUTINE STAT(FILE, SARRAY, STATUS) + CHARACTER(len=*), INTENT(IN) :: FILE + INTEGER, INTENT(OUT), :: SARRAY(13) + INTEGER, INTENT(OUT), OPTIONAL :: STATUS + + FUNCTION STAT(FILE, SARRAY) + INTEGER STAT + CHARACTER(len=*), INTENT(IN) :: FILE + INTEGER, INTENT(OUT), :: SARRAY(13) */ + +/*extern void stat_i4_sub_0 (char *, gfc_array_i4 *, GFC_INTEGER_4 *, + gfc_charlen_type, int); +internal_proto(stat_i4_sub_0);*/ + +static void +stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, + gfc_charlen_type name_len, int is_lstat __attribute__ ((unused))) +{ + int val; + char *str; + struct stat sb; + + /* If the rank of the array is not 1, abort. */ + if (GFC_DESCRIPTOR_RANK (sarray) != 1) + runtime_error ("Array rank of SARRAY is not 1."); + + /* If the array is too small, abort. */ + if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13) + runtime_error ("Array size of SARRAY is too small."); + + /* Trim trailing spaces from name. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + + /* Make a null terminated copy of the string. */ + str = gfc_alloca (name_len + 1); + memcpy (str, name, name_len); + str[name_len] = '\0'; + + /* On platforms that don't provide lstat(), we use stat() instead. */ +#ifdef HAVE_LSTAT + if (is_lstat) + val = lstat(str, &sb); + else +#endif + val = stat(str, &sb); + + if (val == 0) + { + index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0); + + /* Device ID */ + sarray->data[0 * stride] = sb.st_dev; + + /* Inode number */ + sarray->data[1 * stride] = sb.st_ino; + + /* File mode */ + sarray->data[2 * stride] = sb.st_mode; + + /* Number of (hard) links */ + sarray->data[3 * stride] = sb.st_nlink; + + /* Owner's uid */ + sarray->data[4 * stride] = sb.st_uid; + + /* Owner's gid */ + sarray->data[5 * stride] = sb.st_gid; + + /* ID of device containing directory entry for file (0 if not available) */ +#if HAVE_STRUCT_STAT_ST_RDEV + sarray->data[6 * stride] = sb.st_rdev; +#else + sarray->data[6 * stride] = 0; +#endif + + /* File size (bytes) */ + sarray->data[7 * stride] = sb.st_size; + + /* Last access time */ + sarray->data[8 * stride] = sb.st_atime; + + /* Last modification time */ + sarray->data[9 * stride] = sb.st_mtime; + + /* Last file status change time */ + sarray->data[10 * stride] = sb.st_ctime; + + /* Preferred I/O block size (-1 if not available) */ +#if HAVE_STRUCT_STAT_ST_BLKSIZE + sarray->data[11 * stride] = sb.st_blksize; +#else + sarray->data[11 * stride] = -1; +#endif + + /* Number of blocks allocated (-1 if not available) */ +#if HAVE_STRUCT_STAT_ST_BLOCKS + sarray->data[12 * stride] = sb.st_blocks; +#else + sarray->data[12 * stride] = -1; +#endif + } + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} + + +extern void stat_i4_sub (char *, gfc_array_i4 *, GFC_INTEGER_4 *, + gfc_charlen_type); +iexport_proto(stat_i4_sub); + +void +stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, + gfc_charlen_type name_len) +{ + stat_i4_sub_0 (name, sarray, status, name_len, 0); +} +iexport(stat_i4_sub); + + +extern void lstat_i4_sub (char *, gfc_array_i4 *, GFC_INTEGER_4 *, + gfc_charlen_type); +iexport_proto(lstat_i4_sub); + +void +lstat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, + gfc_charlen_type name_len) +{ + stat_i4_sub_0 (name, sarray, status, name_len, 1); +} +iexport(lstat_i4_sub); + + + +static void +stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, + gfc_charlen_type name_len, int is_lstat __attribute__ ((unused))) +{ + int val; + char *str; + struct stat sb; + + /* If the rank of the array is not 1, abort. */ + if (GFC_DESCRIPTOR_RANK (sarray) != 1) + runtime_error ("Array rank of SARRAY is not 1."); + + /* If the array is too small, abort. */ + if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13) + runtime_error ("Array size of SARRAY is too small."); + + /* Trim trailing spaces from name. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + + /* Make a null terminated copy of the string. */ + str = gfc_alloca (name_len + 1); + memcpy (str, name, name_len); + str[name_len] = '\0'; + + /* On platforms that don't provide lstat(), we use stat() instead. */ +#ifdef HAVE_LSTAT + if (is_lstat) + val = lstat(str, &sb); + else +#endif + val = stat(str, &sb); + + if (val == 0) + { + index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0); + + /* Device ID */ + sarray->data[0] = sb.st_dev; + + /* Inode number */ + sarray->data[stride] = sb.st_ino; + + /* File mode */ + sarray->data[2 * stride] = sb.st_mode; + + /* Number of (hard) links */ + sarray->data[3 * stride] = sb.st_nlink; + + /* Owner's uid */ + sarray->data[4 * stride] = sb.st_uid; + + /* Owner's gid */ + sarray->data[5 * stride] = sb.st_gid; + + /* ID of device containing directory entry for file (0 if not available) */ +#if HAVE_STRUCT_STAT_ST_RDEV + sarray->data[6 * stride] = sb.st_rdev; +#else + sarray->data[6 * stride] = 0; +#endif + + /* File size (bytes) */ + sarray->data[7 * stride] = sb.st_size; + + /* Last access time */ + sarray->data[8 * stride] = sb.st_atime; + + /* Last modification time */ + sarray->data[9 * stride] = sb.st_mtime; + + /* Last file status change time */ + sarray->data[10 * stride] = sb.st_ctime; + + /* Preferred I/O block size (-1 if not available) */ +#if HAVE_STRUCT_STAT_ST_BLKSIZE + sarray->data[11 * stride] = sb.st_blksize; +#else + sarray->data[11 * stride] = -1; +#endif + + /* Number of blocks allocated (-1 if not available) */ +#if HAVE_STRUCT_STAT_ST_BLOCKS + sarray->data[12 * stride] = sb.st_blocks; +#else + sarray->data[12 * stride] = -1; +#endif + } + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} + + +extern void stat_i8_sub (char *, gfc_array_i8 *, GFC_INTEGER_8 *, + gfc_charlen_type); +iexport_proto(stat_i8_sub); + +void +stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, + gfc_charlen_type name_len) +{ + stat_i8_sub_0 (name, sarray, status, name_len, 0); +} + +iexport(stat_i8_sub); + + +extern void lstat_i8_sub (char *, gfc_array_i8 *, GFC_INTEGER_8 *, + gfc_charlen_type); +iexport_proto(lstat_i8_sub); + +void +lstat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, + gfc_charlen_type name_len) +{ + stat_i8_sub_0 (name, sarray, status, name_len, 1); +} + +iexport(lstat_i8_sub); + + +extern GFC_INTEGER_4 stat_i4 (char *, gfc_array_i4 *, gfc_charlen_type); +export_proto(stat_i4); + +GFC_INTEGER_4 +stat_i4 (char *name, gfc_array_i4 *sarray, gfc_charlen_type name_len) +{ + GFC_INTEGER_4 val; + stat_i4_sub (name, sarray, &val, name_len); + return val; +} + +extern GFC_INTEGER_8 stat_i8 (char *, gfc_array_i8 *, gfc_charlen_type); +export_proto(stat_i8); + +GFC_INTEGER_8 +stat_i8 (char *name, gfc_array_i8 *sarray, gfc_charlen_type name_len) +{ + GFC_INTEGER_8 val; + stat_i8_sub (name, sarray, &val, name_len); + return val; +} + + +/* SUBROUTINE LSTAT(FILE, SARRAY, STATUS) + CHARACTER(len=*), INTENT(IN) :: FILE + INTEGER, INTENT(OUT), :: SARRAY(13) + INTEGER, INTENT(OUT), OPTIONAL :: STATUS + + FUNCTION LSTAT(FILE, SARRAY) + INTEGER LSTAT + CHARACTER(len=*), INTENT(IN) :: FILE + INTEGER, INTENT(OUT), :: SARRAY(13) */ + +extern GFC_INTEGER_4 lstat_i4 (char *, gfc_array_i4 *, gfc_charlen_type); +export_proto(lstat_i4); + +GFC_INTEGER_4 +lstat_i4 (char *name, gfc_array_i4 *sarray, gfc_charlen_type name_len) +{ + GFC_INTEGER_4 val; + lstat_i4_sub (name, sarray, &val, name_len); + return val; +} + +extern GFC_INTEGER_8 lstat_i8 (char *, gfc_array_i8 *, gfc_charlen_type); +export_proto(lstat_i8); + +GFC_INTEGER_8 +lstat_i8 (char *name, gfc_array_i8 *sarray, gfc_charlen_type name_len) +{ + GFC_INTEGER_8 val; + lstat_i8_sub (name, sarray, &val, name_len); + return val; +} + +#endif + + +#ifdef HAVE_FSTAT + +/* SUBROUTINE FSTAT(UNIT, SARRAY, STATUS) + INTEGER, INTENT(IN) :: UNIT + INTEGER, INTENT(OUT) :: SARRAY(13) + INTEGER, INTENT(OUT), OPTIONAL :: STATUS + + FUNCTION FSTAT(UNIT, SARRAY) + INTEGER FSTAT + INTEGER, INTENT(IN) :: UNIT + INTEGER, INTENT(OUT) :: SARRAY(13) */ + +extern void fstat_i4_sub (GFC_INTEGER_4 *, gfc_array_i4 *, GFC_INTEGER_4 *); +iexport_proto(fstat_i4_sub); + +void +fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_array_i4 *sarray, GFC_INTEGER_4 *status) +{ + int val; + struct stat sb; + + /* If the rank of the array is not 1, abort. */ + if (GFC_DESCRIPTOR_RANK (sarray) != 1) + runtime_error ("Array rank of SARRAY is not 1."); + + /* If the array is too small, abort. */ + if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13) + runtime_error ("Array size of SARRAY is too small."); + + /* Convert Fortran unit number to C file descriptor. */ + val = unit_to_fd (*unit); + if (val >= 0) + val = fstat(val, &sb); + + if (val == 0) + { + index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0); + + /* Device ID */ + sarray->data[0 * stride] = sb.st_dev; + + /* Inode number */ + sarray->data[1 * stride] = sb.st_ino; + + /* File mode */ + sarray->data[2 * stride] = sb.st_mode; + + /* Number of (hard) links */ + sarray->data[3 * stride] = sb.st_nlink; + + /* Owner's uid */ + sarray->data[4 * stride] = sb.st_uid; + + /* Owner's gid */ + sarray->data[5 * stride] = sb.st_gid; + + /* ID of device containing directory entry for file (0 if not available) */ +#if HAVE_STRUCT_STAT_ST_RDEV + sarray->data[6 * stride] = sb.st_rdev; +#else + sarray->data[6 * stride] = 0; +#endif + + /* File size (bytes) */ + sarray->data[7 * stride] = sb.st_size; + + /* Last access time */ + sarray->data[8 * stride] = sb.st_atime; + + /* Last modification time */ + sarray->data[9 * stride] = sb.st_mtime; + + /* Last file status change time */ + sarray->data[10 * stride] = sb.st_ctime; + + /* Preferred I/O block size (-1 if not available) */ +#if HAVE_STRUCT_STAT_ST_BLKSIZE + sarray->data[11 * stride] = sb.st_blksize; +#else + sarray->data[11 * stride] = -1; +#endif + + /* Number of blocks allocated (-1 if not available) */ +#if HAVE_STRUCT_STAT_ST_BLOCKS + sarray->data[12 * stride] = sb.st_blocks; +#else + sarray->data[12 * stride] = -1; +#endif + } + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(fstat_i4_sub); + +extern void fstat_i8_sub (GFC_INTEGER_8 *, gfc_array_i8 *, GFC_INTEGER_8 *); +iexport_proto(fstat_i8_sub); + +void +fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray, GFC_INTEGER_8 *status) +{ + int val; + struct stat sb; + + /* If the rank of the array is not 1, abort. */ + if (GFC_DESCRIPTOR_RANK (sarray) != 1) + runtime_error ("Array rank of SARRAY is not 1."); + + /* If the array is too small, abort. */ + if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13) + runtime_error ("Array size of SARRAY is too small."); + + /* Convert Fortran unit number to C file descriptor. */ + val = unit_to_fd ((int) *unit); + if (val >= 0) + val = fstat(val, &sb); + + if (val == 0) + { + index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0); + + /* Device ID */ + sarray->data[0] = sb.st_dev; + + /* Inode number */ + sarray->data[stride] = sb.st_ino; + + /* File mode */ + sarray->data[2 * stride] = sb.st_mode; + + /* Number of (hard) links */ + sarray->data[3 * stride] = sb.st_nlink; + + /* Owner's uid */ + sarray->data[4 * stride] = sb.st_uid; + + /* Owner's gid */ + sarray->data[5 * stride] = sb.st_gid; + + /* ID of device containing directory entry for file (0 if not available) */ +#if HAVE_STRUCT_STAT_ST_RDEV + sarray->data[6 * stride] = sb.st_rdev; +#else + sarray->data[6 * stride] = 0; +#endif + + /* File size (bytes) */ + sarray->data[7 * stride] = sb.st_size; + + /* Last access time */ + sarray->data[8 * stride] = sb.st_atime; + + /* Last modification time */ + sarray->data[9 * stride] = sb.st_mtime; + + /* Last file status change time */ + sarray->data[10 * stride] = sb.st_ctime; + + /* Preferred I/O block size (-1 if not available) */ +#if HAVE_STRUCT_STAT_ST_BLKSIZE + sarray->data[11 * stride] = sb.st_blksize; +#else + sarray->data[11 * stride] = -1; +#endif + + /* Number of blocks allocated (-1 if not available) */ +#if HAVE_STRUCT_STAT_ST_BLOCKS + sarray->data[12 * stride] = sb.st_blocks; +#else + sarray->data[12 * stride] = -1; +#endif + } + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(fstat_i8_sub); + +extern GFC_INTEGER_4 fstat_i4 (GFC_INTEGER_4 *, gfc_array_i4 *); +export_proto(fstat_i4); + +GFC_INTEGER_4 +fstat_i4 (GFC_INTEGER_4 *unit, gfc_array_i4 *sarray) +{ + GFC_INTEGER_4 val; + fstat_i4_sub (unit, sarray, &val); + return val; +} + +extern GFC_INTEGER_8 fstat_i8 (GFC_INTEGER_8 *, gfc_array_i8 *); +export_proto(fstat_i8); + +GFC_INTEGER_8 +fstat_i8 (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray) +{ + GFC_INTEGER_8 val; + fstat_i8_sub (unit, sarray, &val); + return val; +} + +#endif diff --git a/libgfortran/intrinsics/string_intrinsics.c b/libgfortran/intrinsics/string_intrinsics.c new file mode 100644 index 000000000..a1d3b31ab --- /dev/null +++ b/libgfortran/intrinsics/string_intrinsics.c @@ -0,0 +1,102 @@ +/* String intrinsics helper functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* Unlike what the name of this file suggests, we don't actually + implement the Fortran intrinsics here. At least, not with the + names they have in the standard. The functions here provide all + the support we need for the standard string intrinsics, and the + compiler translates the actual intrinsics calls to calls to + functions in this file. */ + +#include "libgfortran.h" + +#include +#include +#include + + +/* Helper function to set parts of wide strings to a constant (usually + spaces). */ + +static gfc_char4_t * +memset_char4 (gfc_char4_t *b, gfc_char4_t c, size_t len) +{ + size_t i; + + for (i = 0; i < len; i++) + b[i] = c; + + return b; +} + +/* Compare wide character types, which are handled internally as + unsigned 4-byte integers. */ +int +memcmp_char4 (const void *a, const void *b, size_t len) +{ + const GFC_UINTEGER_4 *pa = a; + const GFC_UINTEGER_4 *pb = b; + while (len-- > 0) + { + if (*pa != *pb) + return *pa < *pb ? -1 : 1; + pa ++; + pb ++; + } + return 0; +} + + +/* All other functions are defined using a few generic macros in + string_intrinsics_inc.c, so we avoid code duplication between the + various character type kinds. */ + +#undef CHARTYPE +#define CHARTYPE char +#undef UCHARTYPE +#define UCHARTYPE unsigned char +#undef SUFFIX +#define SUFFIX(x) x +#undef MEMSET +#define MEMSET memset +#undef MEMCMP +#define MEMCMP memcmp + +#include "string_intrinsics_inc.c" + + +#undef CHARTYPE +#define CHARTYPE gfc_char4_t +#undef UCHARTYPE +#define UCHARTYPE gfc_char4_t +#undef SUFFIX +#define SUFFIX(x) x ## _char4 +#undef MEMSET +#define MEMSET memset_char4 +#undef MEMCMP +#define MEMCMP memcmp_char4 + +#include "string_intrinsics_inc.c" + diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c new file mode 100644 index 000000000..8335a38d9 --- /dev/null +++ b/libgfortran/intrinsics/string_intrinsics_inc.c @@ -0,0 +1,453 @@ +/* String intrinsics helper functions. + Copyright 2002, 2005, 2007, 2008, 2009 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* Rename the functions. */ +#define concat_string SUFFIX(concat_string) +#define string_len_trim SUFFIX(string_len_trim) +#define adjustl SUFFIX(adjustl) +#define adjustr SUFFIX(adjustr) +#define string_index SUFFIX(string_index) +#define string_scan SUFFIX(string_scan) +#define string_verify SUFFIX(string_verify) +#define string_trim SUFFIX(string_trim) +#define string_minmax SUFFIX(string_minmax) +#define zero_length_string SUFFIX(zero_length_string) +#define compare_string SUFFIX(compare_string) + + +/* The prototypes. */ + +extern void concat_string (gfc_charlen_type, CHARTYPE *, + gfc_charlen_type, const CHARTYPE *, + gfc_charlen_type, const CHARTYPE *); +export_proto(concat_string); + +extern gfc_charlen_type string_len_trim (gfc_charlen_type, const CHARTYPE *); +export_proto(string_len_trim); + +extern void adjustl (CHARTYPE *, gfc_charlen_type, const CHARTYPE *); +export_proto(adjustl); + +extern void adjustr (CHARTYPE *, gfc_charlen_type, const CHARTYPE *); +export_proto(adjustr); + +extern gfc_charlen_type string_index (gfc_charlen_type, const CHARTYPE *, + gfc_charlen_type, const CHARTYPE *, + GFC_LOGICAL_4); +export_proto(string_index); + +extern gfc_charlen_type string_scan (gfc_charlen_type, const CHARTYPE *, + gfc_charlen_type, const CHARTYPE *, + GFC_LOGICAL_4); +export_proto(string_scan); + +extern gfc_charlen_type string_verify (gfc_charlen_type, const CHARTYPE *, + gfc_charlen_type, const CHARTYPE *, + GFC_LOGICAL_4); +export_proto(string_verify); + +extern void string_trim (gfc_charlen_type *, CHARTYPE **, gfc_charlen_type, + const CHARTYPE *); +export_proto(string_trim); + +extern void string_minmax (gfc_charlen_type *, CHARTYPE **, int, int, ...); +export_proto(string_minmax); + + +/* Use for functions which can return a zero-length string. */ +static CHARTYPE zero_length_string = 0; + + +/* Strings of unequal length are extended with pad characters. */ + +int +compare_string (gfc_charlen_type len1, const CHARTYPE *s1, + gfc_charlen_type len2, const CHARTYPE *s2) +{ + const UCHARTYPE *s; + gfc_charlen_type len; + int res; + + res = MEMCMP (s1, s2, ((len1 < len2) ? len1 : len2)); + if (res != 0) + return res; + + if (len1 == len2) + return 0; + + if (len1 < len2) + { + len = len2 - len1; + s = (UCHARTYPE *) &s2[len1]; + res = -1; + } + else + { + len = len1 - len2; + s = (UCHARTYPE *) &s1[len2]; + res = 1; + } + + while (len--) + { + if (*s != ' ') + { + if (*s > ' ') + return res; + else + return -res; + } + s++; + } + + return 0; +} +iexport(compare_string); + + +/* The destination and source should not overlap. */ + +void +concat_string (gfc_charlen_type destlen, CHARTYPE * dest, + gfc_charlen_type len1, const CHARTYPE * s1, + gfc_charlen_type len2, const CHARTYPE * s2) +{ + if (len1 >= destlen) + { + memcpy (dest, s1, destlen * sizeof (CHARTYPE)); + return; + } + memcpy (dest, s1, len1 * sizeof (CHARTYPE)); + dest += len1; + destlen -= len1; + + if (len2 >= destlen) + { + memcpy (dest, s2, destlen * sizeof (CHARTYPE)); + return; + } + + memcpy (dest, s2, len2 * sizeof (CHARTYPE)); + MEMSET (&dest[len2], ' ', destlen - len2); +} + + +/* Return string with all trailing blanks removed. */ + +void +string_trim (gfc_charlen_type *len, CHARTYPE **dest, gfc_charlen_type slen, + const CHARTYPE *src) +{ + *len = string_len_trim (slen, src); + + if (*len == 0) + *dest = &zero_length_string; + else + { + /* Allocate space for result string. */ + *dest = internal_malloc_size (*len * sizeof (CHARTYPE)); + + /* Copy string if necessary. */ + memcpy (*dest, src, *len * sizeof (CHARTYPE)); + } +} + + +/* The length of a string not including trailing blanks. */ + +gfc_charlen_type +string_len_trim (gfc_charlen_type len, const CHARTYPE *s) +{ + const gfc_charlen_type long_len = (gfc_charlen_type) sizeof (unsigned long); + gfc_charlen_type i; + + i = len - 1; + + /* If we've got the standard (KIND=1) character type, we scan the string in + long word chunks to speed it up (until a long word is hit that does not + consist of ' 's). */ + if (sizeof (CHARTYPE) == 1 && i >= long_len) + { + int starting; + unsigned long blank_longword; + + /* Handle the first characters until we're aligned on a long word + boundary. Actually, s + i + 1 must be properly aligned, because + s + i will be the last byte of a long word read. */ + starting = ((unsigned long) +#ifdef __INTPTR_TYPE__ + (__INTPTR_TYPE__) +#endif + (s + i + 1)) % long_len; + i -= starting; + for (; starting > 0; --starting) + if (s[i + starting] != ' ') + return i + starting + 1; + + /* Handle the others in a batch until first non-blank long word is + found. Here again, s + i is the last byte of the current chunk, + to it starts at s + i - sizeof (long) + 1. */ + +#if __SIZEOF_LONG__ == 4 + blank_longword = 0x20202020L; +#elif __SIZEOF_LONG__ == 8 + blank_longword = 0x2020202020202020L; +#else + #error Invalid size of long! +#endif + + while (i >= long_len) + { + i -= long_len; + if (*((unsigned long*) (s + i + 1)) != blank_longword) + { + i += long_len; + break; + } + } + + /* Now continue for the last characters with naive approach below. */ + assert (i >= 0); + } + + /* Simply look for the first non-blank character. */ + while (i >= 0 && s[i] == ' ') + --i; + return i + 1; +} + + +/* Find a substring within a string. */ + +gfc_charlen_type +string_index (gfc_charlen_type slen, const CHARTYPE *str, + gfc_charlen_type sslen, const CHARTYPE *sstr, + GFC_LOGICAL_4 back) +{ + gfc_charlen_type start, last, delta, i; + + if (sslen == 0) + return back ? (slen + 1) : 1; + + if (sslen > slen) + return 0; + + if (!back) + { + last = slen + 1 - sslen; + start = 0; + delta = 1; + } + else + { + last = -1; + start = slen - sslen; + delta = -1; + } + + for (; start != last; start+= delta) + { + for (i = 0; i < sslen; i++) + { + if (str[start + i] != sstr[i]) + break; + } + if (i == sslen) + return (start + 1); + } + return 0; +} + + +/* Remove leading blanks from a string, padding at end. The src and dest + should not overlap. */ + +void +adjustl (CHARTYPE *dest, gfc_charlen_type len, const CHARTYPE *src) +{ + gfc_charlen_type i; + + i = 0; + while (i < len && src[i] == ' ') + i++; + + if (i < len) + memcpy (dest, &src[i], (len - i) * sizeof (CHARTYPE)); + if (i > 0) + MEMSET (&dest[len - i], ' ', i); +} + + +/* Remove trailing blanks from a string. */ + +void +adjustr (CHARTYPE *dest, gfc_charlen_type len, const CHARTYPE *src) +{ + gfc_charlen_type i; + + i = len; + while (i > 0 && src[i - 1] == ' ') + i--; + + if (i < len) + MEMSET (dest, ' ', len - i); + memcpy (&dest[len - i], src, i * sizeof (CHARTYPE)); +} + + +/* Scan a string for any one of the characters in a set of characters. */ + +gfc_charlen_type +string_scan (gfc_charlen_type slen, const CHARTYPE *str, + gfc_charlen_type setlen, const CHARTYPE *set, GFC_LOGICAL_4 back) +{ + gfc_charlen_type i, j; + + if (slen == 0 || setlen == 0) + return 0; + + if (back) + { + for (i = slen - 1; i >= 0; i--) + { + for (j = 0; j < setlen; j++) + { + if (str[i] == set[j]) + return (i + 1); + } + } + } + else + { + for (i = 0; i < slen; i++) + { + for (j = 0; j < setlen; j++) + { + if (str[i] == set[j]) + return (i + 1); + } + } + } + + return 0; +} + + +/* Verify that a set of characters contains all the characters in a + string by identifying the position of the first character in a + characters that does not appear in a given set of characters. */ + +gfc_charlen_type +string_verify (gfc_charlen_type slen, const CHARTYPE *str, + gfc_charlen_type setlen, const CHARTYPE *set, + GFC_LOGICAL_4 back) +{ + gfc_charlen_type start, last, delta, i; + + if (slen == 0) + return 0; + + if (back) + { + last = -1; + start = slen - 1; + delta = -1; + } + else + { + last = slen; + start = 0; + delta = 1; + } + for (; start != last; start += delta) + { + for (i = 0; i < setlen; i++) + { + if (str[start] == set[i]) + break; + } + if (i == setlen) + return (start + 1); + } + + return 0; +} + + +/* MIN and MAX intrinsics for strings. The front-end makes sure that + nargs is at least 2. */ + +void +string_minmax (gfc_charlen_type *rlen, CHARTYPE **dest, int op, int nargs, ...) +{ + va_list ap; + int i; + CHARTYPE *next, *res; + gfc_charlen_type nextlen, reslen; + + va_start (ap, nargs); + reslen = va_arg (ap, gfc_charlen_type); + res = va_arg (ap, CHARTYPE *); + *rlen = reslen; + + if (res == NULL) + runtime_error ("First argument of '%s' intrinsic should be present", + op > 0 ? "MAX" : "MIN"); + + for (i = 1; i < nargs; i++) + { + nextlen = va_arg (ap, gfc_charlen_type); + next = va_arg (ap, CHARTYPE *); + + if (next == NULL) + { + if (i == 1) + runtime_error ("Second argument of '%s' intrinsic should be " + "present", op > 0 ? "MAX" : "MIN"); + else + continue; + } + + if (nextlen > *rlen) + *rlen = nextlen; + + if (op * compare_string (reslen, res, nextlen, next) < 0) + { + reslen = nextlen; + res = next; + } + } + va_end (ap); + + if (*rlen == 0) + *dest = &zero_length_string; + else + { + CHARTYPE *tmp = internal_malloc_size (*rlen * sizeof (CHARTYPE)); + memcpy (tmp, res, reslen * sizeof (CHARTYPE)); + MEMSET (&tmp[reslen], ' ', *rlen - reslen); + *dest = tmp; + } +} diff --git a/libgfortran/intrinsics/symlnk.c b/libgfortran/intrinsics/symlnk.c new file mode 100644 index 000000000..095520f05 --- /dev/null +++ b/libgfortran/intrinsics/symlnk.c @@ -0,0 +1,131 @@ +/* Implementation of the SYMLNK intrinsic. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +#ifdef HAVE_UNISTD_H +#include +#endif + +/* SUBROUTINE SYMLNK(PATH1, PATH2, STATUS) + CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2 + INTEGER, INTENT(OUT), OPTIONAL :: STATUS */ + +#ifdef HAVE_SYMLINK +extern void symlnk_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type, + gfc_charlen_type); +iexport_proto(symlnk_i4_sub); + +void +symlnk_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status, + gfc_charlen_type path1_len, gfc_charlen_type path2_len) +{ + int val; + char *str1, *str2; + + /* Trim trailing spaces from paths. */ + while (path1_len > 0 && path1[path1_len - 1] == ' ') + path1_len--; + while (path2_len > 0 && path2[path2_len - 1] == ' ') + path2_len--; + + /* Make a null terminated copy of the strings. */ + str1 = gfc_alloca (path1_len + 1); + memcpy (str1, path1, path1_len); + str1[path1_len] = '\0'; + + str2 = gfc_alloca (path2_len + 1); + memcpy (str2, path2, path2_len); + str2[path2_len] = '\0'; + + val = symlink (str1, str2); + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(symlnk_i4_sub); + +extern void symlnk_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type, + gfc_charlen_type); +iexport_proto(symlnk_i8_sub); + +void +symlnk_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status, + gfc_charlen_type path1_len, gfc_charlen_type path2_len) +{ + int val; + char *str1, *str2; + + /* Trim trailing spaces from paths. */ + while (path1_len > 0 && path1[path1_len - 1] == ' ') + path1_len--; + while (path2_len > 0 && path2[path2_len - 1] == ' ') + path2_len--; + + /* Make a null terminated copy of the strings. */ + str1 = gfc_alloca (path1_len + 1); + memcpy (str1, path1, path1_len); + str1[path1_len] = '\0'; + + str2 = gfc_alloca (path2_len + 1); + memcpy (str2, path2, path2_len); + str2[path2_len] = '\0'; + + val = symlink (str1, str2); + + if (status != NULL) + *status = (val == 0) ? 0 : errno; +} +iexport(symlnk_i8_sub); + +extern GFC_INTEGER_4 symlnk_i4 (char *, char *, gfc_charlen_type, + gfc_charlen_type); +export_proto(symlnk_i4); + +GFC_INTEGER_4 +symlnk_i4 (char *path1, char *path2, gfc_charlen_type path1_len, + gfc_charlen_type path2_len) +{ + GFC_INTEGER_4 val; + symlnk_i4_sub (path1, path2, &val, path1_len, path2_len); + return val; +} + +extern GFC_INTEGER_8 symlnk_i8 (char *, char *, gfc_charlen_type, + gfc_charlen_type); +export_proto(symlnk_i8); + +GFC_INTEGER_8 +symlnk_i8 (char *path1, char *path2, gfc_charlen_type path1_len, + gfc_charlen_type path2_len) +{ + GFC_INTEGER_8 val; + symlnk_i8_sub (path1, path2, &val, path1_len, path2_len); + return val; +} +#endif diff --git a/libgfortran/intrinsics/system.c b/libgfortran/intrinsics/system.c new file mode 100644 index 000000000..831823ffc --- /dev/null +++ b/libgfortran/intrinsics/system.c @@ -0,0 +1,64 @@ +/* Implementation of the SYSTEM intrinsic. + Copyright (C) 2004, 2007, 2009 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 3, or (at your option) any later +version. + +Libgfortran is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + +#ifdef HAVE_STDLIB_H +#include +#endif + +extern void system_sub (const char *fcmd, GFC_INTEGER_4 * status, + gfc_charlen_type cmd_len); +iexport_proto(system_sub); + +void +system_sub (const char *fcmd, GFC_INTEGER_4 *status, gfc_charlen_type cmd_len) +{ + char cmd[cmd_len + 1]; + int stat; + + /* Flush all I/O units before executing the command. */ + flush_all_units(); + + memcpy (cmd, fcmd, cmd_len); + cmd[cmd_len] = '\0'; + + stat = system (cmd); + if (status) + *status = stat; +} +iexport(system_sub); + +extern GFC_INTEGER_4 PREFIX(system) (const char *, gfc_charlen_type); +export_proto_np(PREFIX(system)); + +GFC_INTEGER_4 +PREFIX(system) (const char *fcmd, gfc_charlen_type cmd_len) +{ + GFC_INTEGER_4 stat; + system_sub (fcmd, &stat, cmd_len); + return stat; +} diff --git a/libgfortran/intrinsics/system_clock.c b/libgfortran/intrinsics/system_clock.c new file mode 100644 index 000000000..f4bac0777 --- /dev/null +++ b/libgfortran/intrinsics/system_clock.c @@ -0,0 +1,207 @@ +/* Implementation of the SYSTEM_CLOCK intrinsic. + Copyright (C) 2004, 2005, 2007, 2009, 2010, 2011 Free Software + Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include + +#include "time_1.h" + + +/* POSIX states that CLOCK_REALTIME must be present if clock_gettime + is available, others are optional. */ +#if defined(HAVE_CLOCK_GETTIME) || defined(HAVE_CLOCK_GETTIME_LIBRT) +#ifdef CLOCK_MONOTONIC +#define GF_CLOCK_MONOTONIC CLOCK_MONOTONIC +#else +#define GF_CLOCK_MONOTONIC CLOCK_REALTIME +#endif +#endif + +/* Weakref trickery for clock_gettime(). On Glibc, clock_gettime() + requires us to link in librt, which also pulls in libpthread. In + order to avoid this by default, only call clock_gettime() through a + weak reference. + + Some targets don't support weak undefined references; on these + GTHREAD_USE_WEAK is 0. So we need to define it to 1 on other + targets. */ +#ifndef GTHREAD_USE_WEAK +#define GTHREAD_USE_WEAK 1 +#endif + +#if SUPPORTS_WEAK && GTHREAD_USE_WEAK && defined(HAVE_CLOCK_GETTIME_LIBRT) +static int weak_gettime (clockid_t, struct timespec *) + __attribute__((__weakref__("clock_gettime"))); +#endif + + +/* High resolution monotonic clock, falling back to the realtime clock + if the target does not support such a clock. + + Arguments: + secs - OUTPUT, seconds + nanosecs - OUTPUT, nanoseconds + + If the target supports a monotonic clock, the OUTPUT arguments + represent a monotonically incrementing clock starting from some + unspecified time in the past. + + If a monotonic clock is not available, falls back to the realtime + clock which is not monotonic. + + Return value: 0 for success, -1 for error. In case of error, errno + is set. +*/ +static inline int +gf_gettime_mono (time_t * secs, long * nanosecs) +{ + int err; +#ifdef HAVE_CLOCK_GETTIME + struct timespec ts; + err = clock_gettime (GF_CLOCK_MONOTONIC, &ts); + *secs = ts.tv_sec; + *nanosecs = ts.tv_nsec; + return err; +#else +#if defined(HAVE_CLOCK_GETTIME_LIBRT) && SUPPORTS_WEAK && GTHREAD_USE_WEAK + if (weak_gettime) + { + struct timespec ts; + err = weak_gettime (GF_CLOCK_MONOTONIC, &ts); + *secs = ts.tv_sec; + *nanosecs = ts.tv_nsec; + return err; + } +#endif + err = gf_gettime (secs, nanosecs); + *nanosecs *= 1000; + return err; +#endif +} + +extern void system_clock_4 (GFC_INTEGER_4 *, GFC_INTEGER_4 *, GFC_INTEGER_4 *); +export_proto(system_clock_4); + +extern void system_clock_8 (GFC_INTEGER_8 *, GFC_INTEGER_8 *, GFC_INTEGER_8 *); +export_proto(system_clock_8); + + +/* prefix(system_clock_4) is the INTEGER(4) version of the SYSTEM_CLOCK + intrinsic subroutine. It returns the number of clock ticks for the current + system time, the number of ticks per second, and the maximum possible value + for COUNT. On the first call to SYSTEM_CLOCK, COUNT is set to zero. */ + +void +system_clock_4(GFC_INTEGER_4 *count, GFC_INTEGER_4 *count_rate, + GFC_INTEGER_4 *count_max) +{ +#undef TCK +#define TCK 1000 + GFC_INTEGER_4 cnt; + GFC_INTEGER_4 mx; + + time_t secs; + long nanosecs; + + if (sizeof (secs) < sizeof (GFC_INTEGER_4)) + internal_error (NULL, "secs too small"); + + if (gf_gettime_mono (&secs, &nanosecs) == 0) + { + GFC_UINTEGER_4 ucnt = (GFC_UINTEGER_4) secs * TCK; + ucnt += (nanosecs + 500000000 / TCK) / (1000000000 / TCK); + if (ucnt > GFC_INTEGER_4_HUGE) + cnt = ucnt - GFC_INTEGER_4_HUGE - 1; + else + cnt = ucnt; + mx = GFC_INTEGER_4_HUGE; + } + else + { + if (count != NULL) + *count = - GFC_INTEGER_4_HUGE; + if (count_rate != NULL) + *count_rate = 0; + if (count_max != NULL) + *count_max = 0; + return; + } + + if (count != NULL) + *count = cnt; + if (count_rate != NULL) + *count_rate = TCK; + if (count_max != NULL) + *count_max = mx; +} + + +/* INTEGER(8) version of the above routine. */ + +void +system_clock_8 (GFC_INTEGER_8 *count, GFC_INTEGER_8 *count_rate, + GFC_INTEGER_8 *count_max) +{ +#undef TCK +#define TCK 1000000000 + GFC_INTEGER_8 cnt; + GFC_INTEGER_8 mx; + + time_t secs; + long nanosecs; + + if (sizeof (secs) < sizeof (GFC_INTEGER_4)) + internal_error (NULL, "secs too small"); + + if (gf_gettime_mono (&secs, &nanosecs) == 0) + { + GFC_UINTEGER_8 ucnt = (GFC_UINTEGER_8) secs * TCK; + ucnt += (nanosecs + 500000000 / TCK) / (1000000000 / TCK); + if (ucnt > GFC_INTEGER_8_HUGE) + cnt = ucnt - GFC_INTEGER_8_HUGE - 1; + else + cnt = ucnt; + mx = GFC_INTEGER_8_HUGE; + } + else + { + if (count != NULL) + *count = - GFC_INTEGER_8_HUGE; + if (count_rate != NULL) + *count_rate = 0; + if (count_max != NULL) + *count_max = 0; + + return; + } + + if (count != NULL) + *count = cnt; + if (count_rate != NULL) + *count_rate = TCK; + if (count_max != NULL) + *count_max = mx; +} diff --git a/libgfortran/intrinsics/time.c b/libgfortran/intrinsics/time.c new file mode 100644 index 000000000..d046e87ec --- /dev/null +++ b/libgfortran/intrinsics/time.c @@ -0,0 +1,64 @@ +/* Implementation of the TIME and TIME8 g77 intrinsics. + Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#ifdef TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# ifdef HAVE_TIME_H +# include +# endif +# endif +#endif + + +/* INTEGER(KIND=4) FUNCTION TIME() */ + +#ifdef HAVE_TIME +extern GFC_INTEGER_4 time_func (void); +export_proto(time_func); + +GFC_INTEGER_4 +time_func (void) +{ + return (GFC_INTEGER_4) time (NULL); +} + +/* INTEGER(KIND=8) FUNCTION TIME8() */ + +extern GFC_INTEGER_8 time8_func (void); +export_proto(time8_func); + +GFC_INTEGER_8 +time8_func (void) +{ + return (GFC_INTEGER_8) time (NULL); +} +#endif diff --git a/libgfortran/intrinsics/time_1.h b/libgfortran/intrinsics/time_1.h new file mode 100644 index 000000000..12d79ebc1 --- /dev/null +++ b/libgfortran/intrinsics/time_1.h @@ -0,0 +1,238 @@ +/* Wrappers for platform timing functions. + Copyright (C) 2003, 2007, 2009, 2011 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#ifndef LIBGFORTRAN_TIME_H +#define LIBGFORTRAN_TIME_H + +#ifdef HAVE_UNISTD_H +#include +#endif + +#include + +/* The time related intrinsics (DTIME, ETIME, CPU_TIME) to "compare + different algorithms on the same computer or discover which parts + are the most expensive", need a way to get the CPU time with the + finest resolution possible. We can only be accurate up to + microseconds. + + As usual with UNIX systems, unfortunately no single way is + available for all systems. */ + +#ifdef TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# ifdef HAVE_TIME_H +# include +# endif +# endif +#endif + +#ifdef HAVE_SYS_TYPES_H + #include +#endif + +/* The most accurate way to get the CPU time is getrusage (). */ +#if defined (HAVE_GETRUSAGE) && defined (HAVE_SYS_RESOURCE_H) +# include +#endif /* HAVE_GETRUSAGE && HAVE_SYS_RESOURCE_H */ + +/* The most accurate way to get the CPU time is getrusage (). + If we have times(), that's good enough, too. */ +#if !defined (HAVE_GETRUSAGE) || !defined (HAVE_SYS_RESOURCE_H) +/* For times(), we _must_ know the number of clock ticks per second. */ +# if defined (HAVE_TIMES) && (defined (HZ) || defined (_SC_CLK_TCK) || defined (CLK_TCK)) +# ifdef HAVE_SYS_PARAM_H +# include +# endif +# if defined (HAVE_SYS_TIMES_H) +# include +# endif +# ifndef HZ +# if defined _SC_CLK_TCK +# define HZ sysconf(_SC_CLK_TCK) +# else +# define HZ CLK_TCK +# endif +# endif +# endif /* HAVE_TIMES etc. */ +#endif /* !HAVE_GETRUSAGE || !HAVE_SYS_RESOURCE_H */ + + +/* If the re-entrant version of localtime is not available, provide a + fallback implementation. On some targets where the _r version is + not available, localtime uses thread-local storage so it's + threadsafe. */ + +#ifndef HAVE_LOCALTIME_R +/* If _POSIX is defined localtime_r gets defined by mingw-w64 headers. */ +#ifdef localtime_r +#undef localtime_r +#endif + +static inline struct tm * +localtime_r (const time_t * timep, struct tm * result) +{ + *result = *localtime (timep); + return result; +} +#endif + + +#if defined (__GNUC__) && (__GNUC__ >= 3) +# define ATTRIBUTE_ALWAYS_INLINE __attribute__ ((__always_inline__)) +#else +# define ATTRIBUTE_ALWAYS_INLINE +#endif + +static inline int gf_cputime (long *, long *, long *, long *) ATTRIBUTE_ALWAYS_INLINE; + +/* Helper function for the actual implementation of the DTIME, ETIME and + CPU_TIME intrinsics. Returns 0 for success or -1 if no + CPU time could be computed. */ + +#ifdef __MINGW32__ + +#define WIN32_LEAN_AND_MEAN +#include + +static int +gf_cputime (long *user_sec, long *user_usec, long *system_sec, long *system_usec) +{ + union { + FILETIME ft; + unsigned long long ulltime; + } kernel_time, user_time; + + FILETIME unused1, unused2; + + /* No support for Win9x. The high order bit of the DWORD + returned by GetVersion is 0 for NT and higher. */ + if (GetVersion () >= 0x80000000) + { + *user_sec = *system_sec = 0; + *user_usec = *system_usec = 0; + return -1; + } + + /* The FILETIME structs filled in by GetProcessTimes represent + time in 100 nanosecond units. */ + GetProcessTimes (GetCurrentProcess (), &unused1, &unused2, + &kernel_time.ft, &user_time.ft); + + *user_sec = user_time.ulltime / 10000000; + *user_usec = (user_time.ulltime % 10000000) / 10; + + *system_sec = kernel_time.ulltime / 10000000; + *system_usec = (kernel_time.ulltime % 10000000) / 10; + return 0; +} + +#else + +static inline int +gf_cputime (long *user_sec, long *user_usec, long *system_sec, long *system_usec) +{ +#if defined (HAVE_GETRUSAGE) && defined (HAVE_SYS_RESOURCE_H) + struct rusage usage; + int err; + err = getrusage (RUSAGE_SELF, &usage); + + *user_sec = usage.ru_utime.tv_sec; + *user_usec = usage.ru_utime.tv_usec; + *system_sec = usage.ru_stime.tv_sec; + *system_usec = usage.ru_stime.tv_usec; + return err; + +#elif defined HAVE_TIMES + struct tms buf; + clock_t err; + err = times (&buf); + *user_sec = buf.tms_utime / HZ; + *user_usec = buf.tms_utime % HZ * (1000000 / HZ); + *system_sec = buf.tms_stime / HZ; + *system_usec = buf.tms_stime % HZ * (1000000 / HZ); + if ((err == (clock_t) -1) && errno != 0) + return -1; + return 0; + +#else + + /* We have nothing to go on. Return -1. */ + *user_sec = *system_sec = 0; + *user_usec = *system_usec = 0; + errno = ENOSYS; + return -1; + +#endif +} + +#endif + + +/* Realtime clock with microsecond resolution, falling back to less + precise functions if the target does not support gettimeofday(). + + Arguments: + secs - OUTPUT, seconds + usecs - OUTPUT, microseconds + + The OUTPUT arguments shall represent the number of seconds and + nanoseconds since the Epoch. + + Return value: 0 for success, -1 for error. In case of error, errno + is set. +*/ +static inline int +gf_gettime (time_t * secs, long * usecs) +{ +#ifdef HAVE_GETTIMEOFDAY + struct timeval tv; + int err; + err = gettimeofday (&tv, NULL); + *secs = tv.tv_sec; + *usecs = tv.tv_usec; + return err; +#elif HAVE_TIME + time_t t, t2; + t = time (&t2); + *secs = t2; + *usecs = 0; + if (t == ((time_t)-1)) + return -1; + return 0; +#else + *secs = 0; + *usecs = 0; + errno = ENOSYS; + return -1; +#endif +} + + +#endif /* LIBGFORTRAN_TIME_H */ diff --git a/libgfortran/intrinsics/transpose_generic.c b/libgfortran/intrinsics/transpose_generic.c new file mode 100644 index 000000000..b0c2fff57 --- /dev/null +++ b/libgfortran/intrinsics/transpose_generic.c @@ -0,0 +1,151 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +extern void transpose (gfc_array_char *, gfc_array_char *); +export_proto(transpose); + +static void +transpose_internal (gfc_array_char *ret, gfc_array_char *source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + char *rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const char *sptr; + + index_type xcount, ycount; + index_type x, y; + index_type size; + + assert (GFC_DESCRIPTOR_RANK (source) == 2 + && GFC_DESCRIPTOR_RANK (ret) == 2); + + size = GFC_DESCRIPTOR_SIZE(ret); + + if (ret->data == NULL) + { + assert (ret->dtype == source->dtype); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (size * size0 ((array_t*)ret)); + ret->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE_BYTES(source,0); + systride = GFC_DESCRIPTOR_STRIDE_BYTES(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE_BYTES(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE_BYTES(ret,1); + + rptr = ret->data; + sptr = source->data; + + for (y = 0; y < ycount; y++) + { + for (x = 0; x < xcount; x++) + { + memcpy (rptr, sptr, size); + + sptr += sxstride; + rptr += rystride; + } + sptr += systride - (sxstride * xcount); + rptr += rxstride - (rystride * xcount); + } +} + + +extern void transpose (gfc_array_char *, gfc_array_char *); +export_proto(transpose); + +void +transpose (gfc_array_char *ret, gfc_array_char *source) +{ + transpose_internal (ret, source); +} + + +extern void transpose_char (gfc_array_char *, GFC_INTEGER_4, + gfc_array_char *, GFC_INTEGER_4); +export_proto(transpose_char); + +void +transpose_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + gfc_array_char *source, + GFC_INTEGER_4 source_length __attribute__((unused))) +{ + transpose_internal (ret, source); +} + + +extern void transpose_char4 (gfc_array_char *, GFC_INTEGER_4, + gfc_array_char *, GFC_INTEGER_4); +export_proto(transpose_char4); + +void +transpose_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + gfc_array_char *source, + GFC_INTEGER_4 source_length __attribute__((unused))) +{ + transpose_internal (ret, source); +} diff --git a/libgfortran/intrinsics/umask.c b/libgfortran/intrinsics/umask.c new file mode 100644 index 000000000..9df684bfc --- /dev/null +++ b/libgfortran/intrinsics/umask.c @@ -0,0 +1,93 @@ +/* Implementation of the UMASK intrinsic. + Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +#include "libgfortran.h" + +#ifdef HAVE_STDLIB_H +#include +#endif + +#ifdef HAVE_SYS_STAT_H +#include +#endif + +#ifdef HAVE_UNISTD_H +#include +#endif + + +/* SUBROUTINE UMASK(MASK, OLD) + INTEGER, INTENT(IN) :: MASK + INTEGER, INTENT(OUT), OPTIONAL :: OLD */ + +extern void umask_i4_sub (GFC_INTEGER_4 *, GFC_INTEGER_4 *); +iexport_proto(umask_i4_sub); + +void +umask_i4_sub (GFC_INTEGER_4 *mask, GFC_INTEGER_4 *old) +{ + mode_t val = umask((mode_t) *mask); + if (old != NULL) + *old = (GFC_INTEGER_4) val; +} +iexport(umask_i4_sub); + +extern void umask_i8_sub (GFC_INTEGER_8 *, GFC_INTEGER_8 *); +iexport_proto(umask_i8_sub); + +void +umask_i8_sub (GFC_INTEGER_8 *mask, GFC_INTEGER_8 *old) +{ + mode_t val = umask((mode_t) *mask); + if (old != NULL) + *old = (GFC_INTEGER_8) val; +} +iexport(umask_i8_sub); + +/* INTEGER FUNCTION UMASK(MASK) + INTEGER, INTENT(IN) :: MASK */ + +extern GFC_INTEGER_4 umask_i4 (GFC_INTEGER_4 *); +export_proto(umask_i4); + +GFC_INTEGER_4 +umask_i4 (GFC_INTEGER_4 *mask) +{ + GFC_INTEGER_4 old; + umask_i4_sub (mask, &old); + return old; +} + +extern GFC_INTEGER_8 umask_i8 (GFC_INTEGER_8 *); +export_proto(umask_i8); + +GFC_INTEGER_8 +umask_i8 (GFC_INTEGER_8 *mask) +{ + GFC_INTEGER_8 old; + umask_i8_sub (mask, &old); + return old; +} diff --git a/libgfortran/intrinsics/unlink.c b/libgfortran/intrinsics/unlink.c new file mode 100644 index 000000000..7b17dfe3f --- /dev/null +++ b/libgfortran/intrinsics/unlink.c @@ -0,0 +1,91 @@ +/* Implementation of the UNLINK intrinsic. + Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + +#ifdef HAVE_UNISTD_H +#include +#endif + +/* SUBROUTINE UNLINK(NAME, STATUS) + CHARACTER(LEN= ), INTENT(IN) :: NAME + INTEGER, INTENT(OUT), OPTIONAL :: STATUS) */ + +extern void unlink_i4_sub (char *name, GFC_INTEGER_4 *status, + gfc_charlen_type name_len); +iexport_proto(unlink_i4_sub); + +void +unlink_i4_sub (char *name, GFC_INTEGER_4 *status, gfc_charlen_type name_len) +{ + char *str; + GFC_INTEGER_4 stat; + + /* Trim trailing spaces from name. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + + /* Make a null terminated copy of the string. */ + str = gfc_alloca (name_len + 1); + memcpy (str, name, name_len); + str[name_len] = '\0'; + + stat = unlink (str); + + if (status != NULL) + *status = (stat == 0) ? stat : errno; +} +iexport(unlink_i4_sub); + +extern void unlink_i8_sub (char *name, GFC_INTEGER_8 *status, + gfc_charlen_type name_len); +export_proto(unlink_i8_sub); + +void +unlink_i8_sub (char *name, GFC_INTEGER_8 *status, gfc_charlen_type name_len) +{ + GFC_INTEGER_4 status4; + unlink_i4_sub (name, &status4, name_len); + if (status) + *status = status4; +} + + +/* INTEGER FUNCTION UNLINK(NAME) + CHARACTER(LEN= ), INTENT(IN) :: NAME */ + +extern GFC_INTEGER_4 PREFIX(unlink) (char *, gfc_charlen_type); +export_proto_np(PREFIX(unlink)); + +GFC_INTEGER_4 +PREFIX(unlink) (char *name, gfc_charlen_type name_len) +{ + GFC_INTEGER_4 status; + unlink_i4_sub (name, &status, name_len); + return status; +} diff --git a/libgfortran/intrinsics/unpack_generic.c b/libgfortran/intrinsics/unpack_generic.c new file mode 100644 index 000000000..db624996d --- /dev/null +++ b/libgfortran/intrinsics/unpack_generic.c @@ -0,0 +1,630 @@ +/* Generic implementation of the UNPACK intrinsic + Copyright 2002, 2003, 2004, 2005, 2007, 2009, 2010 + 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +/* All the bounds checking for unpack in one function. If field is NULL, + we don't check it, for the unpack0 functions. */ + +static void +unpack_bounds (gfc_array_char *ret, const gfc_array_char *vector, + const gfc_array_l1 *mask, const gfc_array_char *field) +{ + index_type vec_size, mask_count; + vec_size = size0 ((array_t *) vector); + mask_count = count_0 (mask); + if (vec_size < mask_count) + runtime_error ("Incorrect size of return value in UNPACK" + " intrinsic: should be at least %ld, is" + " %ld", (long int) mask_count, + (long int) vec_size); + + if (field != NULL) + bounds_equal_extents ((array_t *) field, (array_t *) mask, + "FIELD", "UNPACK"); + + if (ret->data != NULL) + bounds_equal_extents ((array_t *) ret, (array_t *) mask, + "return value", "UNPACK"); + +} + +static void +unpack_internal (gfc_array_char *ret, const gfc_array_char *vector, + const gfc_array_l1 *mask, const gfc_array_char *field, + index_type size) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + char * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + char *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const char *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Don't convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * size); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n); + fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n); + } + } + + if (empty) + return; + + vstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0); + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + memcpy (rptr, vptr, size); + vptr += vstride0; + } + else + { + /* From field. */ + memcpy (rptr, fptr, size); + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +extern void unpack1 (gfc_array_char *, const gfc_array_char *, + const gfc_array_l1 *, const gfc_array_char *); +export_proto(unpack1); + +void +unpack1 (gfc_array_char *ret, const gfc_array_char *vector, + const gfc_array_l1 *mask, const gfc_array_char *field) +{ + index_type type_size; + index_type size; + + if (unlikely(compile_options.bounds_check)) + unpack_bounds (ret, vector, mask, field); + + type_size = GFC_DTYPE_TYPE_SIZE (vector); + size = GFC_DESCRIPTOR_SIZE (vector); + + switch(type_size) + { + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_INTEGER_1: + case GFC_DTYPE_DERIVED_1: + unpack1_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector, + mask, (gfc_array_i1 *) field); + return; + + case GFC_DTYPE_LOGICAL_2: + case GFC_DTYPE_INTEGER_2: + unpack1_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, + mask, (gfc_array_i2 *) field); + return; + + case GFC_DTYPE_LOGICAL_4: + case GFC_DTYPE_INTEGER_4: + unpack1_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, + mask, (gfc_array_i4 *) field); + return; + + case GFC_DTYPE_LOGICAL_8: + case GFC_DTYPE_INTEGER_8: + unpack1_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, + mask, (gfc_array_i8 *) field); + return; + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_LOGICAL_16: + case GFC_DTYPE_INTEGER_16: + unpack1_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, + mask, (gfc_array_i16 *) field); + return; +#endif + + case GFC_DTYPE_REAL_4: + unpack1_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) vector, + mask, (gfc_array_r4 *) field); + return; + + case GFC_DTYPE_REAL_8: + unpack1_r8 ((gfc_array_r8 *) ret, (gfc_array_r8 *) vector, + mask, (gfc_array_r8 *) field); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef HAVE_GFC_REAL_10 + case GFC_DTYPE_REAL_10: + unpack1_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) vector, + mask, (gfc_array_r10 *) field); + return; +# endif + +# ifdef HAVE_GFC_REAL_16 + case GFC_DTYPE_REAL_16: + unpack1_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) vector, + mask, (gfc_array_r16 *) field); + return; +# endif +#endif + + case GFC_DTYPE_COMPLEX_4: + unpack1_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) vector, + mask, (gfc_array_c4 *) field); + return; + + case GFC_DTYPE_COMPLEX_8: + unpack1_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) vector, + mask, (gfc_array_c8 *) field); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef HAVE_GFC_COMPLEX_10 + case GFC_DTYPE_COMPLEX_10: + unpack1_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) vector, + mask, (gfc_array_c10 *) field); + return; +# endif + +# ifdef HAVE_GFC_COMPLEX_16 + case GFC_DTYPE_COMPLEX_16: + unpack1_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) vector, + mask, (gfc_array_c16 *) field); + return; +# endif +#endif + + case GFC_DTYPE_DERIVED_2: + if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(vector->data) + || GFC_UNALIGNED_2(field->data)) + break; + else + { + unpack1_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, + mask, (gfc_array_i2 *) field); + return; + } + + case GFC_DTYPE_DERIVED_4: + if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(vector->data) + || GFC_UNALIGNED_4(field->data)) + break; + else + { + unpack1_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, + mask, (gfc_array_i4 *) field); + return; + } + + case GFC_DTYPE_DERIVED_8: + if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(vector->data) + || GFC_UNALIGNED_8(field->data)) + break; + else + { + unpack1_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, + mask, (gfc_array_i8 *) field); + return; + } + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_DERIVED_16: + if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(vector->data) + || GFC_UNALIGNED_16(field->data)) + break; + else + { + unpack1_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, + mask, (gfc_array_i16 *) field); + return; + } +#endif + } + + unpack_internal (ret, vector, mask, field, size); +} + + +extern void unpack1_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const gfc_array_l1 *, + const gfc_array_char *, GFC_INTEGER_4, + GFC_INTEGER_4); +export_proto(unpack1_char); + +void +unpack1_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *vector, const gfc_array_l1 *mask, + const gfc_array_char *field, GFC_INTEGER_4 vector_length, + GFC_INTEGER_4 field_length __attribute__((unused))) +{ + + if (unlikely(compile_options.bounds_check)) + unpack_bounds (ret, vector, mask, field); + + unpack_internal (ret, vector, mask, field, vector_length); +} + + +extern void unpack1_char4 (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const gfc_array_l1 *, + const gfc_array_char *, GFC_INTEGER_4, + GFC_INTEGER_4); +export_proto(unpack1_char4); + +void +unpack1_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *vector, const gfc_array_l1 *mask, + const gfc_array_char *field, GFC_INTEGER_4 vector_length, + GFC_INTEGER_4 field_length __attribute__((unused))) +{ + + if (unlikely(compile_options.bounds_check)) + unpack_bounds (ret, vector, mask, field); + + unpack_internal (ret, vector, mask, field, + vector_length * sizeof (gfc_char4_t)); +} + + +extern void unpack0 (gfc_array_char *, const gfc_array_char *, + const gfc_array_l1 *, char *); +export_proto(unpack0); + +void +unpack0 (gfc_array_char *ret, const gfc_array_char *vector, + const gfc_array_l1 *mask, char *field) +{ + gfc_array_char tmp; + + index_type type_size; + + if (unlikely(compile_options.bounds_check)) + unpack_bounds (ret, vector, mask, NULL); + + type_size = GFC_DTYPE_TYPE_SIZE (vector); + + switch (type_size) + { + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_INTEGER_1: + case GFC_DTYPE_DERIVED_1: + unpack0_i1 ((gfc_array_i1 *) ret, (gfc_array_i1 *) vector, + mask, (GFC_INTEGER_1 *) field); + return; + + case GFC_DTYPE_LOGICAL_2: + case GFC_DTYPE_INTEGER_2: + unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, + mask, (GFC_INTEGER_2 *) field); + return; + + case GFC_DTYPE_LOGICAL_4: + case GFC_DTYPE_INTEGER_4: + unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, + mask, (GFC_INTEGER_4 *) field); + return; + + case GFC_DTYPE_LOGICAL_8: + case GFC_DTYPE_INTEGER_8: + unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, + mask, (GFC_INTEGER_8 *) field); + return; + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_LOGICAL_16: + case GFC_DTYPE_INTEGER_16: + unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, + mask, (GFC_INTEGER_16 *) field); + return; +#endif + + case GFC_DTYPE_REAL_4: + unpack0_r4 ((gfc_array_r4 *) ret, (gfc_array_r4 *) vector, + mask, (GFC_REAL_4 *) field); + return; + + case GFC_DTYPE_REAL_8: + unpack0_r8 ((gfc_array_r8 *) ret, (gfc_array_r8*) vector, + mask, (GFC_REAL_8 *) field); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef HAVE_GFC_REAL_10 + case GFC_DTYPE_REAL_10: + unpack0_r10 ((gfc_array_r10 *) ret, (gfc_array_r10 *) vector, + mask, (GFC_REAL_10 *) field); + return; +# endif + +# ifdef HAVE_GFC_REAL_16 + case GFC_DTYPE_REAL_16: + unpack0_r16 ((gfc_array_r16 *) ret, (gfc_array_r16 *) vector, + mask, (GFC_REAL_16 *) field); + return; +# endif +#endif + + case GFC_DTYPE_COMPLEX_4: + unpack0_c4 ((gfc_array_c4 *) ret, (gfc_array_c4 *) vector, + mask, (GFC_COMPLEX_4 *) field); + return; + + case GFC_DTYPE_COMPLEX_8: + unpack0_c8 ((gfc_array_c8 *) ret, (gfc_array_c8 *) vector, + mask, (GFC_COMPLEX_8 *) field); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# ifdef HAVE_GFC_COMPLEX_10 + case GFC_DTYPE_COMPLEX_10: + unpack0_c10 ((gfc_array_c10 *) ret, (gfc_array_c10 *) vector, + mask, (GFC_COMPLEX_10 *) field); + return; +# endif + +# ifdef HAVE_GFC_COMPLEX_16 + case GFC_DTYPE_COMPLEX_16: + unpack0_c16 ((gfc_array_c16 *) ret, (gfc_array_c16 *) vector, + mask, (GFC_COMPLEX_16 *) field); + return; +# endif +#endif + + case GFC_DTYPE_DERIVED_2: + if (GFC_UNALIGNED_2(ret->data) || GFC_UNALIGNED_2(vector->data) + || GFC_UNALIGNED_2(field)) + break; + else + { + unpack0_i2 ((gfc_array_i2 *) ret, (gfc_array_i2 *) vector, + mask, (GFC_INTEGER_2 *) field); + return; + } + + case GFC_DTYPE_DERIVED_4: + if (GFC_UNALIGNED_4(ret->data) || GFC_UNALIGNED_4(vector->data) + || GFC_UNALIGNED_4(field)) + break; + else + { + unpack0_i4 ((gfc_array_i4 *) ret, (gfc_array_i4 *) vector, + mask, (GFC_INTEGER_4 *) field); + return; + } + + case GFC_DTYPE_DERIVED_8: + if (GFC_UNALIGNED_8(ret->data) || GFC_UNALIGNED_8(vector->data) + || GFC_UNALIGNED_8(field)) + break; + else + { + unpack0_i8 ((gfc_array_i8 *) ret, (gfc_array_i8 *) vector, + mask, (GFC_INTEGER_8 *) field); + return; + } + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_DERIVED_16: + if (GFC_UNALIGNED_16(ret->data) || GFC_UNALIGNED_16(vector->data) + || GFC_UNALIGNED_16(field)) + break; + else + { + unpack0_i16 ((gfc_array_i16 *) ret, (gfc_array_i16 *) vector, + mask, (GFC_INTEGER_16 *) field); + return; + } +#endif + + } + + memset (&tmp, 0, sizeof (tmp)); + tmp.dtype = 0; + tmp.data = field; + unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_SIZE (vector)); +} + + +extern void unpack0_char (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const gfc_array_l1 *, + char *, GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(unpack0_char); + +void +unpack0_char (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *vector, const gfc_array_l1 *mask, + char *field, GFC_INTEGER_4 vector_length, + GFC_INTEGER_4 field_length __attribute__((unused))) +{ + gfc_array_char tmp; + + if (unlikely(compile_options.bounds_check)) + unpack_bounds (ret, vector, mask, NULL); + + memset (&tmp, 0, sizeof (tmp)); + tmp.dtype = 0; + tmp.data = field; + unpack_internal (ret, vector, mask, &tmp, vector_length); +} + + +extern void unpack0_char4 (gfc_array_char *, GFC_INTEGER_4, + const gfc_array_char *, const gfc_array_l1 *, + char *, GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(unpack0_char4); + +void +unpack0_char4 (gfc_array_char *ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char *vector, const gfc_array_l1 *mask, + char *field, GFC_INTEGER_4 vector_length, + GFC_INTEGER_4 field_length __attribute__((unused))) +{ + gfc_array_char tmp; + + if (unlikely(compile_options.bounds_check)) + unpack_bounds (ret, vector, mask, NULL); + + memset (&tmp, 0, sizeof (tmp)); + tmp.dtype = 0; + tmp.data = field; + unpack_internal (ret, vector, mask, &tmp, + vector_length * sizeof (gfc_char4_t)); +} diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c new file mode 100644 index 000000000..1a4d7d16e --- /dev/null +++ b/libgfortran/io/close.c @@ -0,0 +1,102 @@ +/* Copyright (C) 2002, 2003, 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Andy Vaught + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "io.h" +#include "unix.h" +#include + +typedef enum +{ CLOSE_DELETE, CLOSE_KEEP, CLOSE_UNSPECIFIED } +close_status; + +static const st_option status_opt[] = { + {"keep", CLOSE_KEEP}, + {"delete", CLOSE_DELETE}, + {NULL, 0} +}; + + +extern void st_close (st_parameter_close *); +export_proto(st_close); + +void +st_close (st_parameter_close *clp) +{ + close_status status; + gfc_unit *u; +#if !HAVE_UNLINK_OPEN_FILE + char * path; + + path = NULL; +#endif + + library_start (&clp->common); + + status = !(clp->common.flags & IOPARM_CLOSE_HAS_STATUS) ? CLOSE_UNSPECIFIED : + find_option (&clp->common, clp->status, clp->status_len, + status_opt, "Bad STATUS parameter in CLOSE statement"); + + if ((clp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + { + library_end (); + return; + } + + u = find_unit (clp->common.unit); + if (u != NULL) + { + if (u->flags.status == STATUS_SCRATCH) + { + if (status == CLOSE_KEEP) + generate_error (&clp->common, LIBERROR_BAD_OPTION, + "Can't KEEP a scratch file on CLOSE"); +#if !HAVE_UNLINK_OPEN_FILE + path = (char *) gfc_alloca (u->file_len + 1); + unpack_filename (path, u->file, u->file_len); +#endif + } + else + { + if (status == CLOSE_DELETE) + { +#if HAVE_UNLINK_OPEN_FILE + delete_file (u); +#else + path = (char *) gfc_alloca (u->file_len + 1); + unpack_filename (path, u->file, u->file_len); +#endif + } + } + + close_unit (u); + +#if !HAVE_UNLINK_OPEN_FILE + if (path != NULL) + unlink (path); +#endif + } + + /* CLOSE on unconnected unit is legal and a no-op: F95 std., 9.3.5. */ + library_end (); +} diff --git a/libgfortran/io/fbuf.c b/libgfortran/io/fbuf.c new file mode 100644 index 000000000..82b3f6ba6 --- /dev/null +++ b/libgfortran/io/fbuf.c @@ -0,0 +1,270 @@ +/* Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. + Contributed by Janne Blomqvist + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +#include "io.h" +#include "fbuf.h" +#include "unix.h" +#include +#include + + +//#define FBUF_DEBUG + + +void +fbuf_init (gfc_unit * u, int len) +{ + if (len == 0) + len = 512; /* Default size. */ + + u->fbuf = get_mem (sizeof (struct fbuf)); + u->fbuf->buf = get_mem (len); + u->fbuf->len = len; + u->fbuf->act = u->fbuf->pos = 0; +} + + +void +fbuf_destroy (gfc_unit * u) +{ + if (u->fbuf == NULL) + return; + if (u->fbuf->buf) + free (u->fbuf->buf); + free (u->fbuf); + u->fbuf = NULL; +} + + +static void +#ifdef FBUF_DEBUG +fbuf_debug (gfc_unit * u, const char * format, ...) +{ + va_list args; + va_start(args, format); + vfprintf(stderr, format, args); + va_end(args); + fprintf (stderr, "fbuf_debug pos: %d, act: %d, buf: ''", + u->fbuf->pos, u->fbuf->act); + for (int ii = 0; ii < u->fbuf->act; ii++) + { + putc (u->fbuf->buf[ii], stderr); + } + fprintf (stderr, "''\n"); +} +#else +fbuf_debug (gfc_unit * u __attribute__ ((unused)), + const char * format __attribute__ ((unused)), + ...) {} +#endif + + + +/* You should probably call this before doing a physical seek on the + underlying device. Returns how much the physical position was + modified. */ + +int +fbuf_reset (gfc_unit * u) +{ + int seekval = 0; + + if (!u->fbuf) + return 0; + + fbuf_debug (u, "fbuf_reset: "); + fbuf_flush (u, u->mode); + /* If we read past the current position, seek the underlying device + back. */ + if (u->mode == READING && u->fbuf->act > u->fbuf->pos) + { + seekval = - (u->fbuf->act - u->fbuf->pos); + fbuf_debug (u, "fbuf_reset seekval %d, ", seekval); + } + u->fbuf->act = u->fbuf->pos = 0; + return seekval; +} + + +/* Return a pointer to the current position in the buffer, and increase + the pointer by len. Makes sure that the buffer is big enough, + reallocating if necessary. */ + +char * +fbuf_alloc (gfc_unit * u, int len) +{ + int newlen; + char *dest; + fbuf_debug (u, "fbuf_alloc len %d, ", len); + if (u->fbuf->pos + len > u->fbuf->len) + { + /* Round up to nearest multiple of the current buffer length. */ + newlen = ((u->fbuf->pos + len) / u->fbuf->len + 1) * u->fbuf->len; + dest = realloc (u->fbuf->buf, newlen); + if (dest == NULL) + return NULL; + u->fbuf->buf = dest; + u->fbuf->len = newlen; + } + + dest = u->fbuf->buf + u->fbuf->pos; + u->fbuf->pos += len; + if (u->fbuf->pos > u->fbuf->act) + u->fbuf->act = u->fbuf->pos; + return dest; +} + + +/* mode argument is WRITING for write mode and READING for read + mode. Return value is 0 for success, -1 on failure. */ + +int +fbuf_flush (gfc_unit * u, unit_mode mode) +{ + int nwritten; + + if (!u->fbuf) + return 0; + + fbuf_debug (u, "fbuf_flush with mode %d: ", mode); + + if (mode == WRITING) + { + if (u->fbuf->pos > 0) + { + nwritten = swrite (u->s, u->fbuf->buf, u->fbuf->pos); + if (nwritten < 0) + return -1; + } + } + /* Salvage remaining bytes for both reading and writing. This + happens with the combination of advance='no' and T edit + descriptors leaving the final position somewhere not at the end + of the record. For reading, this also happens if we sread() past + the record boundary. */ + if (u->fbuf->act > u->fbuf->pos && u->fbuf->pos > 0) + memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->pos, + u->fbuf->act - u->fbuf->pos); + + u->fbuf->act -= u->fbuf->pos; + u->fbuf->pos = 0; + + return 0; +} + + +int +fbuf_seek (gfc_unit * u, int off, int whence) +{ + if (!u->fbuf) + return -1; + + switch (whence) + { + case SEEK_SET: + break; + case SEEK_CUR: + off += u->fbuf->pos; + break; + case SEEK_END: + off += u->fbuf->act; + break; + default: + return -1; + } + + fbuf_debug (u, "fbuf_seek, off %d ", off); + /* The start of the buffer is always equal to the left tab + limit. Moving to the left past the buffer is illegal in C and + would also imply moving past the left tab limit, which is never + allowed in Fortran. Similarly, seeking past the end of the buffer + is not possible, in that case the user must make sure to allocate + space with fbuf_alloc(). So return error if that is + attempted. */ + if (off < 0 || off > u->fbuf->act) + return -1; + u->fbuf->pos = off; + return off; +} + + +/* Fill the buffer with bytes for reading. Returns a pointer to start + reading from. If we hit EOF, returns a short read count. If any + other error occurs, return NULL. After reading, the caller is + expected to call fbuf_seek to update the position with the number + of bytes actually processed. */ + +char * +fbuf_read (gfc_unit * u, int * len) +{ + char *ptr; + int oldact, oldpos; + int readlen = 0; + + fbuf_debug (u, "fbuf_read, len %d: ", *len); + oldact = u->fbuf->act; + oldpos = u->fbuf->pos; + ptr = fbuf_alloc (u, *len); + u->fbuf->pos = oldpos; + if (oldpos + *len > oldact) + { + fbuf_debug (u, "reading %d bytes starting at %d ", + oldpos + *len - oldact, oldact); + readlen = sread (u->s, u->fbuf->buf + oldact, oldpos + *len - oldact); + if (readlen < 0) + return NULL; + *len = oldact - oldpos + readlen; + } + u->fbuf->act = oldact + readlen; + fbuf_debug (u, "fbuf_read done: "); + return ptr; +} + + +/* When the fbuf_getc() inline function runs out of buffer space, it + calls this function to fill the buffer with bytes for + reading. Never call this function directly. */ + +int +fbuf_getc_refill (gfc_unit * u) +{ + int nread; + char *p; + + fbuf_debug (u, "fbuf_getc_refill "); + + /* Read 80 bytes (average line length?). This is a compromise + between not needing to call the read() syscall all the time and + not having to memmove unnecessary stuff when switching to the + next record. */ + nread = 80; + + p = fbuf_read (u, &nread); + + if (p && nread > 0) + return (unsigned char) u->fbuf->buf[u->fbuf->pos++]; + else + return EOF; +} diff --git a/libgfortran/io/fbuf.h b/libgfortran/io/fbuf.h new file mode 100644 index 000000000..3a2883bc5 --- /dev/null +++ b/libgfortran/io/fbuf.h @@ -0,0 +1,87 @@ +/* Copyright (C) 2009 + Free Software Foundation, Inc. + Contributed by Janne Blomqvist + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#ifndef GFOR_FBUF_H +#define GFOR_FBUF_H + +#include "io.h" + + +/* Formatting buffer. This is a temporary scratch buffer used by + formatted read and writes. After every formatted I/O statement, + this buffer is flushed. This buffer is needed since not all devices + are seekable, and T or TL edit descriptors require moving backwards + in the record. However, advance='no' complicates the situation, so + the buffer must only be partially flushed from the end of the last + flush until the current position in the record. */ + +struct fbuf +{ + char *buf; /* Start of buffer. */ + int len; /* Length of buffer. */ + int act; /* Active bytes in buffer. */ + int pos; /* Current position in buffer. */ +}; + +extern void fbuf_init (gfc_unit *, int); +internal_proto(fbuf_init); + +extern void fbuf_destroy (gfc_unit *); +internal_proto(fbuf_destroy); + +extern int fbuf_reset (gfc_unit *); +internal_proto(fbuf_reset); + +extern char * fbuf_alloc (gfc_unit *, int); +internal_proto(fbuf_alloc); + +extern int fbuf_flush (gfc_unit *, unit_mode); +internal_proto(fbuf_flush); + +extern int fbuf_seek (gfc_unit *, int, int); +internal_proto(fbuf_seek); + +extern char * fbuf_read (gfc_unit *, int *); +internal_proto(fbuf_read); + +/* Never call this function, only use fbuf_getc(). */ +extern int fbuf_getc_refill (gfc_unit *); +internal_proto(fbuf_getc_refill); + +static inline int +fbuf_getc (gfc_unit * u) +{ + if (u->fbuf->pos < u->fbuf->act) + return (unsigned char) u->fbuf->buf[u->fbuf->pos++]; + return fbuf_getc_refill (u); +} + +static inline char * +fbuf_getptr (gfc_unit * u) +{ + return (char*) (u->fbuf->buf + u->fbuf->pos); +} + +#endif diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c new file mode 100644 index 000000000..da83aa594 --- /dev/null +++ b/libgfortran/io/file_pos.c @@ -0,0 +1,463 @@ +/* Copyright (C) 2002-2003, 2005, 2006, 2007, 2009, 2010 + Free Software Foundation, Inc. + Contributed by Andy Vaught and Janne Blomqvist + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "io.h" +#include "fbuf.h" +#include "unix.h" +#include + +/* file_pos.c-- Implement the file positioning statements, i.e. BACKSPACE, + ENDFILE, and REWIND as well as the FLUSH statement. */ + + +/* formatted_backspace(fpp, u)-- Move the file back one line. The + current position is after the newline that terminates the previous + record, and we have to sift backwards to find the newline before + that or the start of the file, whichever comes first. */ + +static const int READ_CHUNK = 4096; + +static void +formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) +{ + gfc_offset base; + char p[READ_CHUNK]; + ssize_t n; + + base = stell (u->s) - 1; + + do + { + n = (base < READ_CHUNK) ? base : READ_CHUNK; + base -= n; + if (sseek (u->s, base, SEEK_SET) < 0) + goto io_error; + if (sread (u->s, p, n) != n) + goto io_error; + + /* We have moved backwards from the current position, it should + not be possible to get a short read. Because it is not + clear what to do about such thing, we ignore the possibility. */ + + /* There is no memrchr() in the C library, so we have to do it + ourselves. */ + + while (n > 0) + { + n--; + if (p[n] == '\n') + { + base += n + 1; + goto done; + } + } + + } + while (base != 0); + + /* base is the new pointer. Seek to it exactly. */ + done: + if (sseek (u->s, base, SEEK_SET) < 0) + goto io_error; + u->last_record--; + u->endfile = NO_ENDFILE; + + return; + + io_error: + generate_error (&fpp->common, LIBERROR_OS, NULL); +} + + +/* unformatted_backspace(fpp) -- Move the file backwards for an unformatted + sequential file. We are guaranteed to be between records on entry and + we have to shift to the previous record. Loop over subrecords. */ + +static void +unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) +{ + gfc_offset m, slen; + GFC_INTEGER_4 m4; + GFC_INTEGER_8 m8; + ssize_t length; + int continued; + char p[sizeof (GFC_INTEGER_8)]; + + if (compile_options.record_marker == 0) + length = sizeof (GFC_INTEGER_4); + else + length = compile_options.record_marker; + + do + { + slen = - (gfc_offset) length; + if (sseek (u->s, slen, SEEK_CUR) < 0) + goto io_error; + if (sread (u->s, p, length) != length) + goto io_error; + + /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ + if (likely (u->flags.convert == GFC_CONVERT_NATIVE)) + { + switch (length) + { + case sizeof(GFC_INTEGER_4): + memcpy (&m4, p, sizeof (m4)); + m = m4; + break; + + case sizeof(GFC_INTEGER_8): + memcpy (&m8, p, sizeof (m8)); + m = m8; + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + } + else + { + switch (length) + { + case sizeof(GFC_INTEGER_4): + reverse_memcpy (&m4, p, sizeof (m4)); + m = m4; + break; + + case sizeof(GFC_INTEGER_8): + reverse_memcpy (&m8, p, sizeof (m8)); + m = m8; + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + + } + + continued = m < 0; + if (continued) + m = -m; + + if (sseek (u->s, -m -2 * length, SEEK_CUR) < 0) + goto io_error; + } while (continued); + + u->last_record--; + return; + + io_error: + generate_error (&fpp->common, LIBERROR_OS, NULL); +} + + +extern void st_backspace (st_parameter_filepos *); +export_proto(st_backspace); + +void +st_backspace (st_parameter_filepos *fpp) +{ + gfc_unit *u; + + library_start (&fpp->common); + + u = find_unit (fpp->common.unit); + if (u == NULL) + { + generate_error (&fpp->common, LIBERROR_BAD_UNIT, NULL); + goto done; + } + + /* Direct access is prohibited, and so is unformatted stream access. */ + + + if (u->flags.access == ACCESS_DIRECT) + { + generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT, + "Cannot BACKSPACE a file opened for DIRECT access"); + goto done; + } + + if (u->flags.access == ACCESS_STREAM && u->flags.form == FORM_UNFORMATTED) + { + generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT, + "Cannot BACKSPACE an unformatted stream file"); + goto done; + } + + /* Make sure format buffer is flushed and reset. */ + if (u->flags.form == FORM_FORMATTED) + { + int pos = fbuf_reset (u); + if (pos != 0) + sseek (u->s, pos, SEEK_CUR); + } + + + /* Check for special cases involving the ENDFILE record first. */ + + if (u->endfile == AFTER_ENDFILE) + { + u->endfile = AT_ENDFILE; + u->flags.position = POSITION_APPEND; + sflush (u->s); + } + else + { + if (stell (u->s) == 0) + { + u->flags.position = POSITION_REWIND; + goto done; /* Common special case */ + } + + if (u->mode == WRITING) + { + /* If there are previously written bytes from a write with + ADVANCE="no", add a record marker before performing the + BACKSPACE. */ + + if (u->previous_nonadvancing_write) + finish_last_advance_record (u); + + u->previous_nonadvancing_write = 0; + + unit_truncate (u, stell (u->s), &fpp->common); + u->mode = READING; + } + + if (u->flags.form == FORM_FORMATTED) + formatted_backspace (fpp, u); + else + unformatted_backspace (fpp, u); + + u->flags.position = POSITION_UNSPECIFIED; + u->endfile = NO_ENDFILE; + u->current_record = 0; + u->bytes_left = 0; + } + + done: + if (u != NULL) + unlock_unit (u); + + library_end (); +} + + +extern void st_endfile (st_parameter_filepos *); +export_proto(st_endfile); + +void +st_endfile (st_parameter_filepos *fpp) +{ + gfc_unit *u; + + library_start (&fpp->common); + + u = find_unit (fpp->common.unit); + if (u != NULL) + { + if (u->flags.access == ACCESS_DIRECT) + { + generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT, + "Cannot perform ENDFILE on a file opened " + "for DIRECT access"); + goto done; + } + + if (u->flags.access == ACCESS_SEQUENTIAL + && u->endfile == AFTER_ENDFILE) + { + generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT, + "Cannot perform ENDFILE on a file already " + "positioned after the EOF marker"); + goto done; + } + + /* If there are previously written bytes from a write with ADVANCE="no", + add a record marker before performing the ENDFILE. */ + + if (u->previous_nonadvancing_write) + finish_last_advance_record (u); + + u->previous_nonadvancing_write = 0; + + if (u->current_record) + { + st_parameter_dt dtp; + dtp.common = fpp->common; + memset (&dtp.u.p, 0, sizeof (dtp.u.p)); + dtp.u.p.current_unit = u; + next_record (&dtp, 1); + } + + unit_truncate (u, stell (u->s), &fpp->common); + u->endfile = AFTER_ENDFILE; + if (0 == stell (u->s)) + u->flags.position = POSITION_REWIND; + } + else + { + if (fpp->common.unit < 0) + { + generate_error (&fpp->common, LIBERROR_BAD_OPTION, + "Bad unit number in statement"); + return; + } + + u = find_or_create_unit (fpp->common.unit); + if (u->s == NULL) + { + /* Open the unit with some default flags. */ + st_parameter_open opp; + unit_flags u_flags; + + memset (&u_flags, '\0', sizeof (u_flags)); + u_flags.access = ACCESS_SEQUENTIAL; + u_flags.action = ACTION_READWRITE; + + /* Is it unformatted? */ + if (!(fpp->common.flags & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT + | IOPARM_DT_IONML_SET))) + u_flags.form = FORM_UNFORMATTED; + else + u_flags.form = FORM_UNSPECIFIED; + + u_flags.delim = DELIM_UNSPECIFIED; + u_flags.blank = BLANK_UNSPECIFIED; + u_flags.pad = PAD_UNSPECIFIED; + u_flags.decimal = DECIMAL_UNSPECIFIED; + u_flags.encoding = ENCODING_UNSPECIFIED; + u_flags.async = ASYNC_UNSPECIFIED; + u_flags.round = ROUND_UNSPECIFIED; + u_flags.sign = SIGN_UNSPECIFIED; + u_flags.status = STATUS_UNKNOWN; + u_flags.convert = GFC_CONVERT_NATIVE; + + opp.common = fpp->common; + opp.common.flags &= IOPARM_COMMON_MASK; + u = new_unit (&opp, u, &u_flags); + if (u == NULL) + return; + u->endfile = AFTER_ENDFILE; + } + } + + done: + unlock_unit (u); + + library_end (); +} + + +extern void st_rewind (st_parameter_filepos *); +export_proto(st_rewind); + +void +st_rewind (st_parameter_filepos *fpp) +{ + gfc_unit *u; + + library_start (&fpp->common); + + u = find_unit (fpp->common.unit); + if (u != NULL) + { + if (u->flags.access == ACCESS_DIRECT) + generate_error (&fpp->common, LIBERROR_BAD_OPTION, + "Cannot REWIND a file opened for DIRECT access"); + else + { + /* If there are previously written bytes from a write with ADVANCE="no", + add a record marker before performing the ENDFILE. */ + + if (u->previous_nonadvancing_write) + finish_last_advance_record (u); + + u->previous_nonadvancing_write = 0; + + fbuf_reset (u); + + u->last_record = 0; + + if (sseek (u->s, 0, SEEK_SET) < 0) + generate_error (&fpp->common, LIBERROR_OS, NULL); + + /* Handle special files like /dev/null differently. */ + if (!is_special (u->s)) + { + /* We are rewinding so we are not at the end. */ + u->endfile = NO_ENDFILE; + } + else + { + /* Set this for compatibilty with g77 for /dev/null. */ + if (file_length (u->s) == 0 && stell (u->s) == 0) + u->endfile = AT_ENDFILE; + /* Future refinements on special files can go here. */ + } + + u->current_record = 0; + u->strm_pos = 1; + u->read_bad = 0; + } + /* Update position for INQUIRE. */ + u->flags.position = POSITION_REWIND; + unlock_unit (u); + } + + library_end (); +} + + +extern void st_flush (st_parameter_filepos *); +export_proto(st_flush); + +void +st_flush (st_parameter_filepos *fpp) +{ + gfc_unit *u; + + library_start (&fpp->common); + + u = find_unit (fpp->common.unit); + if (u != NULL) + { + /* Make sure format buffer is flushed. */ + if (u->flags.form == FORM_FORMATTED) + fbuf_flush (u, u->mode); + + flush_sync (u->s); + unlock_unit (u); + } + else + /* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */ + generate_error (&fpp->common, LIBERROR_BAD_OPTION, + "Specified UNIT in FLUSH is not connected"); + + library_end (); +} diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c new file mode 100644 index 000000000..17b58126b --- /dev/null +++ b/libgfortran/io/format.c @@ -0,0 +1,1402 @@ +/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. + Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* format.c-- parse a FORMAT string into a binary format suitable for + * interpretation during I/O statements */ + +#include "io.h" +#include "format.h" +#include +#include +#include +#include + + +static const fnode colon_node = { FMT_COLON, 0, NULL, NULL, {{ 0, 0, 0 }}, 0, + NULL }; + +/* Error messages. */ + +static const char posint_required[] = "Positive width required in format", + period_required[] = "Period required in format", + nonneg_required[] = "Nonnegative width required in format", + unexpected_element[] = "Unexpected element '%c' in format\n", + unexpected_end[] = "Unexpected end of format string", + bad_string[] = "Unterminated character constant in format", + bad_hollerith[] = "Hollerith constant extends past the end of the format", + reversion_error[] = "Exhausted data descriptors in format", + zero_width[] = "Zero width in format descriptor"; + +/* The following routines support caching format data from parsed format strings + into a hash table. This avoids repeatedly parsing duplicate format strings + or format strings in I/O statements that are repeated in loops. */ + + +/* Traverse the table and free all data. */ + +void +free_format_hash_table (gfc_unit *u) +{ + size_t i; + + /* free_format_data handles any NULL pointers. */ + for (i = 0; i < FORMAT_HASH_SIZE; i++) + { + if (u->format_hash_table[i].hashed_fmt != NULL) + { + free_format_data (u->format_hash_table[i].hashed_fmt); + free (u->format_hash_table[i].key); + } + u->format_hash_table[i].key = NULL; + u->format_hash_table[i].key_len = 0; + u->format_hash_table[i].hashed_fmt = NULL; + } +} + +/* Traverse the format_data structure and reset the fnode counters. */ + +static void +reset_node (fnode *fn) +{ + fnode *f; + + fn->count = 0; + fn->current = NULL; + + if (fn->format != FMT_LPAREN) + return; + + for (f = fn->u.child; f; f = f->next) + { + if (f->format == FMT_RPAREN) + break; + reset_node (f); + } +} + +static void +reset_fnode_counters (st_parameter_dt *dtp) +{ + fnode *f; + format_data *fmt; + + fmt = dtp->u.p.fmt; + + /* Clear this pointer at the head so things start at the right place. */ + fmt->array.array[0].current = NULL; + + for (f = fmt->array.array[0].u.child; f; f = f->next) + reset_node (f); +} + + +/* A simple hashing function to generate an index into the hash table. */ + +static inline +uint32_t format_hash (st_parameter_dt *dtp) +{ + char *key; + gfc_charlen_type key_len; + uint32_t hash = 0; + gfc_charlen_type i; + + /* Hash the format string. Super simple, but what the heck! */ + key = dtp->format; + key_len = dtp->format_len; + for (i = 0; i < key_len; i++) + hash ^= key[i]; + hash &= (FORMAT_HASH_SIZE - 1); + return hash; +} + + +static void +save_parsed_format (st_parameter_dt *dtp) +{ + uint32_t hash; + gfc_unit *u; + + hash = format_hash (dtp); + u = dtp->u.p.current_unit; + + /* Index into the hash table. We are simply replacing whatever is there + relying on probability. */ + if (u->format_hash_table[hash].hashed_fmt != NULL) + free_format_data (u->format_hash_table[hash].hashed_fmt); + u->format_hash_table[hash].hashed_fmt = NULL; + + if (u->format_hash_table[hash].key != NULL) + free (u->format_hash_table[hash].key); + u->format_hash_table[hash].key = dtp->format; + + u->format_hash_table[hash].key_len = dtp->format_len; + u->format_hash_table[hash].hashed_fmt = dtp->u.p.fmt; +} + + +static format_data * +find_parsed_format (st_parameter_dt *dtp) +{ + uint32_t hash; + gfc_unit *u; + + hash = format_hash (dtp); + u = dtp->u.p.current_unit; + + if (u->format_hash_table[hash].key != NULL) + { + /* See if it matches. */ + if (u->format_hash_table[hash].key_len == dtp->format_len) + { + /* So far so good. */ + if (strncmp (u->format_hash_table[hash].key, + dtp->format, dtp->format_len) == 0) + return u->format_hash_table[hash].hashed_fmt; + } + } + return NULL; +} + + +/* next_char()-- Return the next character in the format string. + * Returns -1 when the string is done. If the literal flag is set, + * spaces are significant, otherwise they are not. */ + +static int +next_char (format_data *fmt, int literal) +{ + int c; + + do + { + if (fmt->format_string_len == 0) + return -1; + + fmt->format_string_len--; + c = toupper (*fmt->format_string++); + fmt->error_element = c; + } + while ((c == ' ' || c == '\t') && !literal); + + return c; +} + + +/* unget_char()-- Back up one character position. */ + +#define unget_char(fmt) \ + { fmt->format_string--; fmt->format_string_len++; } + + +/* get_fnode()-- Allocate a new format node, inserting it into the + * current singly linked list. These are initially allocated from the + * static buffer. */ + +static fnode * +get_fnode (format_data *fmt, fnode **head, fnode **tail, format_token t) +{ + fnode *f; + + if (fmt->avail == &fmt->last->array[FARRAY_SIZE]) + { + fmt->last->next = get_mem (sizeof (fnode_array)); + fmt->last = fmt->last->next; + fmt->last->next = NULL; + fmt->avail = &fmt->last->array[0]; + } + f = fmt->avail++; + memset (f, '\0', sizeof (fnode)); + + if (*head == NULL) + *head = *tail = f; + else + { + (*tail)->next = f; + *tail = f; + } + + f->format = t; + f->repeat = -1; + f->source = fmt->format_string; + return f; +} + + +/* free_format_data()-- Free all allocated format data. */ + +void +free_format_data (format_data *fmt) +{ + fnode_array *fa, *fa_next; + + + if (fmt == NULL) + return; + + for (fa = fmt->array.next; fa; fa = fa_next) + { + fa_next = fa->next; + free (fa); + } + + free (fmt); + fmt = NULL; +} + + +/* format_lex()-- Simple lexical analyzer for getting the next token + * in a FORMAT string. We support a one-level token pushback in the + * fmt->saved_token variable. */ + +static format_token +format_lex (format_data *fmt) +{ + format_token token; + int negative_flag; + int c; + char delim; + + if (fmt->saved_token != FMT_NONE) + { + token = fmt->saved_token; + fmt->saved_token = FMT_NONE; + return token; + } + + negative_flag = 0; + c = next_char (fmt, 0); + + switch (c) + { + case '*': + token = FMT_STAR; + break; + + case '(': + token = FMT_LPAREN; + break; + + case ')': + token = FMT_RPAREN; + break; + + case '-': + negative_flag = 1; + /* Fall Through */ + + case '+': + c = next_char (fmt, 0); + if (!isdigit (c)) + { + token = FMT_UNKNOWN; + break; + } + + fmt->value = c - '0'; + + for (;;) + { + c = next_char (fmt, 0); + if (!isdigit (c)) + break; + + fmt->value = 10 * fmt->value + c - '0'; + } + + unget_char (fmt); + + if (negative_flag) + fmt->value = -fmt->value; + token = FMT_SIGNED_INT; + break; + + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + fmt->value = c - '0'; + + for (;;) + { + c = next_char (fmt, 0); + if (!isdigit (c)) + break; + + fmt->value = 10 * fmt->value + c - '0'; + } + + unget_char (fmt); + token = (fmt->value == 0) ? FMT_ZERO : FMT_POSINT; + break; + + case '.': + token = FMT_PERIOD; + break; + + case ',': + token = FMT_COMMA; + break; + + case ':': + token = FMT_COLON; + break; + + case '/': + token = FMT_SLASH; + break; + + case '$': + token = FMT_DOLLAR; + break; + + case 'T': + switch (next_char (fmt, 0)) + { + case 'L': + token = FMT_TL; + break; + case 'R': + token = FMT_TR; + break; + default: + token = FMT_T; + unget_char (fmt); + break; + } + + break; + + case 'X': + token = FMT_X; + break; + + case 'S': + switch (next_char (fmt, 0)) + { + case 'S': + token = FMT_SS; + break; + case 'P': + token = FMT_SP; + break; + default: + token = FMT_S; + unget_char (fmt); + break; + } + + break; + + case 'B': + switch (next_char (fmt, 0)) + { + case 'N': + token = FMT_BN; + break; + case 'Z': + token = FMT_BZ; + break; + default: + token = FMT_B; + unget_char (fmt); + break; + } + + break; + + case '\'': + case '"': + delim = c; + + fmt->string = fmt->format_string; + fmt->value = 0; /* This is the length of the string */ + + for (;;) + { + c = next_char (fmt, 1); + if (c == -1) + { + token = FMT_BADSTRING; + fmt->error = bad_string; + break; + } + + if (c == delim) + { + c = next_char (fmt, 1); + + if (c == -1) + { + token = FMT_BADSTRING; + fmt->error = bad_string; + break; + } + + if (c != delim) + { + unget_char (fmt); + token = FMT_STRING; + break; + } + } + + fmt->value++; + } + + break; + + case 'P': + token = FMT_P; + break; + + case 'I': + token = FMT_I; + break; + + case 'O': + token = FMT_O; + break; + + case 'Z': + token = FMT_Z; + break; + + case 'F': + token = FMT_F; + break; + + case 'E': + switch (next_char (fmt, 0)) + { + case 'N': + token = FMT_EN; + break; + case 'S': + token = FMT_ES; + break; + default: + token = FMT_E; + unget_char (fmt); + break; + } + break; + + case 'G': + token = FMT_G; + break; + + case 'H': + token = FMT_H; + break; + + case 'L': + token = FMT_L; + break; + + case 'A': + token = FMT_A; + break; + + case 'D': + switch (next_char (fmt, 0)) + { + case 'P': + token = FMT_DP; + break; + case 'C': + token = FMT_DC; + break; + default: + token = FMT_D; + unget_char (fmt); + break; + } + break; + + case 'R': + switch (next_char (fmt, 0)) + { + case 'C': + token = FMT_RC; + break; + case 'D': + token = FMT_RD; + break; + case 'N': + token = FMT_RN; + break; + case 'P': + token = FMT_RP; + break; + case 'U': + token = FMT_RU; + break; + case 'Z': + token = FMT_RZ; + break; + default: + unget_char (fmt); + token = FMT_UNKNOWN; + break; + } + break; + + case -1: + token = FMT_END; + break; + + default: + token = FMT_UNKNOWN; + break; + } + + return token; +} + + +/* parse_format_list()-- Parse a format list. Assumes that a left + * paren has already been seen. Returns a list representing the + * parenthesis node which contains the rest of the list. */ + +static fnode * +parse_format_list (st_parameter_dt *dtp, bool *seen_dd) +{ + fnode *head, *tail; + format_token t, u, t2; + int repeat; + format_data *fmt = dtp->u.p.fmt; + bool seen_data_desc = false; + + head = tail = NULL; + + /* Get the next format item */ + format_item: + t = format_lex (fmt); + format_item_1: + switch (t) + { + case FMT_STAR: + t = format_lex (fmt); + if (t != FMT_LPAREN) + { + fmt->error = "Left parenthesis required after '*'"; + goto finished; + } + get_fnode (fmt, &head, &tail, FMT_LPAREN); + tail->repeat = -2; /* Signifies unlimited format. */ + tail->u.child = parse_format_list (dtp, &seen_data_desc); + if (fmt->error != NULL) + goto finished; + if (!seen_data_desc) + { + fmt->error = "'*' requires at least one associated data descriptor"; + goto finished; + } + goto between_desc; + + case FMT_POSINT: + repeat = fmt->value; + + t = format_lex (fmt); + switch (t) + { + case FMT_LPAREN: + get_fnode (fmt, &head, &tail, FMT_LPAREN); + tail->repeat = repeat; + tail->u.child = parse_format_list (dtp, &seen_data_desc); + *seen_dd = seen_data_desc; + if (fmt->error != NULL) + goto finished; + + goto between_desc; + + case FMT_SLASH: + get_fnode (fmt, &head, &tail, FMT_SLASH); + tail->repeat = repeat; + goto optional_comma; + + case FMT_X: + get_fnode (fmt, &head, &tail, FMT_X); + tail->repeat = 1; + tail->u.k = fmt->value; + goto between_desc; + + case FMT_P: + goto p_descriptor; + + default: + goto data_desc; + } + + case FMT_LPAREN: + get_fnode (fmt, &head, &tail, FMT_LPAREN); + tail->repeat = 1; + tail->u.child = parse_format_list (dtp, &seen_data_desc); + *seen_dd = seen_data_desc; + if (fmt->error != NULL) + goto finished; + + goto between_desc; + + case FMT_SIGNED_INT: /* Signed integer can only precede a P format. */ + case FMT_ZERO: /* Same for zero. */ + t = format_lex (fmt); + if (t != FMT_P) + { + fmt->error = "Expected P edit descriptor in format"; + goto finished; + } + + p_descriptor: + get_fnode (fmt, &head, &tail, FMT_P); + tail->u.k = fmt->value; + tail->repeat = 1; + + t = format_lex (fmt); + if (t == FMT_F || t == FMT_EN || t == FMT_ES || t == FMT_D + || t == FMT_G || t == FMT_E) + { + repeat = 1; + goto data_desc; + } + + if (t != FMT_COMMA && t != FMT_RPAREN && t != FMT_SLASH + && t != FMT_POSINT) + { + fmt->error = "Comma required after P descriptor"; + goto finished; + } + + fmt->saved_token = t; + goto optional_comma; + + case FMT_P: /* P and X require a prior number */ + fmt->error = "P descriptor requires leading scale factor"; + goto finished; + + case FMT_X: +/* + EXTENSION! + + If we would be pedantic in the library, we would have to reject + an X descriptor without an integer prefix: + + fmt->error = "X descriptor requires leading space count"; + goto finished; + + However, this is an extension supported by many Fortran compilers, + including Cray, HP, AIX, and IRIX. Therefore, we allow it in the + runtime library, and make the front end reject it if the compiler + is in pedantic mode. The interpretation of 'X' is '1X'. +*/ + get_fnode (fmt, &head, &tail, FMT_X); + tail->repeat = 1; + tail->u.k = 1; + goto between_desc; + + case FMT_STRING: + get_fnode (fmt, &head, &tail, FMT_STRING); + tail->u.string.p = fmt->string; + tail->u.string.length = fmt->value; + tail->repeat = 1; + goto optional_comma; + + case FMT_RC: + case FMT_RD: + case FMT_RN: + case FMT_RP: + case FMT_RU: + case FMT_RZ: + notify_std (&dtp->common, GFC_STD_F2003, "Fortran 2003: Round " + "descriptor not allowed"); + get_fnode (fmt, &head, &tail, t); + tail->repeat = 1; + goto between_desc; + + case FMT_DC: + case FMT_DP: + notify_std (&dtp->common, GFC_STD_F2003, "Fortran 2003: DC or DP " + "descriptor not allowed"); + /* Fall through. */ + case FMT_S: + case FMT_SS: + case FMT_SP: + case FMT_BN: + case FMT_BZ: + get_fnode (fmt, &head, &tail, t); + tail->repeat = 1; + goto between_desc; + + case FMT_COLON: + get_fnode (fmt, &head, &tail, FMT_COLON); + tail->repeat = 1; + goto optional_comma; + + case FMT_SLASH: + get_fnode (fmt, &head, &tail, FMT_SLASH); + tail->repeat = 1; + tail->u.r = 1; + goto optional_comma; + + case FMT_DOLLAR: + get_fnode (fmt, &head, &tail, FMT_DOLLAR); + tail->repeat = 1; + notify_std (&dtp->common, GFC_STD_GNU, "Extension: $ descriptor"); + goto between_desc; + + case FMT_T: + case FMT_TL: + case FMT_TR: + t2 = format_lex (fmt); + if (t2 != FMT_POSINT) + { + fmt->error = posint_required; + goto finished; + } + get_fnode (fmt, &head, &tail, t); + tail->u.n = fmt->value; + tail->repeat = 1; + goto between_desc; + + case FMT_I: + case FMT_B: + case FMT_O: + case FMT_Z: + case FMT_E: + case FMT_EN: + case FMT_ES: + case FMT_D: + case FMT_L: + case FMT_A: + case FMT_F: + case FMT_G: + repeat = 1; + *seen_dd = true; + goto data_desc; + + case FMT_H: + get_fnode (fmt, &head, &tail, FMT_STRING); + if (fmt->format_string_len < 1) + { + fmt->error = bad_hollerith; + goto finished; + } + + tail->u.string.p = fmt->format_string; + tail->u.string.length = 1; + tail->repeat = 1; + + fmt->format_string++; + fmt->format_string_len--; + + goto between_desc; + + case FMT_END: + fmt->error = unexpected_end; + goto finished; + + case FMT_BADSTRING: + goto finished; + + case FMT_RPAREN: + goto finished; + + default: + fmt->error = unexpected_element; + goto finished; + } + + /* In this state, t must currently be a data descriptor. Deal with + things that can/must follow the descriptor */ + data_desc: + switch (t) + { + case FMT_L: + t = format_lex (fmt); + if (t != FMT_POSINT) + { + if (notification_std(GFC_STD_GNU) == NOTIFICATION_ERROR) + { + fmt->error = posint_required; + goto finished; + } + else + { + fmt->saved_token = t; + fmt->value = 1; /* Default width */ + notify_std (&dtp->common, GFC_STD_GNU, posint_required); + } + } + + get_fnode (fmt, &head, &tail, FMT_L); + tail->u.n = fmt->value; + tail->repeat = repeat; + break; + + case FMT_A: + t = format_lex (fmt); + if (t == FMT_ZERO) + { + fmt->error = zero_width; + goto finished; + } + + if (t != FMT_POSINT) + { + fmt->saved_token = t; + fmt->value = -1; /* Width not present */ + } + + get_fnode (fmt, &head, &tail, FMT_A); + tail->repeat = repeat; + tail->u.n = fmt->value; + break; + + case FMT_D: + case FMT_E: + case FMT_F: + case FMT_G: + case FMT_EN: + case FMT_ES: + get_fnode (fmt, &head, &tail, t); + tail->repeat = repeat; + + u = format_lex (fmt); + if (t == FMT_G && u == FMT_ZERO) + { + if (notification_std (GFC_STD_F2008) == NOTIFICATION_ERROR + || dtp->u.p.mode == READING) + { + fmt->error = zero_width; + goto finished; + } + tail->u.real.w = 0; + u = format_lex (fmt); + if (u != FMT_PERIOD) + { + fmt->saved_token = u; + break; + } + + u = format_lex (fmt); + if (u != FMT_POSINT) + { + fmt->error = posint_required; + goto finished; + } + tail->u.real.d = fmt->value; + break; + } + if (t == FMT_F && dtp->u.p.mode == WRITING) + { + if (u != FMT_POSINT && u != FMT_ZERO) + { + fmt->error = nonneg_required; + goto finished; + } + } + else if (u != FMT_POSINT) + { + fmt->error = posint_required; + goto finished; + } + + tail->u.real.w = fmt->value; + t2 = t; + t = format_lex (fmt); + if (t != FMT_PERIOD) + { + /* We treat a missing decimal descriptor as 0. Note: This is only + allowed if -std=legacy, otherwise an error occurs. */ + if (compile_options.warn_std != 0) + { + fmt->error = period_required; + goto finished; + } + fmt->saved_token = t; + tail->u.real.d = 0; + tail->u.real.e = -1; + break; + } + + t = format_lex (fmt); + if (t != FMT_ZERO && t != FMT_POSINT) + { + fmt->error = nonneg_required; + goto finished; + } + + tail->u.real.d = fmt->value; + tail->u.real.e = -1; + + if (t2 == FMT_D || t2 == FMT_F) + break; + + + /* Look for optional exponent */ + t = format_lex (fmt); + if (t != FMT_E) + fmt->saved_token = t; + else + { + t = format_lex (fmt); + if (t != FMT_POSINT) + { + fmt->error = "Positive exponent width required in format"; + goto finished; + } + + tail->u.real.e = fmt->value; + } + + break; + + case FMT_H: + if (repeat > fmt->format_string_len) + { + fmt->error = bad_hollerith; + goto finished; + } + + get_fnode (fmt, &head, &tail, FMT_STRING); + tail->u.string.p = fmt->format_string; + tail->u.string.length = repeat; + tail->repeat = 1; + + fmt->format_string += fmt->value; + fmt->format_string_len -= repeat; + + break; + + case FMT_I: + case FMT_B: + case FMT_O: + case FMT_Z: + get_fnode (fmt, &head, &tail, t); + tail->repeat = repeat; + + t = format_lex (fmt); + + if (dtp->u.p.mode == READING) + { + if (t != FMT_POSINT) + { + fmt->error = posint_required; + goto finished; + } + } + else + { + if (t != FMT_ZERO && t != FMT_POSINT) + { + fmt->error = nonneg_required; + goto finished; + } + } + + tail->u.integer.w = fmt->value; + tail->u.integer.m = -1; + + t = format_lex (fmt); + if (t != FMT_PERIOD) + { + fmt->saved_token = t; + } + else + { + t = format_lex (fmt); + if (t != FMT_ZERO && t != FMT_POSINT) + { + fmt->error = nonneg_required; + goto finished; + } + + tail->u.integer.m = fmt->value; + } + + if (tail->u.integer.w != 0 && tail->u.integer.m > tail->u.integer.w) + { + fmt->error = "Minimum digits exceeds field width"; + goto finished; + } + + break; + + default: + fmt->error = unexpected_element; + goto finished; + } + + /* Between a descriptor and what comes next */ + between_desc: + t = format_lex (fmt); + switch (t) + { + case FMT_COMMA: + goto format_item; + + case FMT_RPAREN: + goto finished; + + case FMT_SLASH: + case FMT_COLON: + get_fnode (fmt, &head, &tail, t); + tail->repeat = 1; + goto optional_comma; + + case FMT_END: + fmt->error = unexpected_end; + goto finished; + + default: + /* Assume a missing comma, this is a GNU extension */ + goto format_item_1; + } + + /* Optional comma is a weird between state where we've just finished + reading a colon, slash or P descriptor. */ + optional_comma: + t = format_lex (fmt); + switch (t) + { + case FMT_COMMA: + break; + + case FMT_RPAREN: + goto finished; + + default: /* Assume that we have another format item */ + fmt->saved_token = t; + break; + } + + goto format_item; + + finished: + + return head; +} + + +/* format_error()-- Generate an error message for a format statement. + * If the node that gives the location of the error is NULL, the error + * is assumed to happen at parse time, and the current location of the + * parser is shown. + * + * We generate a message showing where the problem is. We take extra + * care to print only the relevant part of the format if it is longer + * than a standard 80 column display. */ + +void +format_error (st_parameter_dt *dtp, const fnode *f, const char *message) +{ + int width, i, j, offset; + char *p, buffer[300]; + format_data *fmt = dtp->u.p.fmt; + + if (f != NULL) + fmt->format_string = f->source; + + if (message == unexpected_element) + sprintf (buffer, message, fmt->error_element); + else + sprintf (buffer, "%s\n", message); + + j = fmt->format_string - dtp->format; + + offset = (j > 60) ? j - 40 : 0; + + j -= offset; + width = dtp->format_len - offset; + + if (width > 80) + width = 80; + + /* Show the format */ + + p = strchr (buffer, '\0'); + + memcpy (p, dtp->format + offset, width); + + p += width; + *p++ = '\n'; + + /* Show where the problem is */ + + for (i = 1; i < j; i++) + *p++ = ' '; + + *p++ = '^'; + *p = '\0'; + + generate_error (&dtp->common, LIBERROR_FORMAT, buffer); +} + + +/* revert()-- Do reversion of the format. Control reverts to the left + * parenthesis that matches the rightmost right parenthesis. From our + * tree structure, we are looking for the rightmost parenthesis node + * at the second level, the first level always being a single + * parenthesis node. If this node doesn't exit, we use the top + * level. */ + +static void +revert (st_parameter_dt *dtp) +{ + fnode *f, *r; + format_data *fmt = dtp->u.p.fmt; + + dtp->u.p.reversion_flag = 1; + + r = NULL; + + for (f = fmt->array.array[0].u.child; f; f = f->next) + if (f->format == FMT_LPAREN) + r = f; + + /* If r is NULL because no node was found, the whole tree will be used */ + + fmt->array.array[0].current = r; + fmt->array.array[0].count = 0; +} + +/* parse_format()-- Parse a format string. */ + +void +parse_format (st_parameter_dt *dtp) +{ + format_data *fmt; + bool format_cache_ok, seen_data_desc = false; + + /* Don't cache for internal units and set an arbitrary limit on the size of + format strings we will cache. (Avoids memory issues.) */ + format_cache_ok = !is_internal_unit (dtp); + + /* Lookup format string to see if it has already been parsed. */ + if (format_cache_ok) + { + dtp->u.p.fmt = find_parsed_format (dtp); + + if (dtp->u.p.fmt != NULL) + { + dtp->u.p.fmt->reversion_ok = 0; + dtp->u.p.fmt->saved_token = FMT_NONE; + dtp->u.p.fmt->saved_format = NULL; + reset_fnode_counters (dtp); + return; + } + } + + /* Not found so proceed as follows. */ + + if (format_cache_ok) + { + char *fmt_string = get_mem (dtp->format_len); + memcpy (fmt_string, dtp->format, dtp->format_len); + dtp->format = fmt_string; + } + + dtp->u.p.fmt = fmt = get_mem (sizeof (format_data)); + fmt->format_string = dtp->format; + fmt->format_string_len = dtp->format_len; + + fmt->string = NULL; + fmt->saved_token = FMT_NONE; + fmt->error = NULL; + fmt->value = 0; + + /* Initialize variables used during traversal of the tree. */ + + fmt->reversion_ok = 0; + fmt->saved_format = NULL; + + /* Allocate the first format node as the root of the tree. */ + + fmt->last = &fmt->array; + fmt->last->next = NULL; + fmt->avail = &fmt->array.array[0]; + + memset (fmt->avail, 0, sizeof (*fmt->avail)); + fmt->avail->format = FMT_LPAREN; + fmt->avail->repeat = 1; + fmt->avail++; + + if (format_lex (fmt) == FMT_LPAREN) + fmt->array.array[0].u.child = parse_format_list (dtp, &seen_data_desc); + else + fmt->error = "Missing initial left parenthesis in format"; + + if (fmt->error) + { + format_error (dtp, NULL, fmt->error); + if (format_cache_ok) + free (dtp->format); + free_format_hash_table (dtp->u.p.current_unit); + return; + } + + if (format_cache_ok) + save_parsed_format (dtp); + else + dtp->u.p.format_not_saved = 1; +} + + +/* next_format0()-- Get the next format node without worrying about + * reversion. Returns NULL when we hit the end of the list. + * Parenthesis nodes are incremented after the list has been + * exhausted, other nodes are incremented before they are returned. */ + +static const fnode * +next_format0 (fnode * f) +{ + const fnode *r; + + if (f == NULL) + return NULL; + + if (f->format != FMT_LPAREN) + { + f->count++; + if (f->count <= f->repeat) + return f; + + f->count = 0; + return NULL; + } + + /* Deal with a parenthesis node with unlimited format. */ + + if (f->repeat == -2) /* -2 signifies unlimited. */ + for (;;) + { + if (f->current == NULL) + f->current = f->u.child; + + for (; f->current != NULL; f->current = f->current->next) + { + r = next_format0 (f->current); + if (r != NULL) + return r; + } + } + + /* Deal with a parenthesis node with specific repeat count. */ + for (; f->count < f->repeat; f->count++) + { + if (f->current == NULL) + f->current = f->u.child; + + for (; f->current != NULL; f->current = f->current->next) + { + r = next_format0 (f->current); + if (r != NULL) + return r; + } + } + + f->count = 0; + return NULL; +} + + +/* next_format()-- Return the next format node. If the format list + * ends up being exhausted, we do reversion. Reversion is only + * allowed if we've seen a data descriptor since the + * initialization or the last reversion. We return NULL if there + * are no more data descriptors to return (which is an error + * condition). */ + +const fnode * +next_format (st_parameter_dt *dtp) +{ + format_token t; + const fnode *f; + format_data *fmt = dtp->u.p.fmt; + + if (fmt->saved_format != NULL) + { /* Deal with a pushed-back format node */ + f = fmt->saved_format; + fmt->saved_format = NULL; + goto done; + } + + f = next_format0 (&fmt->array.array[0]); + if (f == NULL) + { + if (!fmt->reversion_ok) + return NULL; + + fmt->reversion_ok = 0; + revert (dtp); + + f = next_format0 (&fmt->array.array[0]); + if (f == NULL) + { + format_error (dtp, NULL, reversion_error); + return NULL; + } + + /* Push the first reverted token and return a colon node in case + * there are no more data items. */ + + fmt->saved_format = f; + return &colon_node; + } + + /* If this is a data edit descriptor, then reversion has become OK. */ + done: + t = f->format; + + if (!fmt->reversion_ok && + (t == FMT_I || t == FMT_B || t == FMT_O || t == FMT_Z || t == FMT_F || + t == FMT_E || t == FMT_EN || t == FMT_ES || t == FMT_G || t == FMT_L || + t == FMT_A || t == FMT_D)) + fmt->reversion_ok = 1; + return f; +} + + +/* unget_format()-- Push the given format back so that it will be + * returned on the next call to next_format() without affecting + * counts. This is necessary when we've encountered a data + * descriptor, but don't know what the data item is yet. The format + * node is pushed back, and we return control to the main program, + * which calls the library back with the data item (or not). */ + +void +unget_format (st_parameter_dt *dtp, const fnode *f) +{ + dtp->u.p.fmt->saved_format = f; +} + diff --git a/libgfortran/io/format.h b/libgfortran/io/format.h new file mode 100644 index 000000000..87d86419b --- /dev/null +++ b/libgfortran/io/format.h @@ -0,0 +1,145 @@ +/* Copyright (C) 2009, 2010 + Free Software Foundation, Inc. + Contributed by Janne Blomqvist + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#ifndef GFOR_FORMAT_H +#define GFOR_FORMAT_H + +#include "io.h" + + +/* Format tokens. Only about half of these can be stored in the + format nodes. */ + +typedef enum +{ + FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD, + FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL, + FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING, + FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F, + FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC, + FMT_DP, FMT_STAR, FMT_RC, FMT_RD, FMT_RN, FMT_RP, FMT_RU, FMT_RZ +} +format_token; + + +/* Format nodes. A format string is converted into a tree of these + structures, which is traversed as part of a data transfer statement. */ + +struct fnode +{ + format_token format; + int repeat; + struct fnode *next; + char *source; + + union + { + struct + { + int w, d, e; + } + real; + + struct + { + int length; + char *p; + } + string; + + struct + { + int w, m; + } + integer; + + int w; + int k; + int r; + int n; + + struct fnode *child; + } + u; + + /* Members for traversing the tree during data transfer. */ + + int count; + struct fnode *current; + +}; + + +/* A storage structures for format node data. */ + +#define FARRAY_SIZE 64 + +typedef struct fnode_array +{ + struct fnode_array *next; + fnode array[FARRAY_SIZE]; +} +fnode_array; + + +typedef struct format_data +{ + char *format_string, *string; + const char *error; + char error_element; + format_token saved_token; + int value, format_string_len, reversion_ok; + fnode *avail; + const fnode *saved_format; + fnode_array *last; + fnode_array array; +} +format_data; + +extern void parse_format (st_parameter_dt *); +internal_proto(parse_format); + +extern const fnode *next_format (st_parameter_dt *); +internal_proto(next_format); + +extern void unget_format (st_parameter_dt *, const fnode *); +internal_proto(unget_format); + +extern void format_error (st_parameter_dt *, const fnode *, const char *); +internal_proto(format_error); + +extern void free_format_data (struct format_data *); +internal_proto(free_format_data); + +extern void free_format_hash_table (gfc_unit *); +internal_proto(free_format_hash_table); + +extern void init_format_hash (st_parameter_dt *); +internal_proto(init_format_hash); + +extern void free_format_hash (st_parameter_dt *); +internal_proto(free_format_hash); + +#endif diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c new file mode 100644 index 000000000..97bd9b638 --- /dev/null +++ b/libgfortran/io/inquire.c @@ -0,0 +1,708 @@ +/* Copyright (C) 2002, 2003, 2005, 2007, 2009, 2010, 2011 + Free Software Foundation, Inc. + Contributed by Andy Vaught + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* Implement the non-IOLENGTH variant of the INQUIRY statement */ + +#include "io.h" +#include "unix.h" +#include + + +static const char undefined[] = "UNDEFINED"; + + +/* inquire_via_unit()-- Inquiry via unit number. The unit might not exist. */ + +static void +inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) +{ + const char *p; + GFC_INTEGER_4 cf = iqp->common.flags; + + if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) + { + *iqp->exist = (iqp->common.unit >= 0 + && iqp->common.unit <= GFC_INTEGER_4_HUGE); + + if ((cf & IOPARM_INQUIRE_HAS_FILE) == 0) + { + if (!(*iqp->exist)) + *iqp->common.iostat = LIBERROR_BAD_UNIT; + *iqp->exist = *iqp->exist + && (*iqp->common.iostat != LIBERROR_BAD_UNIT); + } + } + + if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0) + *iqp->opened = (u != NULL); + + if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0) + *iqp->number = (u != NULL) ? u->unit_number : -1; + + if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0) + *iqp->named = (u != NULL && u->flags.status != STATUS_SCRATCH); + + if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0 + && u != NULL && u->flags.status != STATUS_SCRATCH) + { +#if defined(HAVE_TTYNAME_R) || defined(HAVE_TTYNAME) + if (u->unit_number == options.stdin_unit + || u->unit_number == options.stdout_unit + || u->unit_number == options.stderr_unit) + { + int err = stream_ttyname (u->s, iqp->name, iqp->name_len); + if (err == 0) + { + gfc_charlen_type tmplen = strlen (iqp->name); + if (iqp->name_len > tmplen) + memset (&iqp->name[tmplen], ' ', iqp->name_len - tmplen); + } + else /* If ttyname does not work, go with the default. */ + fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len); + } + else + fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len); +#elif defined __MINGW32__ + if (u->unit_number == options.stdin_unit) + fstrcpy (iqp->name, iqp->name_len, "CONIN$", sizeof("CONIN$")); + else if (u->unit_number == options.stdout_unit) + fstrcpy (iqp->name, iqp->name_len, "CONOUT$", sizeof("CONOUT$")); + else if (u->unit_number == options.stderr_unit) + fstrcpy (iqp->name, iqp->name_len, "CONERR$", sizeof("CONERR$")); + else + fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len); +#else + fstrcpy (iqp->name, iqp->name_len, u->file, u->file_len); +#endif + } + + if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) + { + if (u == NULL) + p = undefined; + else + switch (u->flags.access) + { + case ACCESS_SEQUENTIAL: + p = "SEQUENTIAL"; + break; + case ACCESS_DIRECT: + p = "DIRECT"; + break; + case ACCESS_STREAM: + p = "STREAM"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad access"); + } + + cf_strcpy (iqp->access, iqp->access_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0) + { + if (u == NULL) + p = inquire_sequential (NULL, 0); + else + switch (u->flags.access) + { + case ACCESS_DIRECT: + case ACCESS_STREAM: + p = "NO"; + break; + case ACCESS_SEQUENTIAL: + p = "YES"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad access"); + } + + cf_strcpy (iqp->sequential, iqp->sequential_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0) + { + if (u == NULL) + p = inquire_direct (NULL, 0); + else + switch (u->flags.access) + { + case ACCESS_SEQUENTIAL: + case ACCESS_STREAM: + p = "NO"; + break; + case ACCESS_DIRECT: + p = "YES"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad access"); + } + + cf_strcpy (iqp->direct, iqp->direct_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0) + { + if (u == NULL) + p = undefined; + else + switch (u->flags.form) + { + case FORM_FORMATTED: + p = "FORMATTED"; + break; + case FORM_UNFORMATTED: + p = "UNFORMATTED"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad form"); + } + + cf_strcpy (iqp->form, iqp->form_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0) + { + if (u == NULL) + p = inquire_formatted (NULL, 0); + else + switch (u->flags.form) + { + case FORM_FORMATTED: + p = "YES"; + break; + case FORM_UNFORMATTED: + p = "NO"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad form"); + } + + cf_strcpy (iqp->formatted, iqp->formatted_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0) + { + if (u == NULL) + p = inquire_unformatted (NULL, 0); + else + switch (u->flags.form) + { + case FORM_FORMATTED: + p = "NO"; + break; + case FORM_UNFORMATTED: + p = "YES"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad form"); + } + + cf_strcpy (iqp->unformatted, iqp->unformatted_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0) + *iqp->recl_out = (u != NULL) ? u->recl : 0; + + if ((cf & IOPARM_INQUIRE_HAS_STRM_POS_OUT) != 0) + *iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0; + + if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0) + { + /* This only makes sense in the context of DIRECT access. */ + if (u != NULL && u->flags.access == ACCESS_DIRECT) + *iqp->nextrec = u->last_record + 1; + else + *iqp->nextrec = 0; + } + + if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) + { + if (u == NULL || u->flags.form != FORM_FORMATTED) + p = undefined; + else + switch (u->flags.blank) + { + case BLANK_NULL: + p = "NULL"; + break; + case BLANK_ZERO: + p = "ZERO"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad blank"); + } + + cf_strcpy (iqp->blank, iqp->blank_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) + { + if (u == NULL || u->flags.form != FORM_FORMATTED) + p = undefined; + else + switch (u->flags.pad) + { + case PAD_YES: + p = "YES"; + break; + case PAD_NO: + p = "NO"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad pad"); + } + + cf_strcpy (iqp->pad, iqp->pad_len, p); + } + + if (cf & IOPARM_INQUIRE_HAS_FLAGS2) + { + GFC_INTEGER_4 cf2 = iqp->flags2; + + if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0) + *iqp->pending = 0; + + if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0) + *iqp->id = 0; + + if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) + { + if (u == NULL || u->flags.form != FORM_FORMATTED) + p = undefined; + else + switch (u->flags.encoding) + { + case ENCODING_DEFAULT: + p = "UNKNOWN"; + break; + case ENCODING_UTF8: + p = "UTF-8"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad encoding"); + } + + cf_strcpy (iqp->encoding, iqp->encoding_len, p); + } + + if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0) + { + if (u == NULL || u->flags.form != FORM_FORMATTED) + p = undefined; + else + switch (u->flags.decimal) + { + case DECIMAL_POINT: + p = "POINT"; + break; + case DECIMAL_COMMA: + p = "COMMA"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad comma"); + } + + cf_strcpy (iqp->decimal, iqp->decimal_len, p); + } + + if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0) + { + if (u == NULL) + p = undefined; + else + switch (u->flags.async) + { + case ASYNC_YES: + p = "YES"; + break; + case ASYNC_NO: + p = "NO"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad async"); + } + + cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p); + } + + if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0) + { + if (u == NULL) + p = undefined; + else + switch (u->flags.sign) + { + case SIGN_PROCDEFINED: + p = "PROCESSOR_DEFINED"; + break; + case SIGN_SUPPRESS: + p = "SUPPRESS"; + break; + case SIGN_PLUS: + p = "PLUS"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad sign"); + } + + cf_strcpy (iqp->sign, iqp->sign_len, p); + } + + if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0) + { + if (u == NULL) + p = undefined; + else + switch (u->flags.round) + { + case ROUND_UP: + p = "UP"; + break; + case ROUND_DOWN: + p = "DOWN"; + break; + case ROUND_ZERO: + p = "ZERO"; + break; + case ROUND_NEAREST: + p = "NEAREST"; + break; + case ROUND_COMPATIBLE: + p = "COMPATIBLE"; + break; + case ROUND_PROCDEFINED: + p = "PROCESSOR_DEFINED"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad round"); + } + + cf_strcpy (iqp->round, iqp->round_len, p); + } + + if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0) + { + if (u == NULL) + *iqp->size = -1; + else + { + sflush (u->s); + *iqp->size = file_length (u->s); + } + } + } + + if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) + { + if (u == NULL || u->flags.access == ACCESS_DIRECT) + p = undefined; + else + switch (u->flags.position) + { + case POSITION_REWIND: + p = "REWIND"; + break; + case POSITION_APPEND: + p = "APPEND"; + break; + case POSITION_ASIS: + p = "ASIS"; + break; + default: + /* if not direct access, it must be + either REWIND, APPEND, or ASIS. + ASIS seems to be the best default */ + p = "ASIS"; + break; + } + cf_strcpy (iqp->position, iqp->position_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_ACTION) != 0) + { + if (u == NULL) + p = undefined; + else + switch (u->flags.action) + { + case ACTION_READ: + p = "READ"; + break; + case ACTION_WRITE: + p = "WRITE"; + break; + case ACTION_READWRITE: + p = "READWRITE"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad action"); + } + + cf_strcpy (iqp->action, iqp->action_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_READ) != 0) + { + p = (u == NULL) ? inquire_read (NULL, 0) : + inquire_read (u->file, u->file_len); + + cf_strcpy (iqp->read, iqp->read_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0) + { + p = (u == NULL) ? inquire_write (NULL, 0) : + inquire_write (u->file, u->file_len); + + cf_strcpy (iqp->write, iqp->write_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0) + { + p = (u == NULL) ? inquire_readwrite (NULL, 0) : + inquire_readwrite (u->file, u->file_len); + + cf_strcpy (iqp->readwrite, iqp->readwrite_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0) + { + if (u == NULL || u->flags.form != FORM_FORMATTED) + p = undefined; + else + switch (u->flags.delim) + { + case DELIM_NONE: + p = "NONE"; + break; + case DELIM_QUOTE: + p = "QUOTE"; + break; + case DELIM_APOSTROPHE: + p = "APOSTROPHE"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad delim"); + } + + cf_strcpy (iqp->delim, iqp->delim_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) + { + if (u == NULL || u->flags.form != FORM_FORMATTED) + p = undefined; + else + switch (u->flags.pad) + { + case PAD_NO: + p = "NO"; + break; + case PAD_YES: + p = "YES"; + break; + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad pad"); + } + + cf_strcpy (iqp->pad, iqp->pad_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_CONVERT) != 0) + { + if (u == NULL) + p = undefined; + else + switch (u->flags.convert) + { + /* big_endian is 0 for little-endian, 1 for big-endian. */ + case GFC_CONVERT_NATIVE: + p = big_endian ? "BIG_ENDIAN" : "LITTLE_ENDIAN"; + break; + + case GFC_CONVERT_SWAP: + p = big_endian ? "LITTLE_ENDIAN" : "BIG_ENDIAN"; + break; + + default: + internal_error (&iqp->common, "inquire_via_unit(): Bad convert"); + } + + cf_strcpy (iqp->convert, iqp->convert_len, p); + } +} + + +/* inquire_via_filename()-- Inquiry via filename. This subroutine is + * only used if the filename is *not* connected to a unit number. */ + +static void +inquire_via_filename (st_parameter_inquire *iqp) +{ + const char *p; + GFC_INTEGER_4 cf = iqp->common.flags; + + if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) + *iqp->exist = file_exists (iqp->file, iqp->file_len); + + if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0) + *iqp->opened = 0; + + if ((cf & IOPARM_INQUIRE_HAS_NUMBER) != 0) + *iqp->number = -1; + + if ((cf & IOPARM_INQUIRE_HAS_NAMED) != 0) + *iqp->named = 1; + + if ((cf & IOPARM_INQUIRE_HAS_NAME) != 0) + fstrcpy (iqp->name, iqp->name_len, iqp->file, iqp->file_len); + + if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) + cf_strcpy (iqp->access, iqp->access_len, undefined); + + if ((cf & IOPARM_INQUIRE_HAS_SEQUENTIAL) != 0) + { + p = "UNKNOWN"; + cf_strcpy (iqp->sequential, iqp->sequential_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_DIRECT) != 0) + { + p = "UNKNOWN"; + cf_strcpy (iqp->direct, iqp->direct_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_FORM) != 0) + cf_strcpy (iqp->form, iqp->form_len, undefined); + + if ((cf & IOPARM_INQUIRE_HAS_FORMATTED) != 0) + { + p = "UNKNOWN"; + cf_strcpy (iqp->formatted, iqp->formatted_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_UNFORMATTED) != 0) + { + p = "UNKNOWN"; + cf_strcpy (iqp->unformatted, iqp->unformatted_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_RECL_OUT) != 0) + *iqp->recl_out = 0; + + if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0) + *iqp->nextrec = 0; + + if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0) + cf_strcpy (iqp->blank, iqp->blank_len, undefined); + + if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0) + cf_strcpy (iqp->pad, iqp->pad_len, undefined); + + if (cf & IOPARM_INQUIRE_HAS_FLAGS2) + { + GFC_INTEGER_4 cf2 = iqp->flags2; + + if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) + cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0) + cf_strcpy (iqp->delim, iqp->delim_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0) + cf_strcpy (iqp->decimal, iqp->decimal_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0) + cf_strcpy (iqp->delim, iqp->delim_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0) + cf_strcpy (iqp->pad, iqp->pad_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) + cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); + + if ((cf2 & IOPARM_INQUIRE_HAS_SIZE) != 0) + *iqp->size = file_size (iqp->file, iqp->file_len); + } + + if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0) + cf_strcpy (iqp->position, iqp->position_len, undefined); + + if ((cf & IOPARM_INQUIRE_HAS_ACCESS) != 0) + cf_strcpy (iqp->access, iqp->access_len, undefined); + + if ((cf & IOPARM_INQUIRE_HAS_READ) != 0) + { + p = inquire_read (iqp->file, iqp->file_len); + cf_strcpy (iqp->read, iqp->read_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_WRITE) != 0) + { + p = inquire_write (iqp->file, iqp->file_len); + cf_strcpy (iqp->write, iqp->write_len, p); + } + + if ((cf & IOPARM_INQUIRE_HAS_READWRITE) != 0) + { + p = inquire_read (iqp->file, iqp->file_len); + cf_strcpy (iqp->readwrite, iqp->readwrite_len, p); + } +} + + +/* Library entry point for the INQUIRE statement (non-IOLENGTH + form). */ + +extern void st_inquire (st_parameter_inquire *); +export_proto(st_inquire); + +void +st_inquire (st_parameter_inquire *iqp) +{ + gfc_unit *u; + + library_start (&iqp->common); + + if ((iqp->common.flags & IOPARM_INQUIRE_HAS_FILE) == 0) + { + u = find_unit (iqp->common.unit); + inquire_via_unit (iqp, u); + } + else + { + u = find_file (iqp->file, iqp->file_len); + if (u == NULL) + inquire_via_filename (iqp); + else + inquire_via_unit (iqp, u); + } + if (u != NULL) + unlock_unit (u); + + library_end (); +} diff --git a/libgfortran/io/intrinsics.c b/libgfortran/io/intrinsics.c new file mode 100644 index 000000000..2d00a6649 --- /dev/null +++ b/libgfortran/io/intrinsics.c @@ -0,0 +1,400 @@ +/* Implementation of the FGET, FGETC, FPUT, FPUTC, FLUSH + FTELL, TTYNAM and ISATTY intrinsics. + Copyright (C) 2005, 2007, 2009, 2010, 2011 Free Software + Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "io.h" +#include "fbuf.h" +#include "unix.h" + +#ifdef HAVE_STDLIB_H +#include +#endif + +#include + +static const int five = 5; +static const int six = 6; + +extern int PREFIX(fgetc) (const int *, char *, gfc_charlen_type); +export_proto_np(PREFIX(fgetc)); + +int +PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len) +{ + int ret; + gfc_unit * u = find_unit (*unit); + + if (u == NULL) + return -1; + + fbuf_reset (u); + if (u->mode == WRITING) + { + sflush (u->s); + u->mode = READING; + } + + memset (c, ' ', c_len); + ret = sread (u->s, c, 1); + unlock_unit (u); + + if (ret < 0) + return ret; + + if (ret != 1) + return -1; + else + return 0; +} + + +#define FGETC_SUB(kind) \ + extern void fgetc_i ## kind ## _sub \ + (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \ + export_proto(fgetc_i ## kind ## _sub); \ + void fgetc_i ## kind ## _sub \ + (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \ + { if (st != NULL) \ + *st = PREFIX(fgetc) (unit, c, c_len); \ + else \ + PREFIX(fgetc) (unit, c, c_len); } + +FGETC_SUB(1) +FGETC_SUB(2) +FGETC_SUB(4) +FGETC_SUB(8) + + +extern int PREFIX(fget) (char *, gfc_charlen_type); +export_proto_np(PREFIX(fget)); + +int +PREFIX(fget) (char * c, gfc_charlen_type c_len) +{ + return PREFIX(fgetc) (&five, c, c_len); +} + + +#define FGET_SUB(kind) \ + extern void fget_i ## kind ## _sub \ + (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \ + export_proto(fget_i ## kind ## _sub); \ + void fget_i ## kind ## _sub \ + (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \ + { if (st != NULL) \ + *st = PREFIX(fgetc) (&five, c, c_len); \ + else \ + PREFIX(fgetc) (&five, c, c_len); } + +FGET_SUB(1) +FGET_SUB(2) +FGET_SUB(4) +FGET_SUB(8) + + + +extern int PREFIX(fputc) (const int *, char *, gfc_charlen_type); +export_proto_np(PREFIX(fputc)); + +int +PREFIX(fputc) (const int * unit, char * c, + gfc_charlen_type c_len __attribute__((unused))) +{ + ssize_t s; + gfc_unit * u = find_unit (*unit); + + if (u == NULL) + return -1; + + fbuf_reset (u); + if (u->mode == READING) + { + sflush (u->s); + u->mode = WRITING; + } + + s = swrite (u->s, c, 1); + unlock_unit (u); + if (s < 0) + return -1; + return 0; +} + + +#define FPUTC_SUB(kind) \ + extern void fputc_i ## kind ## _sub \ + (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \ + export_proto(fputc_i ## kind ## _sub); \ + void fputc_i ## kind ## _sub \ + (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \ + { if (st != NULL) \ + *st = PREFIX(fputc) (unit, c, c_len); \ + else \ + PREFIX(fputc) (unit, c, c_len); } + +FPUTC_SUB(1) +FPUTC_SUB(2) +FPUTC_SUB(4) +FPUTC_SUB(8) + + +extern int PREFIX(fput) (char *, gfc_charlen_type); +export_proto_np(PREFIX(fput)); + +int +PREFIX(fput) (char * c, gfc_charlen_type c_len) +{ + return PREFIX(fputc) (&six, c, c_len); +} + + +#define FPUT_SUB(kind) \ + extern void fput_i ## kind ## _sub \ + (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \ + export_proto(fput_i ## kind ## _sub); \ + void fput_i ## kind ## _sub \ + (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \ + { if (st != NULL) \ + *st = PREFIX(fputc) (&six, c, c_len); \ + else \ + PREFIX(fputc) (&six, c, c_len); } + +FPUT_SUB(1) +FPUT_SUB(2) +FPUT_SUB(4) +FPUT_SUB(8) + + +/* SUBROUTINE FLUSH(UNIT) + INTEGER, INTENT(IN), OPTIONAL :: UNIT */ + +extern void flush_i4 (GFC_INTEGER_4 *); +export_proto(flush_i4); + +void +flush_i4 (GFC_INTEGER_4 *unit) +{ + gfc_unit *us; + + /* flush all streams */ + if (unit == NULL) + flush_all_units (); + else + { + us = find_unit (*unit); + if (us != NULL) + { + flush_sync (us->s); + unlock_unit (us); + } + } +} + + +extern void flush_i8 (GFC_INTEGER_8 *); +export_proto(flush_i8); + +void +flush_i8 (GFC_INTEGER_8 *unit) +{ + gfc_unit *us; + + /* flush all streams */ + if (unit == NULL) + flush_all_units (); + else + { + us = find_unit (*unit); + if (us != NULL) + { + flush_sync (us->s); + unlock_unit (us); + } + } +} + +/* FSEEK intrinsic */ + +extern void fseek_sub (int *, GFC_IO_INT *, int *, int *); +export_proto(fseek_sub); + +void +fseek_sub (int * unit, GFC_IO_INT * offset, int * whence, int * status) +{ + gfc_unit * u = find_unit (*unit); + ssize_t result = -1; + + if (u != NULL && is_seekable(u->s)) + { + result = sseek(u->s, *offset, *whence); + + unlock_unit (u); + } + + if (status) + *status = (result < 0 ? -1 : 0); +} + + + +/* FTELL intrinsic */ + +static gfc_offset +gf_ftell (int unit) +{ + gfc_unit * u = find_unit (unit); + if (u == NULL) + return -1; + int pos = fbuf_reset (u); + if (pos != 0) + sseek (u->s, pos, SEEK_CUR); + gfc_offset ret = stell (u->s); + unlock_unit (u); + return ret; +} + +extern size_t PREFIX(ftell) (int *); +export_proto_np(PREFIX(ftell)); + +size_t +PREFIX(ftell) (int * unit) +{ + return gf_ftell (*unit); +} + +#define FTELL_SUB(kind) \ + extern void ftell_i ## kind ## _sub (int *, GFC_INTEGER_ ## kind *); \ + export_proto(ftell_i ## kind ## _sub); \ + void \ + ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \ + { \ + *offset = gf_ftell (*unit); \ + } + +FTELL_SUB(1) +FTELL_SUB(2) +FTELL_SUB(4) +FTELL_SUB(8) + + + +/* LOGICAL FUNCTION ISATTY(UNIT) + INTEGER, INTENT(IN) :: UNIT */ + +extern GFC_LOGICAL_4 isatty_l4 (int *); +export_proto(isatty_l4); + +GFC_LOGICAL_4 +isatty_l4 (int *unit) +{ + gfc_unit *u; + GFC_LOGICAL_4 ret = 0; + + u = find_unit (*unit); + if (u != NULL) + { + ret = (GFC_LOGICAL_4) stream_isatty (u->s); + unlock_unit (u); + } + return ret; +} + + +extern GFC_LOGICAL_8 isatty_l8 (int *); +export_proto(isatty_l8); + +GFC_LOGICAL_8 +isatty_l8 (int *unit) +{ + gfc_unit *u; + GFC_LOGICAL_8 ret = 0; + + u = find_unit (*unit); + if (u != NULL) + { + ret = (GFC_LOGICAL_8) stream_isatty (u->s); + unlock_unit (u); + } + return ret; +} + + +/* SUBROUTINE TTYNAM(UNIT,NAME) + INTEGER,SCALAR,INTENT(IN) :: UNIT + CHARACTER,SCALAR,INTENT(OUT) :: NAME */ + +extern void ttynam_sub (int *, char *, gfc_charlen_type); +export_proto(ttynam_sub); + +void +ttynam_sub (int *unit, char * name, gfc_charlen_type name_len) +{ + gfc_unit *u; + int nlen; + int err = 1; + + u = find_unit (*unit); + if (u != NULL) + { + err = stream_ttyname (u->s, name, name_len); + if (err == 0) + { + nlen = strlen (name); + memset (&name[nlen], ' ', name_len - nlen); + } + + unlock_unit (u); + } + if (err != 0) + memset (name, ' ', name_len); +} + + +extern void ttynam (char **, gfc_charlen_type *, int); +export_proto(ttynam); + +void +ttynam (char ** name, gfc_charlen_type * name_len, int unit) +{ + gfc_unit *u; + + u = find_unit (unit); + if (u != NULL) + { + *name = get_mem (TTY_NAME_MAX); + int err = stream_ttyname (u->s, *name, TTY_NAME_MAX); + if (err == 0) + { + *name_len = strlen (*name); + unlock_unit (u); + return; + } + free (*name); + unlock_unit (u); + } + + *name_len = 0; + *name = NULL; +} diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h new file mode 100644 index 000000000..ebe7f7cc1 --- /dev/null +++ b/libgfortran/io/io.h @@ -0,0 +1,809 @@ +/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. + Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#ifndef GFOR_IO_H +#define GFOR_IO_H + +/* IO library include. */ + +#include "libgfortran.h" + +#include + +/* Forward declarations. */ +struct st_parameter_dt; +typedef struct stream stream; +struct fbuf; +struct format_data; +typedef struct fnode fnode; +struct gfc_unit; + + +/* Macros for testing what kinds of I/O we are doing. */ + +#define is_array_io(dtp) ((dtp)->internal_unit_desc) + +#define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal) + +#define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM) + +#define is_char4_unit(dtp) ((dtp)->u.p.unit_is_internal && (dtp)->common.unit) + +/* The array_loop_spec contains the variables for the loops over index ranges + that are encountered. Since the variables can be negative, ssize_t + is used. */ + +typedef struct array_loop_spec +{ + /* Index counter for this dimension. */ + ssize_t idx; + + /* Start for the index counter. */ + ssize_t start; + + /* End for the index counter. */ + ssize_t end; + + /* Step for the index counter. */ + ssize_t step; +} +array_loop_spec; + +/* A stucture to build a hash table for format data. */ + +#define FORMAT_HASH_SIZE 16 + +typedef struct format_hash_entry +{ + char *key; + gfc_charlen_type key_len; + struct format_data *hashed_fmt; +} +format_hash_entry; + +/* Representation of a namelist object in libgfortran + + Namelist Records + &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../ + or + &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END + + The object can be a fully qualified, compound name for an intrinsic + type, derived types or derived type components. So, a substring + a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist + read. Hence full information about the structure of the object has + to be available to list_read.c and write. + + These requirements are met by the following data structures. + + namelist_info type contains all the scalar information about the + object and arrays of descriptor_dimension and array_loop_spec types for + arrays. */ + +typedef struct namelist_type +{ + /* Object type. */ + bt type; + + /* Object name. */ + char * var_name; + + /* Address for the start of the object's data. */ + void * mem_pos; + + /* Flag to show that a read is to be attempted for this node. */ + int touched; + + /* Length of intrinsic type in bytes. */ + int len; + + /* Rank of the object. */ + int var_rank; + + /* Overall size of the object in bytes. */ + index_type size; + + /* Length of character string. */ + index_type string_length; + + descriptor_dimension * dim; + array_loop_spec * ls; + struct namelist_type * next; +} +namelist_info; + +/* Options for the OPEN statement. */ + +typedef enum +{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM, + ACCESS_UNSPECIFIED +} +unit_access; + +typedef enum +{ ACTION_READ, ACTION_WRITE, ACTION_READWRITE, + ACTION_UNSPECIFIED +} +unit_action; + +typedef enum +{ BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED } +unit_blank; + +typedef enum +{ DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE, + DELIM_UNSPECIFIED +} +unit_delim; + +typedef enum +{ FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED } +unit_form; + +typedef enum +{ POSITION_ASIS, POSITION_REWIND, POSITION_APPEND, + POSITION_UNSPECIFIED +} +unit_position; + +typedef enum +{ STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH, + STATUS_REPLACE, STATUS_UNSPECIFIED +} +unit_status; + +typedef enum +{ PAD_YES, PAD_NO, PAD_UNSPECIFIED } +unit_pad; + +typedef enum +{ DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED } +unit_decimal; + +typedef enum +{ ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED } +unit_encoding; + +typedef enum +{ ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE, + ROUND_PROCDEFINED, ROUND_UNSPECIFIED } +unit_round; + +/* NOTE: unit_sign must correspond with the sign_status enumerator in + st_parameter_dt to not break the ABI. */ +typedef enum +{ SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED } +unit_sign; + +typedef enum +{ ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED } +unit_advance; + +typedef enum +{READING, WRITING} +unit_mode; + +typedef enum +{ ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED } +unit_async; + +typedef enum +{ SIGN_S, SIGN_SS, SIGN_SP } +unit_sign_s; + +#define CHARACTER1(name) \ + char * name; \ + gfc_charlen_type name ## _len +#define CHARACTER2(name) \ + gfc_charlen_type name ## _len; \ + char * name + +typedef struct +{ + st_parameter_common common; + GFC_INTEGER_4 recl_in; + CHARACTER2 (file); + CHARACTER1 (status); + CHARACTER2 (access); + CHARACTER1 (form); + CHARACTER2 (blank); + CHARACTER1 (position); + CHARACTER2 (action); + CHARACTER1 (delim); + CHARACTER2 (pad); + CHARACTER1 (convert); + CHARACTER2 (decimal); + CHARACTER1 (encoding); + CHARACTER2 (round); + CHARACTER1 (sign); + CHARACTER2 (asynchronous); + GFC_INTEGER_4 *newunit; +} +st_parameter_open; + +#define IOPARM_CLOSE_HAS_STATUS (1 << 7) + +typedef struct +{ + st_parameter_common common; + CHARACTER1 (status); +} +st_parameter_close; + +typedef struct +{ + st_parameter_common common; +} +st_parameter_filepos; + +#define IOPARM_INQUIRE_HAS_EXIST (1 << 7) +#define IOPARM_INQUIRE_HAS_OPENED (1 << 8) +#define IOPARM_INQUIRE_HAS_NUMBER (1 << 9) +#define IOPARM_INQUIRE_HAS_NAMED (1 << 10) +#define IOPARM_INQUIRE_HAS_NEXTREC (1 << 11) +#define IOPARM_INQUIRE_HAS_RECL_OUT (1 << 12) +#define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13) +#define IOPARM_INQUIRE_HAS_FILE (1 << 14) +#define IOPARM_INQUIRE_HAS_ACCESS (1 << 15) +#define IOPARM_INQUIRE_HAS_FORM (1 << 16) +#define IOPARM_INQUIRE_HAS_BLANK (1 << 17) +#define IOPARM_INQUIRE_HAS_POSITION (1 << 18) +#define IOPARM_INQUIRE_HAS_ACTION (1 << 19) +#define IOPARM_INQUIRE_HAS_DELIM (1 << 20) +#define IOPARM_INQUIRE_HAS_PAD (1 << 21) +#define IOPARM_INQUIRE_HAS_NAME (1 << 22) +#define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 23) +#define IOPARM_INQUIRE_HAS_DIRECT (1 << 24) +#define IOPARM_INQUIRE_HAS_FORMATTED (1 << 25) +#define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 26) +#define IOPARM_INQUIRE_HAS_READ (1 << 27) +#define IOPARM_INQUIRE_HAS_WRITE (1 << 28) +#define IOPARM_INQUIRE_HAS_READWRITE (1 << 29) +#define IOPARM_INQUIRE_HAS_CONVERT (1 << 30) +#define IOPARM_INQUIRE_HAS_FLAGS2 (1 << 31) + +#define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0) +#define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1) +#define IOPARM_INQUIRE_HAS_ENCODING (1 << 2) +#define IOPARM_INQUIRE_HAS_ROUND (1 << 3) +#define IOPARM_INQUIRE_HAS_SIGN (1 << 4) +#define IOPARM_INQUIRE_HAS_PENDING (1 << 5) +#define IOPARM_INQUIRE_HAS_SIZE (1 << 6) +#define IOPARM_INQUIRE_HAS_ID (1 << 7) + +typedef struct +{ + st_parameter_common common; + GFC_INTEGER_4 *exist, *opened, *number, *named; + GFC_INTEGER_4 *nextrec, *recl_out; + GFC_IO_INT *strm_pos_out; + CHARACTER1 (file); + CHARACTER2 (access); + CHARACTER1 (form); + CHARACTER2 (blank); + CHARACTER1 (position); + CHARACTER2 (action); + CHARACTER1 (delim); + CHARACTER2 (pad); + CHARACTER1 (name); + CHARACTER2 (sequential); + CHARACTER1 (direct); + CHARACTER2 (formatted); + CHARACTER1 (unformatted); + CHARACTER2 (read); + CHARACTER1 (write); + CHARACTER2 (readwrite); + CHARACTER1 (convert); + GFC_INTEGER_4 flags2; + CHARACTER1 (asynchronous); + CHARACTER2 (decimal); + CHARACTER1 (encoding); + CHARACTER2 (round); + CHARACTER1 (sign); + GFC_INTEGER_4 *pending; + GFC_IO_INT *size; + GFC_INTEGER_4 *id; +} +st_parameter_inquire; + + +#define IOPARM_DT_LIST_FORMAT (1 << 7) +#define IOPARM_DT_NAMELIST_READ_MODE (1 << 8) +#define IOPARM_DT_HAS_REC (1 << 9) +#define IOPARM_DT_HAS_SIZE (1 << 10) +#define IOPARM_DT_HAS_IOLENGTH (1 << 11) +#define IOPARM_DT_HAS_FORMAT (1 << 12) +#define IOPARM_DT_HAS_ADVANCE (1 << 13) +#define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14) +#define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15) +#define IOPARM_DT_HAS_ID (1 << 16) +#define IOPARM_DT_HAS_POS (1 << 17) +#define IOPARM_DT_HAS_ASYNCHRONOUS (1 << 18) +#define IOPARM_DT_HAS_BLANK (1 << 19) +#define IOPARM_DT_HAS_DECIMAL (1 << 20) +#define IOPARM_DT_HAS_DELIM (1 << 21) +#define IOPARM_DT_HAS_PAD (1 << 22) +#define IOPARM_DT_HAS_ROUND (1 << 23) +#define IOPARM_DT_HAS_SIGN (1 << 24) +#define IOPARM_DT_HAS_F2003 (1 << 25) +/* Internal use bit. */ +#define IOPARM_DT_IONML_SET (1 << 31) + + +typedef struct st_parameter_dt +{ + st_parameter_common common; + GFC_IO_INT rec; + GFC_IO_INT *size, *iolength; + gfc_array_char *internal_unit_desc; + CHARACTER1 (format); + CHARACTER2 (advance); + CHARACTER1 (internal_unit); + CHARACTER2 (namelist_name); + /* Private part of the structure. The compiler just needs + to reserve enough space. */ + union + { + struct + { + void (*transfer) (struct st_parameter_dt *, bt, void *, int, + size_t, size_t); + struct gfc_unit *current_unit; + /* Item number in a formatted data transfer. Also used in namelist + read_logical as an index into line_buffer. */ + int item_count; + unit_mode mode; + unit_blank blank_status; + unit_sign sign_status; + int scale_factor; + int max_pos; /* Maximum righthand column written to. */ + /* Number of skips + spaces to be done for T and X-editing. */ + int skips; + /* Number of spaces to be done for T and X-editing. */ + int pending_spaces; + /* Whether an EOR condition was encountered. Value is: + 0 if no EOR was encountered + 1 if an EOR was encountered due to a 1-byte marker (LF) + 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */ + int sf_seen_eor; + unit_advance advance_status; + unsigned reversion_flag : 1; /* Format reversion has occurred. */ + unsigned first_item : 1; + unsigned seen_dollar : 1; + unsigned eor_condition : 1; + unsigned no_leading_blank : 1; + unsigned char_flag : 1; + unsigned input_complete : 1; + unsigned at_eol : 1; + unsigned comma_flag : 1; + /* A namelist specific flag used in the list directed library + to flag that calls are being made from namelist read (eg. to + ignore comments or to treat '/' as a terminator) */ + unsigned namelist_mode : 1; + /* A namelist specific flag used in the list directed library + to flag read errors and return, so that an attempt can be + made to read a new object name. */ + unsigned nml_read_error : 1; + /* A sequential formatted read specific flag used to signal that a + character string is being read so don't use commas to shorten a + formatted field width. */ + unsigned sf_read_comma : 1; + /* A namelist specific flag used to enable reading input from + line_buffer for logical reads. */ + unsigned line_buffer_enabled : 1; + /* An internal unit specific flag used to identify that the associated + unit is internal. */ + unsigned unit_is_internal : 1; + /* An internal unit specific flag to signify an EOF condition for list + directed read. */ + unsigned at_eof : 1; + /* Used for g0 floating point output. */ + unsigned g0_no_blanks : 1; + /* Used to signal use of free_format_data. */ + unsigned format_not_saved : 1; + /* 14 unused bits. */ + + /* Used for ungetc() style functionality. Possible values + are an unsigned char, EOF, or EOF - 1 used to mark the + field as not valid. */ + int last_char; + char nml_delim; + + int repeat_count; + int saved_length; + int saved_used; + bt saved_type; + char *saved_string; + char *scratch; + char *line_buffer; + struct format_data *fmt; + namelist_info *ionml; + /* A flag used to identify when a non-standard expanded namelist read + has occurred. */ + int expanded_read; + /* Storage area for values except for strings. Must be + large enough to hold a complex value (two reals) of the + largest kind. */ + char value[32]; + GFC_IO_INT size_used; + } p; + /* This pad size must be equal to the pad_size declared in + trans-io.c (gfc_build_io_library_fndecls). The above structure + must be smaller or equal to this array. */ + char pad[16 * sizeof (char *) + 32 * sizeof (int)]; + } u; + GFC_INTEGER_4 *id; + GFC_IO_INT pos; + CHARACTER1 (asynchronous); + CHARACTER2 (blank); + CHARACTER1 (decimal); + CHARACTER2 (delim); + CHARACTER1 (pad); + CHARACTER2 (round); + CHARACTER1 (sign); +} +st_parameter_dt; + +/* Ensure st_parameter_dt's u.pad is bigger or equal to u.p. */ +extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad) + >= sizeof (((st_parameter_dt *) 0)->u.p) + ? 1 : -1]; + +#define IOPARM_WAIT_HAS_ID (1 << 7) + +typedef struct +{ + st_parameter_common common; + CHARACTER1 (id); +} +st_parameter_wait; + + +#undef CHARACTER1 +#undef CHARACTER2 + +typedef struct +{ + unit_access access; + unit_action action; + unit_blank blank; + unit_delim delim; + unit_form form; + int is_notpadded; + unit_position position; + unit_status status; + unit_pad pad; + unit_convert convert; + int has_recl; + unit_decimal decimal; + unit_encoding encoding; + unit_round round; + unit_sign sign; + unit_async async; +} +unit_flags; + + +typedef struct gfc_unit +{ + int unit_number; + stream *s; + + /* Treap links. */ + struct gfc_unit *left, *right; + int priority; + + int read_bad, current_record, saved_pos, previous_nonadvancing_write; + + enum + { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE } + endfile; + + unit_mode mode; + unit_flags flags; + unit_pad pad_status; + unit_decimal decimal_status; + unit_delim delim_status; + unit_round round_status; + + /* recl -- Record length of the file. + last_record -- Last record number read or written + maxrec -- Maximum record number in a direct access file + bytes_left -- Bytes left in current record. + strm_pos -- Current position in file for STREAM I/O. + recl_subrecord -- Maximum length for subrecord. + bytes_left_subrecord -- Bytes left in current subrecord. */ + gfc_offset recl, last_record, maxrec, bytes_left, strm_pos, + recl_subrecord, bytes_left_subrecord; + + /* Set to 1 if we have read a subrecord. */ + + int continued; + + __gthread_mutex_t lock; + /* Number of threads waiting to acquire this unit's lock. + When non-zero, close_unit doesn't only removes the unit + from the UNIT_ROOT tree, but doesn't free it and the + last of the waiting threads will do that. + This must be either atomically increased/decreased, or + always guarded by UNIT_LOCK. */ + int waiting; + /* Flag set by close_unit if the unit as been closed. + Must be manipulated under unit's lock. */ + int closed; + + /* For traversing arrays */ + array_loop_spec *ls; + int rank; + + int file_len; + char *file; + + /* The format hash table. */ + struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE]; + + /* Formatting buffer. */ + struct fbuf *fbuf; +} +gfc_unit; + + +/* unit.c */ + +/* Maximum file offset, computed at library initialization time. */ +extern gfc_offset max_offset; +internal_proto(max_offset); + +/* Unit number to be assigned when NEWUNIT is used in an OPEN statement. */ +extern GFC_INTEGER_4 next_available_newunit; +internal_proto(next_available_newunit); + +/* Unit tree root. */ +extern gfc_unit *unit_root; +internal_proto(unit_root); + +extern __gthread_mutex_t unit_lock; +internal_proto(unit_lock); + +extern int close_unit (gfc_unit *); +internal_proto(close_unit); + +extern gfc_unit *get_internal_unit (st_parameter_dt *); +internal_proto(get_internal_unit); + +extern void free_internal_unit (st_parameter_dt *); +internal_proto(free_internal_unit); + +extern gfc_unit *find_unit (int); +internal_proto(find_unit); + +extern gfc_unit *find_or_create_unit (int); +internal_proto(find_or_create_unit); + +extern gfc_unit *get_unit (st_parameter_dt *, int); +internal_proto(get_unit); + +extern void unlock_unit (gfc_unit *); +internal_proto(unlock_unit); + +extern void update_position (gfc_unit *); +internal_proto(update_position); + +extern void finish_last_advance_record (gfc_unit *u); +internal_proto (finish_last_advance_record); + +extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *); +internal_proto (unit_truncate); + +extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *); +internal_proto(get_unique_unit_number); + +/* open.c */ + +extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *); +internal_proto(new_unit); + + +/* transfer.c */ + +#define SCRATCH_SIZE 300 + +extern const char *type_name (bt); +internal_proto(type_name); + +extern void * read_block_form (st_parameter_dt *, int *); +internal_proto(read_block_form); + +extern void * read_block_form4 (st_parameter_dt *, int *); +internal_proto(read_block_form4); + +extern void *write_block (st_parameter_dt *, int); +internal_proto(write_block); + +extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *, + int*); +internal_proto(next_array_record); + +extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *, + gfc_offset *); +internal_proto(init_loop_spec); + +extern void next_record (st_parameter_dt *, int); +internal_proto(next_record); + +extern void reverse_memcpy (void *, const void *, size_t); +internal_proto (reverse_memcpy); + +extern void st_wait (st_parameter_wait *); +export_proto(st_wait); + +extern void hit_eof (st_parameter_dt *); +internal_proto(hit_eof); + +/* read.c */ + +extern void set_integer (void *, GFC_INTEGER_LARGEST, int); +internal_proto(set_integer); + +extern GFC_UINTEGER_LARGEST max_value (int, int); +internal_proto(max_value); + +extern int convert_real (st_parameter_dt *, void *, const char *, int); +internal_proto(convert_real); + +extern void read_a (st_parameter_dt *, const fnode *, char *, int); +internal_proto(read_a); + +extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int); +internal_proto(read_a); + +extern void read_f (st_parameter_dt *, const fnode *, char *, int); +internal_proto(read_f); + +extern void read_l (st_parameter_dt *, const fnode *, char *, int); +internal_proto(read_l); + +extern void read_x (st_parameter_dt *, int); +internal_proto(read_x); + +extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int); +internal_proto(read_radix); + +extern void read_decimal (st_parameter_dt *, const fnode *, char *, int); +internal_proto(read_decimal); + +/* list_read.c */ + +extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t, + size_t); +internal_proto(list_formatted_read); + +extern void finish_list_read (st_parameter_dt *); +internal_proto(finish_list_read); + +extern void namelist_read (st_parameter_dt *); +internal_proto(namelist_read); + +extern void namelist_write (st_parameter_dt *); +internal_proto(namelist_write); + +/* write.c */ + +extern void write_a (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_a); + +extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_a_char4); + +extern void write_b (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_b); + +extern void write_d (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_d); + +extern void write_e (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_e); + +extern void write_en (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_en); + +extern void write_es (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_es); + +extern void write_f (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_f); + +extern void write_i (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_i); + +extern void write_l (st_parameter_dt *, const fnode *, char *, int); +internal_proto(write_l); + +extern void write_o (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_o); + +extern void write_real (st_parameter_dt *, const char *, int); +internal_proto(write_real); + +extern void write_real_g0 (st_parameter_dt *, const char *, int, int); +internal_proto(write_real_g0); + +extern void write_x (st_parameter_dt *, int, int); +internal_proto(write_x); + +extern void write_z (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_z); + +extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t, + size_t); +internal_proto(list_formatted_write); + +/* size_from_kind.c */ +extern size_t size_from_real_kind (int); +internal_proto(size_from_real_kind); + +extern size_t size_from_complex_kind (int); +internal_proto(size_from_complex_kind); + + +/* lock.c */ +extern void free_ionml (st_parameter_dt *); +internal_proto(free_ionml); + +static inline void +inc_waiting_locked (gfc_unit *u) +{ +#ifdef HAVE_SYNC_FETCH_AND_ADD + (void) __sync_fetch_and_add (&u->waiting, 1); +#else + u->waiting++; +#endif +} + +static inline int +predec_waiting_locked (gfc_unit *u) +{ +#ifdef HAVE_SYNC_FETCH_AND_ADD + return __sync_add_and_fetch (&u->waiting, -1); +#else + return --u->waiting; +#endif +} + +static inline void +dec_waiting_unlocked (gfc_unit *u) +{ +#ifdef HAVE_SYNC_FETCH_AND_ADD + (void) __sync_fetch_and_add (&u->waiting, -1); +#else + __gthread_mutex_lock (&unit_lock); + u->waiting--; + __gthread_mutex_unlock (&unit_lock); +#endif +} + +#endif + diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c new file mode 100644 index 000000000..198f9a702 --- /dev/null +++ b/libgfortran/io/list_read.c @@ -0,0 +1,3077 @@ +/* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2009, 2010, 2011 + Free Software Foundation, Inc. + Contributed by Andy Vaught + Namelist input contributed by Paul Thomas + F2003 I/O support contributed by Jerry DeLisle + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +#include "io.h" +#include "fbuf.h" +#include "unix.h" +#include +#include +#include + + +/* List directed input. Several parsing subroutines are practically + reimplemented from formatted input, the reason being that there are + all kinds of small differences between formatted and list directed + parsing. */ + + +/* Subroutines for reading characters from the input. Because a + repeat count is ambiguous with an integer, we have to read the + whole digit string before seeing if there is a '*' which signals + the repeat count. Since we can have a lot of potential leading + zeros, we have to be able to back up by arbitrary amount. Because + the input might not be seekable, we have to buffer the data + ourselves. */ + +#define CASE_DIGITS case '0': case '1': case '2': case '3': case '4': \ + case '5': case '6': case '7': case '8': case '9' + +#define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t': \ + case '\r': case ';' + +/* This macro assumes that we're operating on a variable. */ + +#define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \ + || c == '\t' || c == '\r' || c == ';') + +/* Maximum repeat count. Less than ten times the maximum signed int32. */ + +#define MAX_REPEAT 200000000 + +#ifndef HAVE_SNPRINTF +# undef snprintf +# define snprintf(str, size, ...) sprintf (str, __VA_ARGS__) +#endif + +/* Save a character to a string buffer, enlarging it as necessary. */ + +static void +push_char (st_parameter_dt *dtp, char c) +{ + char *new; + + if (dtp->u.p.saved_string == NULL) + { + dtp->u.p.saved_string = get_mem (SCRATCH_SIZE); + // memset below should be commented out. + memset (dtp->u.p.saved_string, 0, SCRATCH_SIZE); + dtp->u.p.saved_length = SCRATCH_SIZE; + dtp->u.p.saved_used = 0; + } + + if (dtp->u.p.saved_used >= dtp->u.p.saved_length) + { + dtp->u.p.saved_length = 2 * dtp->u.p.saved_length; + new = realloc (dtp->u.p.saved_string, dtp->u.p.saved_length); + if (new == NULL) + generate_error (&dtp->common, LIBERROR_OS, NULL); + dtp->u.p.saved_string = new; + + // Also this should not be necessary. + memset (new + dtp->u.p.saved_used, 0, + dtp->u.p.saved_length - dtp->u.p.saved_used); + + } + + dtp->u.p.saved_string[dtp->u.p.saved_used++] = c; +} + + +/* Free the input buffer if necessary. */ + +static void +free_saved (st_parameter_dt *dtp) +{ + if (dtp->u.p.saved_string == NULL) + return; + + free (dtp->u.p.saved_string); + + dtp->u.p.saved_string = NULL; + dtp->u.p.saved_used = 0; +} + + +/* Free the line buffer if necessary. */ + +static void +free_line (st_parameter_dt *dtp) +{ + dtp->u.p.item_count = 0; + dtp->u.p.line_buffer_enabled = 0; + + if (dtp->u.p.line_buffer == NULL) + return; + + free (dtp->u.p.line_buffer); + dtp->u.p.line_buffer = NULL; +} + + +static int +next_char (st_parameter_dt *dtp) +{ + ssize_t length; + gfc_offset record; + int c; + + if (dtp->u.p.last_char != EOF - 1) + { + dtp->u.p.at_eol = 0; + c = dtp->u.p.last_char; + dtp->u.p.last_char = EOF - 1; + goto done; + } + + /* Read from line_buffer if enabled. */ + + if (dtp->u.p.line_buffer_enabled) + { + dtp->u.p.at_eol = 0; + + c = dtp->u.p.line_buffer[dtp->u.p.item_count]; + if (c != '\0' && dtp->u.p.item_count < 64) + { + dtp->u.p.line_buffer[dtp->u.p.item_count] = '\0'; + dtp->u.p.item_count++; + goto done; + } + + dtp->u.p.item_count = 0; + dtp->u.p.line_buffer_enabled = 0; + } + + /* Handle the end-of-record and end-of-file conditions for + internal array unit. */ + if (is_array_io (dtp)) + { + if (dtp->u.p.at_eof) + return EOF; + + /* Check for "end-of-record" condition. */ + if (dtp->u.p.current_unit->bytes_left == 0) + { + int finished; + + c = '\n'; + record = next_array_record (dtp, dtp->u.p.current_unit->ls, + &finished); + + /* Check for "end-of-file" condition. */ + if (finished) + { + dtp->u.p.at_eof = 1; + goto done; + } + + record *= dtp->u.p.current_unit->recl; + if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0) + return EOF; + + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + goto done; + } + } + + /* Get the next character and handle end-of-record conditions. */ + + if (is_internal_unit (dtp)) + { + char cc; + length = sread (dtp->u.p.current_unit->s, &cc, 1); + c = cc; + if (length < 0) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return '\0'; + } + + if (is_array_io (dtp)) + { + /* Check whether we hit EOF. */ + if (length == 0) + { + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); + return '\0'; + } + dtp->u.p.current_unit->bytes_left--; + } + else + { + if (dtp->u.p.at_eof) + return EOF; + if (length == 0) + { + c = '\n'; + dtp->u.p.at_eof = 1; + } + } + } + else + { + c = fbuf_getc (dtp->u.p.current_unit); + if (c != EOF && is_stream_io (dtp)) + dtp->u.p.current_unit->strm_pos++; + } +done: + dtp->u.p.at_eol = (c == '\n' || c == '\r' || c == EOF); + return c; +} + + +/* Push a character back onto the input. */ + +static void +unget_char (st_parameter_dt *dtp, int c) +{ + dtp->u.p.last_char = c; +} + + +/* Skip over spaces in the input. Returns the nonspace character that + terminated the eating and also places it back on the input. */ + +static int +eat_spaces (st_parameter_dt *dtp) +{ + int c; + + do + c = next_char (dtp); + while (c != EOF && (c == ' ' || c == '\t')); + + unget_char (dtp, c); + return c; +} + + +/* This function reads characters through to the end of the current + line and just ignores them. Returns 0 for success and LIBERROR_END + if it hit EOF. */ + +static int +eat_line (st_parameter_dt *dtp) +{ + int c; + + do + c = next_char (dtp); + while (c != EOF && c != '\n'); + if (c == EOF) + return LIBERROR_END; + return 0; +} + + +/* Skip over a separator. Technically, we don't always eat the whole + separator. This is because if we've processed the last input item, + then a separator is unnecessary. Plus the fact that operating + systems usually deliver console input on a line basis. + + The upshot is that if we see a newline as part of reading a + separator, we stop reading. If there are more input items, we + continue reading the separator with finish_separator() which takes + care of the fact that we may or may not have seen a comma as part + of the separator. + + Returns 0 for success, and non-zero error code otherwise. */ + +static int +eat_separator (st_parameter_dt *dtp) +{ + int c, n; + int err = 0; + + eat_spaces (dtp); + dtp->u.p.comma_flag = 0; + + if ((c = next_char (dtp)) == EOF) + return LIBERROR_END; + switch (c) + { + case ',': + if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + { + unget_char (dtp, c); + break; + } + /* Fall through. */ + case ';': + dtp->u.p.comma_flag = 1; + eat_spaces (dtp); + break; + + case '/': + dtp->u.p.input_complete = 1; + break; + + case '\r': + dtp->u.p.at_eol = 1; + if ((n = next_char(dtp)) == EOF) + return LIBERROR_END; + if (n != '\n') + { + unget_char (dtp, n); + break; + } + /* Fall through. */ + case '\n': + dtp->u.p.at_eol = 1; + if (dtp->u.p.namelist_mode) + { + do + { + if ((c = next_char (dtp)) == EOF) + return LIBERROR_END; + if (c == '!') + { + err = eat_line (dtp); + if (err) + return err; + c = '\n'; + } + } + while (c == '\n' || c == '\r' || c == ' ' || c == '\t'); + unget_char (dtp, c); + } + break; + + case '!': + if (dtp->u.p.namelist_mode) + { /* Eat a namelist comment. */ + err = eat_line (dtp); + if (err) + return err; + + break; + } + + /* Fall Through... */ + + default: + unget_char (dtp, c); + break; + } + return err; +} + + +/* Finish processing a separator that was interrupted by a newline. + If we're here, then another data item is present, so we finish what + we started on the previous line. Return 0 on success, error code + on failure. */ + +static int +finish_separator (st_parameter_dt *dtp) +{ + int c; + int err; + + restart: + eat_spaces (dtp); + + if ((c = next_char (dtp)) == EOF) + return LIBERROR_END; + switch (c) + { + case ',': + if (dtp->u.p.comma_flag) + unget_char (dtp, c); + else + { + if ((c = eat_spaces (dtp)) == EOF) + return LIBERROR_END; + if (c == '\n' || c == '\r') + goto restart; + } + + break; + + case '/': + dtp->u.p.input_complete = 1; + if (!dtp->u.p.namelist_mode) + return err; + break; + + case '\n': + case '\r': + goto restart; + + case '!': + if (dtp->u.p.namelist_mode) + { + err = eat_line (dtp); + if (err) + return err; + goto restart; + } + + default: + unget_char (dtp, c); + break; + } + return err; +} + + +/* This function is needed to catch bad conversions so that namelist can + attempt to see if dtp->u.p.saved_string contains a new object name rather + than a bad value. */ + +static int +nml_bad_return (st_parameter_dt *dtp, char c) +{ + if (dtp->u.p.namelist_mode) + { + dtp->u.p.nml_read_error = 1; + unget_char (dtp, c); + return 1; + } + return 0; +} + +/* Convert an unsigned string to an integer. The length value is -1 + if we are working on a repeat count. Returns nonzero if we have a + range problem. As a side effect, frees the dtp->u.p.saved_string. */ + +static int +convert_integer (st_parameter_dt *dtp, int length, int negative) +{ + char c, *buffer, message[100]; + int m; + GFC_INTEGER_LARGEST v, max, max10; + + buffer = dtp->u.p.saved_string; + v = 0; + + max = (length == -1) ? MAX_REPEAT : max_value (length, 1); + max10 = max / 10; + + for (;;) + { + c = *buffer++; + if (c == '\0') + break; + c -= '0'; + + if (v > max10) + goto overflow; + v = 10 * v; + + if (v > max - c) + goto overflow; + v += c; + } + + m = 0; + + if (length != -1) + { + if (negative) + v = -v; + set_integer (dtp->u.p.value, v, length); + } + else + { + dtp->u.p.repeat_count = v; + + if (dtp->u.p.repeat_count == 0) + { + sprintf (message, "Zero repeat count in item %d of list input", + dtp->u.p.item_count); + + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + m = 1; + } + } + + free_saved (dtp); + return m; + + overflow: + if (length == -1) + sprintf (message, "Repeat count overflow in item %d of list input", + dtp->u.p.item_count); + else + sprintf (message, "Integer overflow while reading item %d", + dtp->u.p.item_count); + + free_saved (dtp); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + + return 1; +} + + +/* Parse a repeat count for logical and complex values which cannot + begin with a digit. Returns nonzero if we are done, zero if we + should continue on. */ + +static int +parse_repeat (st_parameter_dt *dtp) +{ + char message[100]; + int c, repeat; + + if ((c = next_char (dtp)) == EOF) + goto bad_repeat; + switch (c) + { + CASE_DIGITS: + repeat = c - '0'; + break; + + CASE_SEPARATORS: + unget_char (dtp, c); + eat_separator (dtp); + return 1; + + default: + unget_char (dtp, c); + return 0; + } + + for (;;) + { + c = next_char (dtp); + switch (c) + { + CASE_DIGITS: + repeat = 10 * repeat + c - '0'; + + if (repeat > MAX_REPEAT) + { + sprintf (message, + "Repeat count overflow in item %d of list input", + dtp->u.p.item_count); + + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + return 1; + } + + break; + + case '*': + if (repeat == 0) + { + sprintf (message, + "Zero repeat count in item %d of list input", + dtp->u.p.item_count); + + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + return 1; + } + + goto done; + + default: + goto bad_repeat; + } + } + + done: + dtp->u.p.repeat_count = repeat; + return 0; + + bad_repeat: + + free_saved (dtp); + if (c == EOF) + { + hit_eof (dtp); + return 1; + } + else + eat_line (dtp); + sprintf (message, "Bad repeat count in item %d of list input", + dtp->u.p.item_count); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + return 1; +} + + +/* To read a logical we have to look ahead in the input stream to make sure + there is not an equal sign indicating a variable name. To do this we use + line_buffer to point to a temporary buffer, pushing characters there for + possible later reading. */ + +static void +l_push_char (st_parameter_dt *dtp, char c) +{ + if (dtp->u.p.line_buffer == NULL) + { + dtp->u.p.line_buffer = get_mem (SCRATCH_SIZE); + memset (dtp->u.p.line_buffer, 0, SCRATCH_SIZE); + } + + dtp->u.p.line_buffer[dtp->u.p.item_count++] = c; +} + + +/* Read a logical character on the input. */ + +static void +read_logical (st_parameter_dt *dtp, int length) +{ + char message[100]; + int c, i, v; + + if (parse_repeat (dtp)) + return; + + c = tolower (next_char (dtp)); + l_push_char (dtp, c); + switch (c) + { + case 't': + v = 1; + c = next_char (dtp); + l_push_char (dtp, c); + + if (!is_separator(c) && c != EOF) + goto possible_name; + + unget_char (dtp, c); + break; + case 'f': + v = 0; + c = next_char (dtp); + l_push_char (dtp, c); + + if (!is_separator(c) && c != EOF) + goto possible_name; + + unget_char (dtp, c); + break; + + case '.': + c = tolower (next_char (dtp)); + switch (c) + { + case 't': + v = 1; + break; + case 'f': + v = 0; + break; + default: + goto bad_logical; + } + + break; + + CASE_SEPARATORS: + unget_char (dtp, c); + eat_separator (dtp); + return; /* Null value. */ + + default: + /* Save the character in case it is the beginning + of the next object name. */ + unget_char (dtp, c); + goto bad_logical; + } + + dtp->u.p.saved_type = BT_LOGICAL; + dtp->u.p.saved_length = length; + + /* Eat trailing garbage. */ + do + c = next_char (dtp); + while (c != EOF && !is_separator (c)); + + unget_char (dtp, c); + eat_separator (dtp); + set_integer ((int *) dtp->u.p.value, v, length); + free_line (dtp); + + return; + + possible_name: + + for(i = 0; i < 63; i++) + { + c = next_char (dtp); + if (is_separator(c)) + { + /* All done if this is not a namelist read. */ + if (!dtp->u.p.namelist_mode) + goto logical_done; + + unget_char (dtp, c); + eat_separator (dtp); + c = next_char (dtp); + if (c != '=') + { + unget_char (dtp, c); + goto logical_done; + } + } + + l_push_char (dtp, c); + if (c == '=') + { + dtp->u.p.nml_read_error = 1; + dtp->u.p.line_buffer_enabled = 1; + dtp->u.p.item_count = 0; + return; + } + + } + + bad_logical: + + free_line (dtp); + + if (nml_bad_return (dtp, c)) + return; + + free_saved (dtp); + if (c == EOF) + { + hit_eof (dtp); + return; + } + else if (c != '\n') + eat_line (dtp); + sprintf (message, "Bad logical value while reading item %d", + dtp->u.p.item_count); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + return; + + logical_done: + + dtp->u.p.saved_type = BT_LOGICAL; + dtp->u.p.saved_length = length; + set_integer ((int *) dtp->u.p.value, v, length); + free_saved (dtp); + free_line (dtp); +} + + +/* Reading integers is tricky because we can actually be reading a + repeat count. We have to store the characters in a buffer because + we could be reading an integer that is larger than the default int + used for repeat counts. */ + +static void +read_integer (st_parameter_dt *dtp, int length) +{ + char message[100]; + int c, negative; + + negative = 0; + + c = next_char (dtp); + switch (c) + { + case '-': + negative = 1; + /* Fall through... */ + + case '+': + if ((c = next_char (dtp)) == EOF) + goto bad_integer; + goto get_integer; + + CASE_SEPARATORS: /* Single null. */ + unget_char (dtp, c); + eat_separator (dtp); + return; + + CASE_DIGITS: + push_char (dtp, c); + break; + + default: + goto bad_integer; + } + + /* Take care of what may be a repeat count. */ + + for (;;) + { + c = next_char (dtp); + switch (c) + { + CASE_DIGITS: + push_char (dtp, c); + break; + + case '*': + push_char (dtp, '\0'); + goto repeat; + + CASE_SEPARATORS: /* Not a repeat count. */ + case EOF: + goto done; + + default: + goto bad_integer; + } + } + + repeat: + if (convert_integer (dtp, -1, 0)) + return; + + /* Get the real integer. */ + + if ((c = next_char (dtp)) == EOF) + goto bad_integer; + switch (c) + { + CASE_DIGITS: + break; + + CASE_SEPARATORS: + unget_char (dtp, c); + eat_separator (dtp); + return; + + case '-': + negative = 1; + /* Fall through... */ + + case '+': + c = next_char (dtp); + break; + } + + get_integer: + if (!isdigit (c)) + goto bad_integer; + push_char (dtp, c); + + for (;;) + { + c = next_char (dtp); + switch (c) + { + CASE_DIGITS: + push_char (dtp, c); + break; + + CASE_SEPARATORS: + goto done; + + default: + goto bad_integer; + } + } + + bad_integer: + + if (nml_bad_return (dtp, c)) + return; + + free_saved (dtp); + if (c == EOF) + { + hit_eof (dtp); + return; + } + else if (c != '\n') + eat_line (dtp); + sprintf (message, "Bad integer for item %d in list input", + dtp->u.p.item_count); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + + return; + + done: + unget_char (dtp, c); + eat_separator (dtp); + + push_char (dtp, '\0'); + if (convert_integer (dtp, length, negative)) + { + free_saved (dtp); + return; + } + + free_saved (dtp); + dtp->u.p.saved_type = BT_INTEGER; +} + + +/* Read a character variable. */ + +static void +read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) +{ + char quote, message[100]; + int c; + + quote = ' '; /* Space means no quote character. */ + + if ((c = next_char (dtp)) == EOF) + goto eof; + switch (c) + { + CASE_DIGITS: + push_char (dtp, c); + break; + + CASE_SEPARATORS: + unget_char (dtp, c); /* NULL value. */ + eat_separator (dtp); + return; + + case '"': + case '\'': + quote = c; + goto get_string; + + default: + if (dtp->u.p.namelist_mode) + { + unget_char (dtp, c); + return; + } + + push_char (dtp, c); + goto get_string; + } + + /* Deal with a possible repeat count. */ + + for (;;) + { + if ((c = next_char (dtp)) == EOF) + goto eof; + switch (c) + { + CASE_DIGITS: + push_char (dtp, c); + break; + + CASE_SEPARATORS: + unget_char (dtp, c); + goto done; /* String was only digits! */ + + case '*': + push_char (dtp, '\0'); + goto got_repeat; + + default: + push_char (dtp, c); + goto get_string; /* Not a repeat count after all. */ + } + } + + got_repeat: + if (convert_integer (dtp, -1, 0)) + return; + + /* Now get the real string. */ + + if ((c = next_char (dtp)) == EOF) + goto eof; + switch (c) + { + CASE_SEPARATORS: + unget_char (dtp, c); /* Repeated NULL values. */ + eat_separator (dtp); + return; + + case '"': + case '\'': + quote = c; + break; + + default: + push_char (dtp, c); + break; + } + + get_string: + for (;;) + { + if ((c = next_char (dtp)) == EOF) + goto done_eof; + switch (c) + { + case '"': + case '\'': + if (c != quote) + { + push_char (dtp, c); + break; + } + + /* See if we have a doubled quote character or the end of + the string. */ + + if ((c = next_char (dtp)) == EOF) + goto eof; + if (c == quote) + { + push_char (dtp, quote); + break; + } + + unget_char (dtp, c); + goto done; + + CASE_SEPARATORS: + if (quote == ' ') + { + unget_char (dtp, c); + goto done; + } + + if (c != '\n' && c != '\r') + push_char (dtp, c); + break; + + default: + push_char (dtp, c); + break; + } + } + + /* At this point, we have to have a separator, or else the string is + invalid. */ + done: + c = next_char (dtp); + done_eof: + if (is_separator (c) || c == '!' || c == EOF) + { + unget_char (dtp, c); + eat_separator (dtp); + dtp->u.p.saved_type = BT_CHARACTER; + free_line (dtp); + } + else + { + free_saved (dtp); + sprintf (message, "Invalid string input in item %d", + dtp->u.p.item_count); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + } + return; + + eof: + free_saved (dtp); + hit_eof (dtp); +} + + +/* Parse a component of a complex constant or a real number that we + are sure is already there. This is a straight real number parser. */ + +static int +parse_real (st_parameter_dt *dtp, void *buffer, int length) +{ + char message[100]; + int c, m, seen_dp; + + if ((c = next_char (dtp)) == EOF) + goto bad; + + if (c == '-' || c == '+') + { + push_char (dtp, c); + if ((c = next_char (dtp)) == EOF) + goto bad; + } + + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; + + if (!isdigit (c) && c != '.') + { + if (c == 'i' || c == 'I' || c == 'n' || c == 'N') + goto inf_nan; + else + goto bad; + } + + push_char (dtp, c); + + seen_dp = (c == '.') ? 1 : 0; + + for (;;) + { + if ((c = next_char (dtp)) == EOF) + goto bad; + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; + switch (c) + { + CASE_DIGITS: + push_char (dtp, c); + break; + + case '.': + if (seen_dp) + goto bad; + + seen_dp = 1; + push_char (dtp, c); + break; + + case 'e': + case 'E': + case 'd': + case 'D': + push_char (dtp, 'e'); + goto exp1; + + case '-': + case '+': + push_char (dtp, 'e'); + push_char (dtp, c); + if ((c = next_char (dtp)) == EOF) + goto bad; + goto exp2; + + CASE_SEPARATORS: + goto done; + + default: + goto done; + } + } + + exp1: + if ((c = next_char (dtp)) == EOF) + goto bad; + if (c != '-' && c != '+') + push_char (dtp, '+'); + else + { + push_char (dtp, c); + c = next_char (dtp); + } + + exp2: + if (!isdigit (c)) + goto bad; + + push_char (dtp, c); + + for (;;) + { + if ((c = next_char (dtp)) == EOF) + goto bad; + switch (c) + { + CASE_DIGITS: + push_char (dtp, c); + break; + + CASE_SEPARATORS: + unget_char (dtp, c); + goto done; + + default: + goto done; + } + } + + done: + unget_char (dtp, c); + push_char (dtp, '\0'); + + m = convert_real (dtp, buffer, dtp->u.p.saved_string, length); + free_saved (dtp); + + return m; + + inf_nan: + /* Match INF and Infinity. */ + if ((c == 'i' || c == 'I') + && ((c = next_char (dtp)) == 'n' || c == 'N') + && ((c = next_char (dtp)) == 'f' || c == 'F')) + { + c = next_char (dtp); + if ((c != 'i' && c != 'I') + || ((c == 'i' || c == 'I') + && ((c = next_char (dtp)) == 'n' || c == 'N') + && ((c = next_char (dtp)) == 'i' || c == 'I') + && ((c = next_char (dtp)) == 't' || c == 'T') + && ((c = next_char (dtp)) == 'y' || c == 'Y') + && (c = next_char (dtp)))) + { + if (is_separator (c)) + unget_char (dtp, c); + push_char (dtp, 'i'); + push_char (dtp, 'n'); + push_char (dtp, 'f'); + goto done; + } + } /* Match NaN. */ + else if (((c = next_char (dtp)) == 'a' || c == 'A') + && ((c = next_char (dtp)) == 'n' || c == 'N') + && (c = next_char (dtp))) + { + if (is_separator (c)) + unget_char (dtp, c); + push_char (dtp, 'n'); + push_char (dtp, 'a'); + push_char (dtp, 'n'); + + /* Match "NAN(alphanum)". */ + if (c == '(') + { + for ( ; c != ')'; c = next_char (dtp)) + if (is_separator (c)) + goto bad; + + c = next_char (dtp); + if (is_separator (c)) + unget_char (dtp, c); + } + goto done; + } + + bad: + + if (nml_bad_return (dtp, c)) + return 0; + + free_saved (dtp); + if (c == EOF) + { + hit_eof (dtp); + return 1; + } + else if (c != '\n') + eat_line (dtp); + sprintf (message, "Bad floating point number for item %d", + dtp->u.p.item_count); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + + return 1; +} + + +/* Reading a complex number is straightforward because we can tell + what it is right away. */ + +static void +read_complex (st_parameter_dt *dtp, void * dest, int kind, size_t size) +{ + char message[100]; + int c; + + if (parse_repeat (dtp)) + return; + + c = next_char (dtp); + switch (c) + { + case '(': + break; + + CASE_SEPARATORS: + unget_char (dtp, c); + eat_separator (dtp); + return; + + default: + goto bad_complex; + } + +eol_1: + eat_spaces (dtp); + c = next_char (dtp); + if (c == '\n' || c== '\r') + goto eol_1; + else + unget_char (dtp, c); + + if (parse_real (dtp, dest, kind)) + return; + +eol_2: + eat_spaces (dtp); + c = next_char (dtp); + if (c == '\n' || c== '\r') + goto eol_2; + else + unget_char (dtp, c); + + if (next_char (dtp) + != (dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';')) + goto bad_complex; + +eol_3: + eat_spaces (dtp); + c = next_char (dtp); + if (c == '\n' || c== '\r') + goto eol_3; + else + unget_char (dtp, c); + + if (parse_real (dtp, dest + size / 2, kind)) + return; + +eol_4: + eat_spaces (dtp); + c = next_char (dtp); + if (c == '\n' || c== '\r') + goto eol_4; + else + unget_char (dtp, c); + + if (next_char (dtp) != ')') + goto bad_complex; + + c = next_char (dtp); + if (!is_separator (c)) + goto bad_complex; + + unget_char (dtp, c); + eat_separator (dtp); + + free_saved (dtp); + dtp->u.p.saved_type = BT_COMPLEX; + return; + + bad_complex: + + if (nml_bad_return (dtp, c)) + return; + + free_saved (dtp); + if (c == EOF) + { + hit_eof (dtp); + return; + } + else if (c != '\n') + eat_line (dtp); + sprintf (message, "Bad complex value in item %d of list input", + dtp->u.p.item_count); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); +} + + +/* Parse a real number with a possible repeat count. */ + +static void +read_real (st_parameter_dt *dtp, void * dest, int length) +{ + char message[100]; + int c; + int seen_dp; + int is_inf; + + seen_dp = 0; + + c = next_char (dtp); + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; + switch (c) + { + CASE_DIGITS: + push_char (dtp, c); + break; + + case '.': + push_char (dtp, c); + seen_dp = 1; + break; + + case '+': + case '-': + goto got_sign; + + CASE_SEPARATORS: + unget_char (dtp, c); /* Single null. */ + eat_separator (dtp); + return; + + case 'i': + case 'I': + case 'n': + case 'N': + goto inf_nan; + + default: + goto bad_real; + } + + /* Get the digit string that might be a repeat count. */ + + for (;;) + { + c = next_char (dtp); + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; + switch (c) + { + CASE_DIGITS: + push_char (dtp, c); + break; + + case '.': + if (seen_dp) + goto bad_real; + + seen_dp = 1; + push_char (dtp, c); + goto real_loop; + + case 'E': + case 'e': + case 'D': + case 'd': + goto exp1; + + case '+': + case '-': + push_char (dtp, 'e'); + push_char (dtp, c); + c = next_char (dtp); + goto exp2; + + case '*': + push_char (dtp, '\0'); + goto got_repeat; + + CASE_SEPARATORS: + if (c != '\n' && c != ',' && c != '\r' && c != ';') + unget_char (dtp, c); + goto done; + + default: + goto bad_real; + } + } + + got_repeat: + if (convert_integer (dtp, -1, 0)) + return; + + /* Now get the number itself. */ + + if ((c = next_char (dtp)) == EOF) + goto bad_real; + if (is_separator (c)) + { /* Repeated null value. */ + unget_char (dtp, c); + eat_separator (dtp); + return; + } + + if (c != '-' && c != '+') + push_char (dtp, '+'); + else + { + got_sign: + push_char (dtp, c); + if ((c = next_char (dtp)) == EOF) + goto bad_real; + } + + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; + + if (!isdigit (c) && c != '.') + { + if (c == 'i' || c == 'I' || c == 'n' || c == 'N') + goto inf_nan; + else + goto bad_real; + } + + if (c == '.') + { + if (seen_dp) + goto bad_real; + else + seen_dp = 1; + } + + push_char (dtp, c); + + real_loop: + for (;;) + { + c = next_char (dtp); + if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) + c = '.'; + switch (c) + { + CASE_DIGITS: + push_char (dtp, c); + break; + + CASE_SEPARATORS: + case EOF: + goto done; + + case '.': + if (seen_dp) + goto bad_real; + + seen_dp = 1; + push_char (dtp, c); + break; + + case 'E': + case 'e': + case 'D': + case 'd': + goto exp1; + + case '+': + case '-': + push_char (dtp, 'e'); + push_char (dtp, c); + c = next_char (dtp); + goto exp2; + + default: + goto bad_real; + } + } + + exp1: + push_char (dtp, 'e'); + + if ((c = next_char (dtp)) == EOF) + goto bad_real; + if (c != '+' && c != '-') + push_char (dtp, '+'); + else + { + push_char (dtp, c); + c = next_char (dtp); + } + + exp2: + if (!isdigit (c)) + goto bad_real; + push_char (dtp, c); + + for (;;) + { + c = next_char (dtp); + + switch (c) + { + CASE_DIGITS: + push_char (dtp, c); + break; + + CASE_SEPARATORS: + case EOF: + goto done; + + default: + goto bad_real; + } + } + + done: + unget_char (dtp, c); + eat_separator (dtp); + push_char (dtp, '\0'); + if (convert_real (dtp, dest, dtp->u.p.saved_string, length)) + return; + + free_saved (dtp); + dtp->u.p.saved_type = BT_REAL; + return; + + inf_nan: + l_push_char (dtp, c); + is_inf = 0; + + /* Match INF and Infinity. */ + if (c == 'i' || c == 'I') + { + c = next_char (dtp); + l_push_char (dtp, c); + if (c != 'n' && c != 'N') + goto unwind; + c = next_char (dtp); + l_push_char (dtp, c); + if (c != 'f' && c != 'F') + goto unwind; + c = next_char (dtp); + l_push_char (dtp, c); + if (!is_separator (c)) + { + if (c != 'i' && c != 'I') + goto unwind; + c = next_char (dtp); + l_push_char (dtp, c); + if (c != 'n' && c != 'N') + goto unwind; + c = next_char (dtp); + l_push_char (dtp, c); + if (c != 'i' && c != 'I') + goto unwind; + c = next_char (dtp); + l_push_char (dtp, c); + if (c != 't' && c != 'T') + goto unwind; + c = next_char (dtp); + l_push_char (dtp, c); + if (c != 'y' && c != 'Y') + goto unwind; + c = next_char (dtp); + l_push_char (dtp, c); + } + is_inf = 1; + } /* Match NaN. */ + else + { + c = next_char (dtp); + l_push_char (dtp, c); + if (c != 'a' && c != 'A') + goto unwind; + c = next_char (dtp); + l_push_char (dtp, c); + if (c != 'n' && c != 'N') + goto unwind; + c = next_char (dtp); + l_push_char (dtp, c); + + /* Match NAN(alphanum). */ + if (c == '(') + { + for (c = next_char (dtp); c != ')'; c = next_char (dtp)) + if (is_separator (c)) + goto unwind; + else + l_push_char (dtp, c); + + l_push_char (dtp, ')'); + c = next_char (dtp); + l_push_char (dtp, c); + } + } + + if (!is_separator (c)) + goto unwind; + + if (dtp->u.p.namelist_mode) + { + if (c == ' ' || c =='\n' || c == '\r') + { + do + { + if ((c = next_char (dtp)) == EOF) + goto bad_real; + } + while (c == ' ' || c =='\n' || c == '\r'); + + l_push_char (dtp, c); + + if (c == '=') + goto unwind; + } + } + + if (is_inf) + { + push_char (dtp, 'i'); + push_char (dtp, 'n'); + push_char (dtp, 'f'); + } + else + { + push_char (dtp, 'n'); + push_char (dtp, 'a'); + push_char (dtp, 'n'); + } + + free_line (dtp); + goto done; + + unwind: + if (dtp->u.p.namelist_mode) + { + dtp->u.p.nml_read_error = 1; + dtp->u.p.line_buffer_enabled = 1; + dtp->u.p.item_count = 0; + return; + } + + bad_real: + + if (nml_bad_return (dtp, c)) + return; + + free_saved (dtp); + if (c == EOF) + { + hit_eof (dtp); + return; + } + else if (c != '\n') + eat_line (dtp); + + sprintf (message, "Bad real number in item %d of list input", + dtp->u.p.item_count); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); +} + + +/* Check the current type against the saved type to make sure they are + compatible. Returns nonzero if incompatible. */ + +static int +check_type (st_parameter_dt *dtp, bt type, int len) +{ + char message[100]; + + if (dtp->u.p.saved_type != BT_UNKNOWN && dtp->u.p.saved_type != type) + { + sprintf (message, "Read type %s where %s was expected for item %d", + type_name (dtp->u.p.saved_type), type_name (type), + dtp->u.p.item_count); + + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + return 1; + } + + if (dtp->u.p.saved_type == BT_UNKNOWN || dtp->u.p.saved_type == BT_CHARACTER) + return 0; + + if (dtp->u.p.saved_length != len) + { + sprintf (message, + "Read kind %d %s where kind %d is required for item %d", + dtp->u.p.saved_length, type_name (dtp->u.p.saved_type), len, + dtp->u.p.item_count); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); + return 1; + } + + return 0; +} + + +/* Top level data transfer subroutine for list reads. Because we have + to deal with repeat counts, the data item is always saved after + reading, usually in the dtp->u.p.value[] array. If a repeat count is + greater than one, we copy the data item multiple times. */ + +static int +list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p, + int kind, size_t size) +{ + gfc_char4_t *q; + int c, i, m; + int err = 0; + + dtp->u.p.namelist_mode = 0; + + if (dtp->u.p.first_item) + { + dtp->u.p.first_item = 0; + dtp->u.p.input_complete = 0; + dtp->u.p.repeat_count = 1; + dtp->u.p.at_eol = 0; + + if ((c = eat_spaces (dtp)) == EOF) + { + err = LIBERROR_END; + goto cleanup; + } + if (is_separator (c)) + { + /* Found a null value. */ + eat_separator (dtp); + dtp->u.p.repeat_count = 0; + + /* eat_separator sets this flag if the separator was a comma. */ + if (dtp->u.p.comma_flag) + goto cleanup; + + /* eat_separator sets this flag if the separator was a \n or \r. */ + if (dtp->u.p.at_eol) + finish_separator (dtp); + else + goto cleanup; + } + + } + else + { + if (dtp->u.p.repeat_count > 0) + { + if (check_type (dtp, type, kind)) + return err; + goto set_value; + } + + if (dtp->u.p.input_complete) + goto cleanup; + + if (dtp->u.p.at_eol) + finish_separator (dtp); + else + { + eat_spaces (dtp); + /* Trailing spaces prior to end of line. */ + if (dtp->u.p.at_eol) + finish_separator (dtp); + } + + dtp->u.p.saved_type = BT_UNKNOWN; + dtp->u.p.repeat_count = 1; + } + + switch (type) + { + case BT_INTEGER: + read_integer (dtp, kind); + break; + case BT_LOGICAL: + read_logical (dtp, kind); + break; + case BT_CHARACTER: + read_character (dtp, kind); + break; + case BT_REAL: + read_real (dtp, p, kind); + /* Copy value back to temporary if needed. */ + if (dtp->u.p.repeat_count > 0) + memcpy (dtp->u.p.value, p, kind); + break; + case BT_COMPLEX: + read_complex (dtp, p, kind, size); + /* Copy value back to temporary if needed. */ + if (dtp->u.p.repeat_count > 0) + memcpy (dtp->u.p.value, p, size); + break; + default: + internal_error (&dtp->common, "Bad type for list read"); + } + + if (dtp->u.p.saved_type != BT_CHARACTER && dtp->u.p.saved_type != BT_UNKNOWN) + dtp->u.p.saved_length = size; + + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + goto cleanup; + + set_value: + switch (dtp->u.p.saved_type) + { + case BT_COMPLEX: + case BT_REAL: + if (dtp->u.p.repeat_count > 0) + memcpy (p, dtp->u.p.value, size); + break; + + case BT_INTEGER: + case BT_LOGICAL: + memcpy (p, dtp->u.p.value, size); + break; + + case BT_CHARACTER: + if (dtp->u.p.saved_string) + { + m = ((int) size < dtp->u.p.saved_used) + ? (int) size : dtp->u.p.saved_used; + if (kind == 1) + memcpy (p, dtp->u.p.saved_string, m); + else + { + q = (gfc_char4_t *) p; + for (i = 0; i < m; i++) + q[i] = (unsigned char) dtp->u.p.saved_string[i]; + } + } + else + /* Just delimiters encountered, nothing to copy but SPACE. */ + m = 0; + + if (m < (int) size) + { + if (kind == 1) + memset (((char *) p) + m, ' ', size - m); + else + { + q = (gfc_char4_t *) p; + for (i = m; i < (int) size; i++) + q[i] = (unsigned char) ' '; + } + } + break; + + case BT_UNKNOWN: + break; + + default: + internal_error (&dtp->common, "Bad type for list read"); + } + + if (--dtp->u.p.repeat_count <= 0) + free_saved (dtp); + +cleanup: + if (err == LIBERROR_END) + hit_eof (dtp); + return err; +} + + +void +list_formatted_read (st_parameter_dt *dtp, bt type, void *p, int kind, + size_t size, size_t nelems) +{ + size_t elem; + char *tmp; + size_t stride = type == BT_CHARACTER ? + size * GFC_SIZE_OF_CHAR_KIND(kind) : size; + int err; + + tmp = (char *) p; + + /* Big loop over all the elements. */ + for (elem = 0; elem < nelems; elem++) + { + dtp->u.p.item_count++; + err = list_formatted_read_scalar (dtp, type, tmp + stride*elem, + kind, size); + if (err) + break; + } +} + + +/* Finish a list read. */ + +void +finish_list_read (st_parameter_dt *dtp) +{ + int err; + + free_saved (dtp); + + fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode); + + if (dtp->u.p.at_eol) + { + dtp->u.p.at_eol = 0; + return; + } + + err = eat_line (dtp); + if (err == LIBERROR_END) + hit_eof (dtp); +} + +/* NAMELIST INPUT + +void namelist_read (st_parameter_dt *dtp) +calls: + static void nml_match_name (char *name, int len) + static int nml_query (st_parameter_dt *dtp) + static int nml_get_obj_data (st_parameter_dt *dtp, + namelist_info **prev_nl, char *, size_t) +calls: + static void nml_untouch_nodes (st_parameter_dt *dtp) + static namelist_info * find_nml_node (st_parameter_dt *dtp, + char * var_name) + static int nml_parse_qualifier(descriptor_dimension * ad, + array_loop_spec * ls, int rank, char *) + static void nml_touch_nodes (namelist_info * nl) + static int nml_read_obj (namelist_info *nl, index_type offset, + namelist_info **prev_nl, char *, size_t, + index_type clow, index_type chigh) +calls: + -itself- */ + +/* Inputs a rank-dimensional qualifier, which can contain + singlets, doublets, triplets or ':' with the standard meanings. */ + +static try +nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, + array_loop_spec *ls, int rank, char *parse_err_msg, + int *parsed_rank) +{ + int dim; + int indx; + int neg; + int null_flag; + int is_array_section, is_char; + int c; + + is_char = 0; + is_array_section = 0; + dtp->u.p.expanded_read = 0; + + /* See if this is a character substring qualifier we are looking for. */ + if (rank == -1) + { + rank = 1; + is_char = 1; + } + + /* The next character in the stream should be the '('. */ + + if ((c = next_char (dtp)) == EOF) + return FAILURE; + + /* Process the qualifier, by dimension and triplet. */ + + for (dim=0; dim < rank; dim++ ) + { + for (indx=0; indx<3; indx++) + { + free_saved (dtp); + eat_spaces (dtp); + neg = 0; + + /* Process a potential sign. */ + if ((c = next_char (dtp)) == EOF) + return FAILURE; + switch (c) + { + case '-': + neg = 1; + break; + + case '+': + break; + + default: + unget_char (dtp, c); + break; + } + + /* Process characters up to the next ':' , ',' or ')'. */ + for (;;) + { + if ((c = next_char (dtp)) == EOF) + return FAILURE; + + switch (c) + { + case ':': + is_array_section = 1; + break; + + case ',': case ')': + if ((c==',' && dim == rank -1) + || (c==')' && dim < rank -1)) + { + if (is_char) + sprintf (parse_err_msg, "Bad substring qualifier"); + else + sprintf (parse_err_msg, "Bad number of index fields"); + goto err_ret; + } + break; + + CASE_DIGITS: + push_char (dtp, c); + continue; + + case ' ': case '\t': + eat_spaces (dtp); + if ((c = next_char (dtp) == EOF)) + return FAILURE; + break; + + default: + if (is_char) + sprintf (parse_err_msg, + "Bad character in substring qualifier"); + else + sprintf (parse_err_msg, "Bad character in index"); + goto err_ret; + } + + if ((c == ',' || c == ')') && indx == 0 + && dtp->u.p.saved_string == 0) + { + if (is_char) + sprintf (parse_err_msg, "Null substring qualifier"); + else + sprintf (parse_err_msg, "Null index field"); + goto err_ret; + } + + if ((c == ':' && indx == 1 && dtp->u.p.saved_string == 0) + || (indx == 2 && dtp->u.p.saved_string == 0)) + { + if (is_char) + sprintf (parse_err_msg, "Bad substring qualifier"); + else + sprintf (parse_err_msg, "Bad index triplet"); + goto err_ret; + } + + if (is_char && !is_array_section) + { + sprintf (parse_err_msg, + "Missing colon in substring qualifier"); + goto err_ret; + } + + /* If '( : ? )' or '( ? : )' break and flag read failure. */ + null_flag = 0; + if ((c == ':' && indx == 0 && dtp->u.p.saved_string == 0) + || (indx==1 && dtp->u.p.saved_string == 0)) + { + null_flag = 1; + break; + } + + /* Now read the index. */ + if (convert_integer (dtp, sizeof(ssize_t), neg)) + { + if (is_char) + sprintf (parse_err_msg, "Bad integer substring qualifier"); + else + sprintf (parse_err_msg, "Bad integer in index"); + goto err_ret; + } + break; + } + + /* Feed the index values to the triplet arrays. */ + if (!null_flag) + { + if (indx == 0) + memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t)); + if (indx == 1) + memcpy (&ls[dim].end, dtp->u.p.value, sizeof(ssize_t)); + if (indx == 2) + memcpy (&ls[dim].step, dtp->u.p.value, sizeof(ssize_t)); + } + + /* Singlet or doublet indices. */ + if (c==',' || c==')') + { + if (indx == 0) + { + memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t)); + + /* If -std=f95/2003 or an array section is specified, + do not allow excess data to be processed. */ + if (is_array_section == 1 + || !(compile_options.allow_std & GFC_STD_GNU) + || dtp->u.p.ionml->type == BT_DERIVED) + ls[dim].end = ls[dim].start; + else + dtp->u.p.expanded_read = 1; + } + + /* Check for non-zero rank. */ + if (is_array_section == 1 && ls[dim].start != ls[dim].end) + *parsed_rank = 1; + + break; + } + } + + if (is_array_section == 1 && dtp->u.p.expanded_read == 1) + { + int i; + dtp->u.p.expanded_read = 0; + for (i = 0; i < dim; i++) + ls[i].end = ls[i].start; + } + + /* Check the values of the triplet indices. */ + if ((ls[dim].start > (ssize_t) GFC_DIMENSION_UBOUND(ad[dim])) + || (ls[dim].start < (ssize_t) GFC_DIMENSION_LBOUND(ad[dim])) + || (ls[dim].end > (ssize_t) GFC_DIMENSION_UBOUND(ad[dim])) + || (ls[dim].end < (ssize_t) GFC_DIMENSION_LBOUND(ad[dim]))) + { + if (is_char) + sprintf (parse_err_msg, "Substring out of range"); + else + sprintf (parse_err_msg, "Index %d out of range", dim + 1); + goto err_ret; + } + + if (((ls[dim].end - ls[dim].start ) * ls[dim].step < 0) + || (ls[dim].step == 0)) + { + sprintf (parse_err_msg, "Bad range in index %d", dim + 1); + goto err_ret; + } + + /* Initialise the loop index counter. */ + ls[dim].idx = ls[dim].start; + } + eat_spaces (dtp); + return SUCCESS; + +err_ret: + + return FAILURE; +} + +static namelist_info * +find_nml_node (st_parameter_dt *dtp, char * var_name) +{ + namelist_info * t = dtp->u.p.ionml; + while (t != NULL) + { + if (strcmp (var_name, t->var_name) == 0) + { + t->touched = 1; + return t; + } + t = t->next; + } + return NULL; +} + +/* Visits all the components of a derived type that have + not explicitly been identified in the namelist input. + touched is set and the loop specification initialised + to default values */ + +static void +nml_touch_nodes (namelist_info * nl) +{ + index_type len = strlen (nl->var_name) + 1; + int dim; + char * ext_name = (char*)get_mem (len + 1); + memcpy (ext_name, nl->var_name, len-1); + memcpy (ext_name + len - 1, "%", 2); + for (nl = nl->next; nl; nl = nl->next) + { + if (strncmp (nl->var_name, ext_name, len) == 0) + { + nl->touched = 1; + for (dim=0; dim < nl->var_rank; dim++) + { + nl->ls[dim].step = 1; + nl->ls[dim].end = GFC_DESCRIPTOR_UBOUND(nl,dim); + nl->ls[dim].start = GFC_DESCRIPTOR_LBOUND(nl,dim); + nl->ls[dim].idx = nl->ls[dim].start; + } + } + else + break; + } + free (ext_name); + return; +} + +/* Resets touched for the entire list of nml_nodes, ready for a + new object. */ + +static void +nml_untouch_nodes (st_parameter_dt *dtp) +{ + namelist_info * t; + for (t = dtp->u.p.ionml; t; t = t->next) + t->touched = 0; + return; +} + +/* Attempts to input name to namelist name. Returns + dtp->u.p.nml_read_error = 1 on no match. */ + +static void +nml_match_name (st_parameter_dt *dtp, const char *name, index_type len) +{ + index_type i; + int c; + + dtp->u.p.nml_read_error = 0; + for (i = 0; i < len; i++) + { + c = next_char (dtp); + if (c == EOF || (tolower (c) != tolower (name[i]))) + { + dtp->u.p.nml_read_error = 1; + break; + } + } +} + +/* If the namelist read is from stdin, output the current state of the + namelist to stdout. This is used to implement the non-standard query + features, ? and =?. If c == '=' the full namelist is printed. Otherwise + the names alone are printed. */ + +static void +nml_query (st_parameter_dt *dtp, char c) +{ + gfc_unit * temp_unit; + namelist_info * nl; + index_type len; + char * p; +#ifdef HAVE_CRLF + static const index_type endlen = 2; + static const char endl[] = "\r\n"; + static const char nmlend[] = "&end\r\n"; +#else + static const index_type endlen = 1; + static const char endl[] = "\n"; + static const char nmlend[] = "&end\n"; +#endif + + if (dtp->u.p.current_unit->unit_number != options.stdin_unit) + return; + + /* Store the current unit and transfer to stdout. */ + + temp_unit = dtp->u.p.current_unit; + dtp->u.p.current_unit = find_unit (options.stdout_unit); + + if (dtp->u.p.current_unit) + { + dtp->u.p.mode = WRITING; + next_record (dtp, 0); + + /* Write the namelist in its entirety. */ + + if (c == '=') + namelist_write (dtp); + + /* Or write the list of names. */ + + else + { + /* "&namelist_name\n" */ + + len = dtp->namelist_name_len; + p = write_block (dtp, len - 1 + endlen); + if (!p) + goto query_return; + memcpy (p, "&", 1); + memcpy ((char*)(p + 1), dtp->namelist_name, len); + memcpy ((char*)(p + len + 1), &endl, endlen); + for (nl = dtp->u.p.ionml; nl; nl = nl->next) + { + /* " var_name\n" */ + + len = strlen (nl->var_name); + p = write_block (dtp, len + endlen); + if (!p) + goto query_return; + memcpy (p, " ", 1); + memcpy ((char*)(p + 1), nl->var_name, len); + memcpy ((char*)(p + len + 1), &endl, endlen); + } + + /* "&end\n" */ + + p = write_block (dtp, endlen + 4); + if (!p) + goto query_return; + memcpy (p, &nmlend, endlen + 4); + } + + /* Flush the stream to force immediate output. */ + + fbuf_flush (dtp->u.p.current_unit, WRITING); + sflush (dtp->u.p.current_unit->s); + unlock_unit (dtp->u.p.current_unit); + } + +query_return: + + /* Restore the current unit. */ + + dtp->u.p.current_unit = temp_unit; + dtp->u.p.mode = READING; + return; +} + +/* Reads and stores the input for the namelist object nl. For an array, + the function loops over the ranges defined by the loop specification. + This default to all the data or to the specification from a qualifier. + nml_read_obj recursively calls itself to read derived types. It visits + all its own components but only reads data for those that were touched + when the name was parsed. If a read error is encountered, an attempt is + made to return to read a new object name because the standard allows too + little data to be available. On the other hand, too much data is an + error. */ + +static try +nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, + namelist_info **pprev_nl, char *nml_err_msg, + size_t nml_err_msg_size, index_type clow, index_type chigh) +{ + namelist_info * cmp; + char * obj_name; + int nml_carry; + int len; + int dim; + index_type dlen; + index_type m; + size_t obj_name_len; + void * pdata; + + /* This object not touched in name parsing. */ + + if (!nl->touched) + return SUCCESS; + + dtp->u.p.repeat_count = 0; + eat_spaces (dtp); + + len = nl->len; + switch (nl->type) + { + case BT_INTEGER: + case BT_LOGICAL: + dlen = len; + break; + + case BT_REAL: + dlen = size_from_real_kind (len); + break; + + case BT_COMPLEX: + dlen = size_from_complex_kind (len); + break; + + case BT_CHARACTER: + dlen = chigh ? (chigh - clow + 1) : nl->string_length; + break; + + default: + dlen = 0; + } + + do + { + /* Update the pointer to the data, using the current index vector */ + + pdata = (void*)(nl->mem_pos + offset); + for (dim = 0; dim < nl->var_rank; dim++) + pdata = (void*)(pdata + (nl->ls[dim].idx + - GFC_DESCRIPTOR_LBOUND(nl,dim)) + * GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size); + + /* Reset the error flag and try to read next value, if + dtp->u.p.repeat_count=0 */ + + dtp->u.p.nml_read_error = 0; + nml_carry = 0; + if (--dtp->u.p.repeat_count <= 0) + { + if (dtp->u.p.input_complete) + return SUCCESS; + if (dtp->u.p.at_eol) + finish_separator (dtp); + if (dtp->u.p.input_complete) + return SUCCESS; + + dtp->u.p.saved_type = BT_UNKNOWN; + free_saved (dtp); + + switch (nl->type) + { + case BT_INTEGER: + read_integer (dtp, len); + break; + + case BT_LOGICAL: + read_logical (dtp, len); + break; + + case BT_CHARACTER: + read_character (dtp, len); + break; + + case BT_REAL: + /* Need to copy data back from the real location to the temp in order + to handle nml reads into arrays. */ + read_real (dtp, pdata, len); + memcpy (dtp->u.p.value, pdata, dlen); + break; + + case BT_COMPLEX: + /* Same as for REAL, copy back to temp. */ + read_complex (dtp, pdata, len, dlen); + memcpy (dtp->u.p.value, pdata, dlen); + break; + + case BT_DERIVED: + obj_name_len = strlen (nl->var_name) + 1; + obj_name = get_mem (obj_name_len+1); + memcpy (obj_name, nl->var_name, obj_name_len-1); + memcpy (obj_name + obj_name_len - 1, "%", 2); + + /* If reading a derived type, disable the expanded read warning + since a single object can have multiple reads. */ + dtp->u.p.expanded_read = 0; + + /* Now loop over the components. Update the component pointer + with the return value from nml_write_obj. This loop jumps + past nested derived types by testing if the potential + component name contains '%'. */ + + for (cmp = nl->next; + cmp && + !strncmp (cmp->var_name, obj_name, obj_name_len) && + !strchr (cmp->var_name + obj_name_len, '%'); + cmp = cmp->next) + { + + if (nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos), + pprev_nl, nml_err_msg, nml_err_msg_size, + clow, chigh) == FAILURE) + { + free (obj_name); + return FAILURE; + } + + if (dtp->u.p.input_complete) + { + free (obj_name); + return SUCCESS; + } + } + + free (obj_name); + goto incr_idx; + + default: + snprintf (nml_err_msg, nml_err_msg_size, + "Bad type for namelist object %s", nl->var_name); + internal_error (&dtp->common, nml_err_msg); + goto nml_err_ret; + } + } + + /* The standard permits array data to stop short of the number of + elements specified in the loop specification. In this case, we + should be here with dtp->u.p.nml_read_error != 0. Control returns to + nml_get_obj_data and an attempt is made to read object name. */ + + *pprev_nl = nl; + if (dtp->u.p.nml_read_error) + { + dtp->u.p.expanded_read = 0; + return SUCCESS; + } + + if (dtp->u.p.saved_type == BT_UNKNOWN) + { + dtp->u.p.expanded_read = 0; + goto incr_idx; + } + + switch (dtp->u.p.saved_type) + { + + case BT_COMPLEX: + case BT_REAL: + case BT_INTEGER: + case BT_LOGICAL: + memcpy (pdata, dtp->u.p.value, dlen); + break; + + case BT_CHARACTER: + if (dlen < dtp->u.p.saved_used) + { + if (compile_options.bounds_check) + { + snprintf (nml_err_msg, nml_err_msg_size, + "Namelist object '%s' truncated on read.", + nl->var_name); + generate_warning (&dtp->common, nml_err_msg); + } + m = dlen; + } + else + m = dtp->u.p.saved_used; + pdata = (void*)( pdata + clow - 1 ); + memcpy (pdata, dtp->u.p.saved_string, m); + if (m < dlen) + memset ((void*)( pdata + m ), ' ', dlen - m); + break; + + default: + break; + } + + /* Warn if a non-standard expanded read occurs. A single read of a + single object is acceptable. If a second read occurs, issue a warning + and set the flag to zero to prevent further warnings. */ + if (dtp->u.p.expanded_read == 2) + { + notify_std (&dtp->common, GFC_STD_GNU, "Non-standard expanded namelist read."); + dtp->u.p.expanded_read = 0; + } + + /* If the expanded read warning flag is set, increment it, + indicating that a single read has occurred. */ + if (dtp->u.p.expanded_read >= 1) + dtp->u.p.expanded_read++; + + /* Break out of loop if scalar. */ + if (!nl->var_rank) + break; + + /* Now increment the index vector. */ + +incr_idx: + + nml_carry = 1; + for (dim = 0; dim < nl->var_rank; dim++) + { + nl->ls[dim].idx += nml_carry * nl->ls[dim].step; + nml_carry = 0; + if (((nl->ls[dim].step > 0) && (nl->ls[dim].idx > nl->ls[dim].end)) + || + ((nl->ls[dim].step < 0) && (nl->ls[dim].idx < nl->ls[dim].end))) + { + nl->ls[dim].idx = nl->ls[dim].start; + nml_carry = 1; + } + } + } while (!nml_carry); + + if (dtp->u.p.repeat_count > 1) + { + snprintf (nml_err_msg, nml_err_msg_size, + "Repeat count too large for namelist object %s", nl->var_name); + goto nml_err_ret; + } + return SUCCESS; + +nml_err_ret: + + return FAILURE; +} + +/* Parses the object name, including array and substring qualifiers. It + iterates over derived type components, touching those components and + setting their loop specifications, if there is a qualifier. If the + object is itself a derived type, its components and subcomponents are + touched. nml_read_obj is called at the end and this reads the data in + the manner specified by the object name. */ + +static try +nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl, + char *nml_err_msg, size_t nml_err_msg_size) +{ + int c; + namelist_info * nl; + namelist_info * first_nl = NULL; + namelist_info * root_nl = NULL; + int dim, parsed_rank; + int component_flag, qualifier_flag; + index_type clow, chigh; + int non_zero_rank_count; + + /* Look for end of input or object name. If '?' or '=?' are encountered + in stdin, print the node names or the namelist to stdout. */ + + eat_separator (dtp); + if (dtp->u.p.input_complete) + return SUCCESS; + + if (dtp->u.p.at_eol) + finish_separator (dtp); + if (dtp->u.p.input_complete) + return SUCCESS; + + if ((c = next_char (dtp)) == EOF) + return FAILURE; + switch (c) + { + case '=': + if ((c = next_char (dtp)) == EOF) + return FAILURE; + if (c != '?') + { + sprintf (nml_err_msg, "namelist read: misplaced = sign"); + goto nml_err_ret; + } + nml_query (dtp, '='); + return SUCCESS; + + case '?': + nml_query (dtp, '?'); + return SUCCESS; + + case '$': + case '&': + nml_match_name (dtp, "end", 3); + if (dtp->u.p.nml_read_error) + { + sprintf (nml_err_msg, "namelist not terminated with / or &end"); + goto nml_err_ret; + } + case '/': + dtp->u.p.input_complete = 1; + return SUCCESS; + + default : + break; + } + + /* Untouch all nodes of the namelist and reset the flags that are set for + derived type components. */ + + nml_untouch_nodes (dtp); + component_flag = 0; + qualifier_flag = 0; + non_zero_rank_count = 0; + + /* Get the object name - should '!' and '\n' be permitted separators? */ + +get_name: + + free_saved (dtp); + + do + { + if (!is_separator (c)) + push_char (dtp, tolower(c)); + if ((c = next_char (dtp)) == EOF) + return FAILURE; + } while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' )); + + unget_char (dtp, c); + + /* Check that the name is in the namelist and get pointer to object. + Three error conditions exist: (i) An attempt is being made to + identify a non-existent object, following a failed data read or + (ii) The object name does not exist or (iii) Too many data items + are present for an object. (iii) gives the same error message + as (i) */ + + push_char (dtp, '\0'); + + if (component_flag) + { + size_t var_len = strlen (root_nl->var_name); + size_t saved_len + = dtp->u.p.saved_string ? strlen (dtp->u.p.saved_string) : 0; + char ext_name[var_len + saved_len + 1]; + + memcpy (ext_name, root_nl->var_name, var_len); + if (dtp->u.p.saved_string) + memcpy (ext_name + var_len, dtp->u.p.saved_string, saved_len); + ext_name[var_len + saved_len] = '\0'; + nl = find_nml_node (dtp, ext_name); + } + else + nl = find_nml_node (dtp, dtp->u.p.saved_string); + + if (nl == NULL) + { + if (dtp->u.p.nml_read_error && *pprev_nl) + snprintf (nml_err_msg, nml_err_msg_size, + "Bad data for namelist object %s", (*pprev_nl)->var_name); + + else + snprintf (nml_err_msg, nml_err_msg_size, + "Cannot match namelist object name %s", + dtp->u.p.saved_string); + + goto nml_err_ret; + } + + /* Get the length, data length, base pointer and rank of the variable. + Set the default loop specification first. */ + + for (dim=0; dim < nl->var_rank; dim++) + { + nl->ls[dim].step = 1; + nl->ls[dim].end = GFC_DESCRIPTOR_UBOUND(nl,dim); + nl->ls[dim].start = GFC_DESCRIPTOR_LBOUND(nl,dim); + nl->ls[dim].idx = nl->ls[dim].start; + } + +/* Check to see if there is a qualifier: if so, parse it.*/ + + if (c == '(' && nl->var_rank) + { + parsed_rank = 0; + if (nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank, + nml_err_msg, &parsed_rank) == FAILURE) + { + char *nml_err_msg_end = strchr (nml_err_msg, '\0'); + snprintf (nml_err_msg_end, + nml_err_msg_size - (nml_err_msg_end - nml_err_msg), + " for namelist variable %s", nl->var_name); + goto nml_err_ret; + } + if (parsed_rank > 0) + non_zero_rank_count++; + + qualifier_flag = 1; + + if ((c = next_char (dtp)) == EOF) + return FAILURE; + unget_char (dtp, c); + } + else if (nl->var_rank > 0) + non_zero_rank_count++; + + /* Now parse a derived type component. The root namelist_info address + is backed up, as is the previous component level. The component flag + is set and the iteration is made by jumping back to get_name. */ + + if (c == '%') + { + if (nl->type != BT_DERIVED) + { + snprintf (nml_err_msg, nml_err_msg_size, + "Attempt to get derived component for %s", nl->var_name); + goto nml_err_ret; + } + + if (*pprev_nl == NULL || !component_flag) + first_nl = nl; + + root_nl = nl; + + component_flag = 1; + if ((c = next_char (dtp)) == EOF) + return FAILURE; + goto get_name; + } + + /* Parse a character qualifier, if present. chigh = 0 is a default + that signals that the string length = string_length. */ + + clow = 1; + chigh = 0; + + if (c == '(' && nl->type == BT_CHARACTER) + { + descriptor_dimension chd[1] = { {1, clow, nl->string_length} }; + array_loop_spec ind[1] = { {1, clow, nl->string_length, 1} }; + + if (nml_parse_qualifier (dtp, chd, ind, -1, nml_err_msg, &parsed_rank) + == FAILURE) + { + char *nml_err_msg_end = strchr (nml_err_msg, '\0'); + snprintf (nml_err_msg_end, + nml_err_msg_size - (nml_err_msg_end - nml_err_msg), + " for namelist variable %s", nl->var_name); + goto nml_err_ret; + } + + clow = ind[0].start; + chigh = ind[0].end; + + if (ind[0].step != 1) + { + snprintf (nml_err_msg, nml_err_msg_size, + "Step not allowed in substring qualifier" + " for namelist object %s", nl->var_name); + goto nml_err_ret; + } + + if ((c = next_char (dtp)) == EOF) + return FAILURE; + unget_char (dtp, c); + } + + /* Make sure no extraneous qualifiers are there. */ + + if (c == '(') + { + snprintf (nml_err_msg, nml_err_msg_size, + "Qualifier for a scalar or non-character namelist object %s", + nl->var_name); + goto nml_err_ret; + } + + /* Make sure there is no more than one non-zero rank object. */ + if (non_zero_rank_count > 1) + { + snprintf (nml_err_msg, nml_err_msg_size, + "Multiple sub-objects with non-zero rank in namelist object %s", + nl->var_name); + non_zero_rank_count = 0; + goto nml_err_ret; + } + +/* According to the standard, an equal sign MUST follow an object name. The + following is possibly lax - it allows comments, blank lines and so on to + intervene. eat_spaces (dtp); c = next_char (dtp); would be compliant*/ + + free_saved (dtp); + + eat_separator (dtp); + if (dtp->u.p.input_complete) + return SUCCESS; + + if (dtp->u.p.at_eol) + finish_separator (dtp); + if (dtp->u.p.input_complete) + return SUCCESS; + + if ((c = next_char (dtp)) == EOF) + return FAILURE; + + if (c != '=') + { + snprintf (nml_err_msg, nml_err_msg_size, + "Equal sign must follow namelist object name %s", + nl->var_name); + goto nml_err_ret; + } + /* If a derived type, touch its components and restore the root + namelist_info if we have parsed a qualified derived type + component. */ + + if (nl->type == BT_DERIVED) + nml_touch_nodes (nl); + + if (first_nl) + { + if (first_nl->var_rank == 0) + { + if (component_flag && qualifier_flag) + nl = first_nl; + } + else + nl = first_nl; + } + + if (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size, + clow, chigh) == FAILURE) + goto nml_err_ret; + + return SUCCESS; + +nml_err_ret: + + return FAILURE; +} + +/* Entry point for namelist input. Goes through input until namelist name + is matched. Then cycles through nml_get_obj_data until the input is + completed or there is an error. */ + +void +namelist_read (st_parameter_dt *dtp) +{ + int c; + char nml_err_msg[200]; + + /* Initialize the error string buffer just in case we get an unexpected fail + somewhere and end up at nml_err_ret. */ + strcpy (nml_err_msg, "Internal namelist read error"); + + /* Pointer to the previously read object, in case attempt is made to read + new object name. Should this fail, error message can give previous + name. */ + namelist_info *prev_nl = NULL; + + dtp->u.p.namelist_mode = 1; + dtp->u.p.input_complete = 0; + dtp->u.p.expanded_read = 0; + + /* Look for &namelist_name . Skip all characters, testing for $nmlname. + Exit on success or EOF. If '?' or '=?' encountered in stdin, print + node names or namelist on stdout. */ + +find_nml_name: + c = next_char (dtp); + switch (c) + { + case '$': + case '&': + break; + + case '!': + eat_line (dtp); + goto find_nml_name; + + case '=': + c = next_char (dtp); + if (c == '?') + nml_query (dtp, '='); + else + unget_char (dtp, c); + goto find_nml_name; + + case '?': + nml_query (dtp, '?'); + goto find_nml_name; + + case EOF: + return; + + default: + goto find_nml_name; + } + + /* Match the name of the namelist. */ + + nml_match_name (dtp, dtp->namelist_name, dtp->namelist_name_len); + + if (dtp->u.p.nml_read_error) + goto find_nml_name; + + /* A trailing space is required, we give a little lattitude here, 10.9.1. */ + c = next_char (dtp); + if (!is_separator(c) && c != '!') + { + unget_char (dtp, c); + goto find_nml_name; + } + + unget_char (dtp, c); + eat_separator (dtp); + + /* Ready to read namelist objects. If there is an error in input + from stdin, output the error message and continue. */ + + while (!dtp->u.p.input_complete) + { + if (nml_get_obj_data (dtp, &prev_nl, nml_err_msg, sizeof nml_err_msg) + == FAILURE) + { + if (dtp->u.p.current_unit->unit_number != options.stdin_unit) + goto nml_err_ret; + generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg); + } + + /* Reset the previous namelist pointer if we know we are not going + to be doing multiple reads within a single namelist object. */ + if (prev_nl && prev_nl->var_rank == 0) + prev_nl = NULL; + } + + free_saved (dtp); + free_line (dtp); + return; + + +nml_err_ret: + + /* All namelist error calls return from here */ + free_saved (dtp); + free_line (dtp); + generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg); + return; +} diff --git a/libgfortran/io/lock.c b/libgfortran/io/lock.c new file mode 100644 index 000000000..9e7e9513e --- /dev/null +++ b/libgfortran/io/lock.c @@ -0,0 +1,67 @@ +/* Thread/recursion locking + Copyright 2002, 2003, 2004, 2005, 2007, 2009, 2010 + Free Software Foundation, Inc. + Contributed by Paul Brook and Andy Vaught + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "io.h" +#include +#include + +/* library_start()-- Called with a library call is entered. */ + +void +library_start (st_parameter_common *cmp) +{ + if ((cmp->flags & IOPARM_LIBRETURN_ERROR) != 0) + return; + + cmp->flags &= ~IOPARM_LIBRETURN_MASK; +} + + +void +free_ionml (st_parameter_dt *dtp) +{ + namelist_info * t1, *t2; + + /* Delete the namelist, if it exists. */ + + if (dtp->u.p.ionml != NULL) + { + t1 = dtp->u.p.ionml; + while (t1 != NULL) + { + t2 = t1; + t1 = t1->next; + free (t2->var_name); + if (t2->var_rank) + { + free (t2->dim); + free (t2->ls); + } + free (t2); + } + } + dtp->u.p.ionml = NULL; +} diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c new file mode 100644 index 000000000..d7448c007 --- /dev/null +++ b/libgfortran/io/open.c @@ -0,0 +1,866 @@ +/* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. + Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "io.h" +#include "fbuf.h" +#include "unix.h" +#include +#include +#include +#include + + +static const st_option access_opt[] = { + {"sequential", ACCESS_SEQUENTIAL}, + {"direct", ACCESS_DIRECT}, + {"append", ACCESS_APPEND}, + {"stream", ACCESS_STREAM}, + {NULL, 0} +}; + +static const st_option action_opt[] = +{ + { "read", ACTION_READ}, + { "write", ACTION_WRITE}, + { "readwrite", ACTION_READWRITE}, + { NULL, 0} +}; + +static const st_option blank_opt[] = +{ + { "null", BLANK_NULL}, + { "zero", BLANK_ZERO}, + { NULL, 0} +}; + +static const st_option delim_opt[] = +{ + { "none", DELIM_NONE}, + { "apostrophe", DELIM_APOSTROPHE}, + { "quote", DELIM_QUOTE}, + { NULL, 0} +}; + +static const st_option form_opt[] = +{ + { "formatted", FORM_FORMATTED}, + { "unformatted", FORM_UNFORMATTED}, + { NULL, 0} +}; + +static const st_option position_opt[] = +{ + { "asis", POSITION_ASIS}, + { "rewind", POSITION_REWIND}, + { "append", POSITION_APPEND}, + { NULL, 0} +}; + +static const st_option status_opt[] = +{ + { "unknown", STATUS_UNKNOWN}, + { "old", STATUS_OLD}, + { "new", STATUS_NEW}, + { "replace", STATUS_REPLACE}, + { "scratch", STATUS_SCRATCH}, + { NULL, 0} +}; + +static const st_option pad_opt[] = +{ + { "yes", PAD_YES}, + { "no", PAD_NO}, + { NULL, 0} +}; + +static const st_option decimal_opt[] = +{ + { "point", DECIMAL_POINT}, + { "comma", DECIMAL_COMMA}, + { NULL, 0} +}; + +static const st_option encoding_opt[] = +{ + { "utf-8", ENCODING_UTF8}, + { "default", ENCODING_DEFAULT}, + { NULL, 0} +}; + +static const st_option round_opt[] = +{ + { "up", ROUND_UP}, + { "down", ROUND_DOWN}, + { "zero", ROUND_ZERO}, + { "nearest", ROUND_NEAREST}, + { "compatible", ROUND_COMPATIBLE}, + { "processor_defined", ROUND_PROCDEFINED}, + { NULL, 0} +}; + +static const st_option sign_opt[] = +{ + { "plus", SIGN_PLUS}, + { "suppress", SIGN_SUPPRESS}, + { "processor_defined", SIGN_PROCDEFINED}, + { NULL, 0} +}; + +static const st_option convert_opt[] = +{ + { "native", GFC_CONVERT_NATIVE}, + { "swap", GFC_CONVERT_SWAP}, + { "big_endian", GFC_CONVERT_BIG}, + { "little_endian", GFC_CONVERT_LITTLE}, + { NULL, 0} +}; + +static const st_option async_opt[] = +{ + { "yes", ASYNC_YES}, + { "no", ASYNC_NO}, + { NULL, 0} +}; + +/* Given a unit, test to see if the file is positioned at the terminal + point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE. + This prevents us from changing the state from AFTER_ENDFILE to + AT_ENDFILE. */ + +static void +test_endfile (gfc_unit * u) +{ + if (u->endfile == NO_ENDFILE && file_length (u->s) == stell (u->s)) + u->endfile = AT_ENDFILE; +} + + +/* Change the modes of a file, those that are allowed * to be + changed. */ + +static void +edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) +{ + /* Complain about attempts to change the unchangeable. */ + + if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD && + u->flags.status != flags->status) + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Cannot change STATUS parameter in OPEN statement"); + + if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access) + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Cannot change ACCESS parameter in OPEN statement"); + + if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form) + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Cannot change FORM parameter in OPEN statement"); + + if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) + && opp->recl_in != u->recl) + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Cannot change RECL parameter in OPEN statement"); + + if (flags->action != ACTION_UNSPECIFIED && u->flags.action != flags->action) + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Cannot change ACTION parameter in OPEN statement"); + + /* Status must be OLD if present. */ + + if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD && + flags->status != STATUS_UNKNOWN) + { + if (flags->status == STATUS_SCRATCH) + notify_std (&opp->common, GFC_STD_GNU, + "OPEN statement must have a STATUS of OLD or UNKNOWN"); + else + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "OPEN statement must have a STATUS of OLD or UNKNOWN"); + } + + if (u->flags.form == FORM_UNFORMATTED) + { + if (flags->delim != DELIM_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "DELIM parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + + if (flags->blank != BLANK_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "BLANK parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + + if (flags->pad != PAD_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "PAD parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + + if (flags->decimal != DECIMAL_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "DECIMAL parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + + if (flags->encoding != ENCODING_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "ENCODING parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + + if (flags->round != ROUND_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "ROUND parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + + if (flags->sign != SIGN_UNSPECIFIED) + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "SIGN parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + } + + if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK) + { + /* Change the changeable: */ + if (flags->blank != BLANK_UNSPECIFIED) + u->flags.blank = flags->blank; + if (flags->delim != DELIM_UNSPECIFIED) + u->flags.delim = flags->delim; + if (flags->pad != PAD_UNSPECIFIED) + u->flags.pad = flags->pad; + if (flags->decimal != DECIMAL_UNSPECIFIED) + u->flags.decimal = flags->decimal; + if (flags->encoding != ENCODING_UNSPECIFIED) + u->flags.encoding = flags->encoding; + if (flags->async != ASYNC_UNSPECIFIED) + u->flags.async = flags->async; + if (flags->round != ROUND_UNSPECIFIED) + u->flags.round = flags->round; + if (flags->sign != SIGN_UNSPECIFIED) + u->flags.sign = flags->sign; + } + + /* Reposition the file if necessary. */ + + switch (flags->position) + { + case POSITION_UNSPECIFIED: + case POSITION_ASIS: + break; + + case POSITION_REWIND: + if (sseek (u->s, 0, SEEK_SET) != 0) + goto seek_error; + + u->current_record = 0; + u->last_record = 0; + + test_endfile (u); + break; + + case POSITION_APPEND: + if (sseek (u->s, 0, SEEK_END) < 0) + goto seek_error; + + if (flags->access != ACCESS_STREAM) + u->current_record = 0; + + u->endfile = AT_ENDFILE; /* We are at the end. */ + break; + + seek_error: + generate_error (&opp->common, LIBERROR_OS, NULL); + break; + } + + unlock_unit (u); +} + + +/* Open an unused unit. */ + +gfc_unit * +new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) +{ + gfc_unit *u2; + stream *s; + char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */]; + + /* Change unspecifieds to defaults. Leave (flags->action == + ACTION_UNSPECIFIED) alone so open_external() can set it based on + what type of open actually works. */ + + if (flags->access == ACCESS_UNSPECIFIED) + flags->access = ACCESS_SEQUENTIAL; + + if (flags->form == FORM_UNSPECIFIED) + flags->form = (flags->access == ACCESS_SEQUENTIAL) + ? FORM_FORMATTED : FORM_UNFORMATTED; + + if (flags->async == ASYNC_UNSPECIFIED) + flags->async = ASYNC_NO; + + if (flags->status == STATUS_UNSPECIFIED) + flags->status = STATUS_UNKNOWN; + + /* Checks. */ + + if (flags->delim == DELIM_UNSPECIFIED) + flags->delim = DELIM_NONE; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "DELIM parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + goto fail; + } + } + + if (flags->blank == BLANK_UNSPECIFIED) + flags->blank = BLANK_NULL; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "BLANK parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + goto fail; + } + } + + if (flags->pad == PAD_UNSPECIFIED) + flags->pad = PAD_YES; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "PAD parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + goto fail; + } + } + + if (flags->decimal == DECIMAL_UNSPECIFIED) + flags->decimal = DECIMAL_POINT; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "DECIMAL parameter conflicts with UNFORMATTED form " + "in OPEN statement"); + goto fail; + } + } + + if (flags->encoding == ENCODING_UNSPECIFIED) + flags->encoding = ENCODING_DEFAULT; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "ENCODING parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + goto fail; + } + } + + /* NB: the value for ROUND when it's not specified by the user does not + have to be PROCESSOR_DEFINED; the standard says that it is + processor dependent, and requires that it is one of the + possible value (see F2003, 9.4.5.13). */ + if (flags->round == ROUND_UNSPECIFIED) + flags->round = ROUND_PROCDEFINED; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "ROUND parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + goto fail; + } + } + + if (flags->sign == SIGN_UNSPECIFIED) + flags->sign = SIGN_PROCDEFINED; + else + { + if (flags->form == FORM_UNFORMATTED) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "SIGN parameter conflicts with UNFORMATTED form in " + "OPEN statement"); + goto fail; + } + } + + if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT) + { + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, + "ACCESS parameter conflicts with SEQUENTIAL access in " + "OPEN statement"); + goto fail; + } + else + if (flags->position == POSITION_UNSPECIFIED) + flags->position = POSITION_ASIS; + + if (flags->access == ACCESS_DIRECT + && (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0) + { + generate_error (&opp->common, LIBERROR_MISSING_OPTION, + "Missing RECL parameter in OPEN statement"); + goto fail; + } + + if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0) + { + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "RECL parameter is non-positive in OPEN statement"); + goto fail; + } + + switch (flags->status) + { + case STATUS_SCRATCH: + if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0) + { + opp->file = NULL; + break; + } + + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "FILE parameter must not be present in OPEN statement"); + goto fail; + + case STATUS_OLD: + case STATUS_NEW: + case STATUS_REPLACE: + case STATUS_UNKNOWN: + if ((opp->common.flags & IOPARM_OPEN_HAS_FILE)) + break; + + opp->file = tmpname; +#ifdef HAVE_SNPRINTF + opp->file_len = snprintf(opp->file, sizeof (tmpname), "fort.%d", + (int) opp->common.unit); +#else + opp->file_len = sprintf(opp->file, "fort.%d", (int) opp->common.unit); +#endif + break; + + default: + internal_error (&opp->common, "new_unit(): Bad status"); + } + + /* Make sure the file isn't already open someplace else. + Do not error if opening file preconnected to stdin, stdout, stderr. */ + + u2 = NULL; + if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0) + u2 = find_file (opp->file, opp->file_len); + if (u2 != NULL + && (options.stdin_unit < 0 || u2->unit_number != options.stdin_unit) + && (options.stdout_unit < 0 || u2->unit_number != options.stdout_unit) + && (options.stderr_unit < 0 || u2->unit_number != options.stderr_unit)) + { + unlock_unit (u2); + generate_error (&opp->common, LIBERROR_ALREADY_OPEN, NULL); + goto cleanup; + } + + if (u2 != NULL) + unlock_unit (u2); + + /* Open file. */ + + s = open_external (opp, flags); + if (s == NULL) + { + char *path, *msg; + path = (char *) gfc_alloca (opp->file_len + 1); + msg = (char *) gfc_alloca (opp->file_len + 51); + unpack_filename (path, opp->file, opp->file_len); + + switch (errno) + { + case ENOENT: + sprintf (msg, "File '%s' does not exist", path); + break; + + case EEXIST: + sprintf (msg, "File '%s' already exists", path); + break; + + case EACCES: + sprintf (msg, "Permission denied trying to open file '%s'", path); + break; + + case EISDIR: + sprintf (msg, "'%s' is a directory", path); + break; + + default: + msg = NULL; + } + + generate_error (&opp->common, LIBERROR_OS, msg); + goto cleanup; + } + + if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE) + flags->status = STATUS_OLD; + + /* Create the unit structure. */ + + u->file = get_mem (opp->file_len); + if (u->unit_number != opp->common.unit) + internal_error (&opp->common, "Unit number changed"); + u->s = s; + u->flags = *flags; + u->read_bad = 0; + u->endfile = NO_ENDFILE; + u->last_record = 0; + u->current_record = 0; + u->mode = READING; + u->maxrec = 0; + u->bytes_left = 0; + u->saved_pos = 0; + + if (flags->position == POSITION_APPEND) + { + if (file_size (opp->file, opp->file_len) > 0 && sseek (u->s, 0, SEEK_END) < 0) + generate_error (&opp->common, LIBERROR_OS, NULL); + u->endfile = AT_ENDFILE; + } + + /* Unspecified recl ends up with a processor dependent value. */ + + if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)) + { + u->flags.has_recl = 1; + u->recl = opp->recl_in; + u->recl_subrecord = u->recl; + u->bytes_left = u->recl; + } + else + { + u->flags.has_recl = 0; + u->recl = max_offset; + if (compile_options.max_subrecord_length) + { + u->recl_subrecord = compile_options.max_subrecord_length; + } + else + { + switch (compile_options.record_marker) + { + case 0: + /* Fall through */ + case sizeof (GFC_INTEGER_4): + u->recl_subrecord = GFC_MAX_SUBRECORD_LENGTH; + break; + + case sizeof (GFC_INTEGER_8): + u->recl_subrecord = max_offset - 16; + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + } + } + + /* If the file is direct access, calculate the maximum record number + via a division now instead of letting the multiplication overflow + later. */ + + if (flags->access == ACCESS_DIRECT) + u->maxrec = max_offset / u->recl; + + if (flags->access == ACCESS_STREAM) + { + u->maxrec = max_offset; + u->recl = 1; + u->bytes_left = 1; + u->strm_pos = stell (u->s) + 1; + } + + memmove (u->file, opp->file, opp->file_len); + u->file_len = opp->file_len; + + /* Curiously, the standard requires that the + position specifier be ignored for new files so a newly connected + file starts out at the initial point. We still need to figure + out if the file is at the end or not. */ + + test_endfile (u); + + if (flags->status == STATUS_SCRATCH && opp->file != NULL) + free (opp->file); + + if (flags->form == FORM_FORMATTED) + { + if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)) + fbuf_init (u, u->recl); + else + fbuf_init (u, 0); + } + else + u->fbuf = NULL; + + + + return u; + + cleanup: + + /* Free memory associated with a temporary filename. */ + + if (flags->status == STATUS_SCRATCH && opp->file != NULL) + free (opp->file); + + fail: + + close_unit (u); + return NULL; +} + + +/* Open a unit which is already open. This involves changing the + modes or closing what is there now and opening the new file. */ + +static void +already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) +{ + if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0) + { + edit_modes (opp, u, flags); + return; + } + + /* If the file is connected to something else, close it and open a + new unit. */ + + if (!compare_file_filename (u, opp->file, opp->file_len)) + { +#if !HAVE_UNLINK_OPEN_FILE + char *path = NULL; + if (u->file && u->flags.status == STATUS_SCRATCH) + { + path = (char *) gfc_alloca (u->file_len + 1); + unpack_filename (path, u->file, u->file_len); + } +#endif + + if (sclose (u->s) == -1) + { + unlock_unit (u); + generate_error (&opp->common, LIBERROR_OS, + "Error closing file in OPEN statement"); + return; + } + + u->s = NULL; + if (u->file) + free (u->file); + u->file = NULL; + u->file_len = 0; + +#if !HAVE_UNLINK_OPEN_FILE + if (path != NULL) + unlink (path); +#endif + + u = new_unit (opp, u, flags); + if (u != NULL) + unlock_unit (u); + return; + } + + edit_modes (opp, u, flags); +} + + +/* Open file. */ + +extern void st_open (st_parameter_open *opp); +export_proto(st_open); + +void +st_open (st_parameter_open *opp) +{ + unit_flags flags; + gfc_unit *u = NULL; + GFC_INTEGER_4 cf = opp->common.flags; + unit_convert conv; + + library_start (&opp->common); + + /* Decode options. */ + + flags.access = !(cf & IOPARM_OPEN_HAS_ACCESS) ? ACCESS_UNSPECIFIED : + find_option (&opp->common, opp->access, opp->access_len, + access_opt, "Bad ACCESS parameter in OPEN statement"); + + flags.action = !(cf & IOPARM_OPEN_HAS_ACTION) ? ACTION_UNSPECIFIED : + find_option (&opp->common, opp->action, opp->action_len, + action_opt, "Bad ACTION parameter in OPEN statement"); + + flags.blank = !(cf & IOPARM_OPEN_HAS_BLANK) ? BLANK_UNSPECIFIED : + find_option (&opp->common, opp->blank, opp->blank_len, + blank_opt, "Bad BLANK parameter in OPEN statement"); + + flags.delim = !(cf & IOPARM_OPEN_HAS_DELIM) ? DELIM_UNSPECIFIED : + find_option (&opp->common, opp->delim, opp->delim_len, + delim_opt, "Bad DELIM parameter in OPEN statement"); + + flags.pad = !(cf & IOPARM_OPEN_HAS_PAD) ? PAD_UNSPECIFIED : + find_option (&opp->common, opp->pad, opp->pad_len, + pad_opt, "Bad PAD parameter in OPEN statement"); + + flags.decimal = !(cf & IOPARM_OPEN_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED : + find_option (&opp->common, opp->decimal, opp->decimal_len, + decimal_opt, "Bad DECIMAL parameter in OPEN statement"); + + flags.encoding = !(cf & IOPARM_OPEN_HAS_ENCODING) ? ENCODING_UNSPECIFIED : + find_option (&opp->common, opp->encoding, opp->encoding_len, + encoding_opt, "Bad ENCODING parameter in OPEN statement"); + + flags.async = !(cf & IOPARM_OPEN_HAS_ASYNCHRONOUS) ? ASYNC_UNSPECIFIED : + find_option (&opp->common, opp->asynchronous, opp->asynchronous_len, + async_opt, "Bad ASYNCHRONOUS parameter in OPEN statement"); + + flags.round = !(cf & IOPARM_OPEN_HAS_ROUND) ? ROUND_UNSPECIFIED : + find_option (&opp->common, opp->round, opp->round_len, + round_opt, "Bad ROUND parameter in OPEN statement"); + + flags.sign = !(cf & IOPARM_OPEN_HAS_SIGN) ? SIGN_UNSPECIFIED : + find_option (&opp->common, opp->sign, opp->sign_len, + sign_opt, "Bad SIGN parameter in OPEN statement"); + + flags.form = !(cf & IOPARM_OPEN_HAS_FORM) ? FORM_UNSPECIFIED : + find_option (&opp->common, opp->form, opp->form_len, + form_opt, "Bad FORM parameter in OPEN statement"); + + flags.position = !(cf & IOPARM_OPEN_HAS_POSITION) ? POSITION_UNSPECIFIED : + find_option (&opp->common, opp->position, opp->position_len, + position_opt, "Bad POSITION parameter in OPEN statement"); + + flags.status = !(cf & IOPARM_OPEN_HAS_STATUS) ? STATUS_UNSPECIFIED : + find_option (&opp->common, opp->status, opp->status_len, + status_opt, "Bad STATUS parameter in OPEN statement"); + + /* First, we check wether the convert flag has been set via environment + variable. This overrides the convert tag in the open statement. */ + + conv = get_unformatted_convert (opp->common.unit); + + if (conv == GFC_CONVERT_NONE) + { + /* Nothing has been set by environment variable, check the convert tag. */ + if (cf & IOPARM_OPEN_HAS_CONVERT) + conv = find_option (&opp->common, opp->convert, opp->convert_len, + convert_opt, + "Bad CONVERT parameter in OPEN statement"); + else + conv = compile_options.convert; + } + + /* We use big_endian, which is 0 on little-endian machines + and 1 on big-endian machines. */ + switch (conv) + { + case GFC_CONVERT_NATIVE: + case GFC_CONVERT_SWAP: + break; + + case GFC_CONVERT_BIG: + conv = big_endian ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP; + break; + + case GFC_CONVERT_LITTLE: + conv = big_endian ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE; + break; + + default: + internal_error (&opp->common, "Illegal value for CONVERT"); + break; + } + + flags.convert = conv; + + if (!(opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT) && opp->common.unit < 0) + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Bad unit number in OPEN statement"); + + if (flags.position != POSITION_UNSPECIFIED + && flags.access == ACCESS_DIRECT) + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Cannot use POSITION with direct access files"); + + if (flags.access == ACCESS_APPEND) + { + if (flags.position != POSITION_UNSPECIFIED + && flags.position != POSITION_APPEND) + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Conflicting ACCESS and POSITION flags in" + " OPEN statement"); + + notify_std (&opp->common, GFC_STD_GNU, + "Extension: APPEND as a value for ACCESS in OPEN statement"); + flags.access = ACCESS_SEQUENTIAL; + flags.position = POSITION_APPEND; + } + + if (flags.position == POSITION_UNSPECIFIED) + flags.position = POSITION_ASIS; + + if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK) + { + if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT)) + { + *opp->newunit = get_unique_unit_number(opp); + opp->common.unit = *opp->newunit; + } + + u = find_or_create_unit (opp->common.unit); + if (u->s == NULL) + { + u = new_unit (opp, u, &flags); + if (u != NULL) + unlock_unit (u); + } + else + already_open (opp, u, &flags); + } + + library_end (); +} diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c new file mode 100644 index 000000000..4eda4a2f8 --- /dev/null +++ b/libgfortran/io/read.c @@ -0,0 +1,1179 @@ +/* Copyright (C) 2002, 2003, 2005, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. + Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "io.h" +#include "fbuf.h" +#include "format.h" +#include "unix.h" +#include +#include +#include +#include +#include + +typedef unsigned char uchar; + +/* read.c -- Deal with formatted reads */ + + +/* set_integer()-- All of the integer assignments come here to + actually place the value into memory. */ + +void +set_integer (void *dest, GFC_INTEGER_LARGEST value, int length) +{ + switch (length) + { +#ifdef HAVE_GFC_INTEGER_16 +/* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711. */ + case 10: + case 16: + { + GFC_INTEGER_16 tmp = value; + memcpy (dest, (void *) &tmp, length); + } + break; +#endif + case 8: + { + GFC_INTEGER_8 tmp = value; + memcpy (dest, (void *) &tmp, length); + } + break; + case 4: + { + GFC_INTEGER_4 tmp = value; + memcpy (dest, (void *) &tmp, length); + } + break; + case 2: + { + GFC_INTEGER_2 tmp = value; + memcpy (dest, (void *) &tmp, length); + } + break; + case 1: + { + GFC_INTEGER_1 tmp = value; + memcpy (dest, (void *) &tmp, length); + } + break; + default: + internal_error (NULL, "Bad integer kind"); + } +} + + +/* max_value()-- Given a length (kind), return the maximum signed or + * unsigned value */ + +GFC_UINTEGER_LARGEST +max_value (int length, int signed_flag) +{ + GFC_UINTEGER_LARGEST value; +#if defined HAVE_GFC_REAL_16 || defined HAVE_GFC_REAL_10 + int n; +#endif + + switch (length) + { +#if defined HAVE_GFC_REAL_16 || defined HAVE_GFC_REAL_10 + case 16: + case 10: + value = 1; + for (n = 1; n < 4 * length; n++) + value = (value << 2) + 3; + if (! signed_flag) + value = 2*value+1; + break; +#endif + case 8: + value = signed_flag ? 0x7fffffffffffffff : 0xffffffffffffffff; + break; + case 4: + value = signed_flag ? 0x7fffffff : 0xffffffff; + break; + case 2: + value = signed_flag ? 0x7fff : 0xffff; + break; + case 1: + value = signed_flag ? 0x7f : 0xff; + break; + default: + internal_error (NULL, "Bad integer kind"); + } + + return value; +} + + +/* convert_real()-- Convert a character representation of a floating + point number to the machine number. Returns nonzero if there is a + range problem during conversion. Note: many architectures + (e.g. IA-64, HP-PA) require that the storage pointed to by the dest + argument is properly aligned for the type in question. */ + +int +convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length) +{ + errno = 0; + + switch (length) + { + case 4: + *((GFC_REAL_4*) dest) = +#if defined(HAVE_STRTOF) + gfc_strtof (buffer, NULL); +#else + (GFC_REAL_4) gfc_strtod (buffer, NULL); +#endif + break; + + case 8: + *((GFC_REAL_8*) dest) = gfc_strtod (buffer, NULL); + break; + +#if defined(HAVE_GFC_REAL_10) && defined (HAVE_STRTOLD) + case 10: + *((GFC_REAL_10*) dest) = gfc_strtold (buffer, NULL); + break; +#endif + +#if defined(HAVE_GFC_REAL_16) +# if defined(GFC_REAL_16_IS_FLOAT128) + case 16: + *((GFC_REAL_16*) dest) = __qmath_(strtoflt128) (buffer, NULL); + break; +# elif defined(HAVE_STRTOLD) + case 16: + *((GFC_REAL_16*) dest) = gfc_strtold (buffer, NULL); + break; +# endif +#endif + + default: + internal_error (&dtp->common, "Unsupported real kind during IO"); + } + + if (errno == EINVAL) + { + generate_error (&dtp->common, LIBERROR_READ_VALUE, + "Error during floating point read"); + next_record (dtp, 1); + return 1; + } + + return 0; +} + + +/* read_l()-- Read a logical value */ + +void +read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length) +{ + char *p; + int w; + + w = f->u.w; + + p = read_block_form (dtp, &w); + + if (p == NULL) + return; + + while (*p == ' ') + { + if (--w == 0) + goto bad; + p++; + } + + if (*p == '.') + { + if (--w == 0) + goto bad; + p++; + } + + switch (*p) + { + case 't': + case 'T': + set_integer (dest, (GFC_INTEGER_LARGEST) 1, length); + break; + case 'f': + case 'F': + set_integer (dest, (GFC_INTEGER_LARGEST) 0, length); + break; + default: + bad: + generate_error (&dtp->common, LIBERROR_READ_VALUE, + "Bad value on logical read"); + next_record (dtp, 1); + break; + } +} + + +static gfc_char4_t +read_utf8 (st_parameter_dt *dtp, int *nbytes) +{ + static const uchar masks[6] = { 0x7F, 0x1F, 0x0F, 0x07, 0x02, 0x01 }; + static const uchar patns[6] = { 0x00, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC }; + int i, nb, nread; + gfc_char4_t c; + char *s; + + *nbytes = 1; + + s = read_block_form (dtp, nbytes); + if (s == NULL) + return 0; + + /* If this is a short read, just return. */ + if (*nbytes == 0) + return 0; + + c = (uchar) s[0]; + if (c < 0x80) + return c; + + /* The number of leading 1-bits in the first byte indicates how many + bytes follow. */ + for (nb = 2; nb < 7; nb++) + if ((c & ~masks[nb-1]) == patns[nb-1]) + goto found; + goto invalid; + + found: + c = (c & masks[nb-1]); + nread = nb - 1; + + s = read_block_form (dtp, &nread); + if (s == NULL) + return 0; + /* Decode the bytes read. */ + for (i = 1; i < nb; i++) + { + gfc_char4_t n = *s++; + + if ((n & 0xC0) != 0x80) + goto invalid; + + c = ((c << 6) + (n & 0x3F)); + } + + /* Make sure the shortest possible encoding was used. */ + if (c <= 0x7F && nb > 1) goto invalid; + if (c <= 0x7FF && nb > 2) goto invalid; + if (c <= 0xFFFF && nb > 3) goto invalid; + if (c <= 0x1FFFFF && nb > 4) goto invalid; + if (c <= 0x3FFFFFF && nb > 5) goto invalid; + + /* Make sure the character is valid. */ + if (c > 0x7FFFFFFF || (c >= 0xD800 && c <= 0xDFFF)) + goto invalid; + + return c; + + invalid: + generate_error (&dtp->common, LIBERROR_READ_VALUE, "Invalid UTF-8 encoding"); + return (gfc_char4_t) '?'; +} + + +static void +read_utf8_char1 (st_parameter_dt *dtp, char *p, int len, int width) +{ + gfc_char4_t c; + char *dest; + int nbytes; + int i, j; + + len = (width < len) ? len : width; + + dest = (char *) p; + + /* Proceed with decoding one character at a time. */ + for (j = 0; j < len; j++, dest++) + { + c = read_utf8 (dtp, &nbytes); + + /* Check for a short read and if so, break out. */ + if (nbytes == 0) + break; + + *dest = c > 255 ? '?' : (uchar) c; + } + + /* If there was a short read, pad the remaining characters. */ + for (i = j; i < len; i++) + *dest++ = ' '; + return; +} + +static void +read_default_char1 (st_parameter_dt *dtp, char *p, int len, int width) +{ + char *s; + int m, n; + + s = read_block_form (dtp, &width); + + if (s == NULL) + return; + if (width > len) + s += (width - len); + + m = (width > len) ? len : width; + memcpy (p, s, m); + + n = len - width; + if (n > 0) + memset (p + m, ' ', n); +} + + +static void +read_utf8_char4 (st_parameter_dt *dtp, void *p, int len, int width) +{ + gfc_char4_t *dest; + int nbytes; + int i, j; + + len = (width < len) ? len : width; + + dest = (gfc_char4_t *) p; + + /* Proceed with decoding one character at a time. */ + for (j = 0; j < len; j++, dest++) + { + *dest = read_utf8 (dtp, &nbytes); + + /* Check for a short read and if so, break out. */ + if (nbytes == 0) + break; + } + + /* If there was a short read, pad the remaining characters. */ + for (i = j; i < len; i++) + *dest++ = (gfc_char4_t) ' '; + return; +} + + +static void +read_default_char4 (st_parameter_dt *dtp, char *p, int len, int width) +{ + int m, n; + gfc_char4_t *dest; + + if (is_char4_unit(dtp)) + { + gfc_char4_t *s4; + + s4 = (gfc_char4_t *) read_block_form4 (dtp, &width); + + if (s4 == NULL) + return; + if (width > len) + s4 += (width - len); + + m = ((int) width > len) ? len : (int) width; + + dest = (gfc_char4_t *) p; + + for (n = 0; n < m; n++) + *dest++ = *s4++; + + for (n = 0; n < len - (int) width; n++) + *dest++ = (gfc_char4_t) ' '; + } + else + { + char *s; + + s = read_block_form (dtp, &width); + + if (s == NULL) + return; + if (width > len) + s += (width - len); + + m = ((int) width > len) ? len : (int) width; + + dest = (gfc_char4_t *) p; + + for (n = 0; n < m; n++, dest++, s++) + *dest = (unsigned char ) *s; + + for (n = 0; n < len - (int) width; n++, dest++) + *dest = (unsigned char) ' '; + } +} + + +/* read_a()-- Read a character record into a KIND=1 character destination, + processing UTF-8 encoding if necessary. */ + +void +read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length) +{ + int wi; + int w; + + wi = f->u.w; + if (wi == -1) /* '(A)' edit descriptor */ + wi = length; + w = wi; + + /* Read in w characters, treating comma as not a separator. */ + dtp->u.p.sf_read_comma = 0; + + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + read_utf8_char1 (dtp, p, length, w); + else + read_default_char1 (dtp, p, length, w); + + dtp->u.p.sf_read_comma = + dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1; +} + + +/* read_a_char4()-- Read a character record into a KIND=4 character destination, + processing UTF-8 encoding if necessary. */ + +void +read_a_char4 (st_parameter_dt *dtp, const fnode *f, char *p, int length) +{ + int w; + + w = f->u.w; + if (w == -1) /* '(A)' edit descriptor */ + w = length; + + /* Read in w characters, treating comma as not a separator. */ + dtp->u.p.sf_read_comma = 0; + + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + read_utf8_char4 (dtp, p, length, w); + else + read_default_char4 (dtp, p, length, w); + + dtp->u.p.sf_read_comma = + dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1; +} + +/* eat_leading_spaces()-- Given a character pointer and a width, + * ignore the leading spaces. */ + +static char * +eat_leading_spaces (int *width, char *p) +{ + for (;;) + { + if (*width == 0 || *p != ' ') + break; + + (*width)--; + p++; + } + + return p; +} + + +static char +next_char (st_parameter_dt *dtp, char **p, int *w) +{ + char c, *q; + + if (*w == 0) + return '\0'; + + q = *p; + c = *q++; + *p = q; + + (*w)--; + + if (c != ' ') + return c; + if (dtp->u.p.blank_status != BLANK_UNSPECIFIED) + return ' '; /* return a blank to signal a null */ + + /* At this point, the rest of the field has to be trailing blanks */ + + while (*w > 0) + { + if (*q++ != ' ') + return '?'; + (*w)--; + } + + *p = q; + return '\0'; +} + + +/* read_decimal()-- Read a decimal integer value. The values here are + * signed values. */ + +void +read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length) +{ + GFC_UINTEGER_LARGEST value, maxv, maxv_10; + GFC_INTEGER_LARGEST v; + int w, negative; + char c, *p; + + w = f->u.w; + + p = read_block_form (dtp, &w); + + if (p == NULL) + return; + + p = eat_leading_spaces (&w, p); + if (w == 0) + { + set_integer (dest, (GFC_INTEGER_LARGEST) 0, length); + return; + } + + maxv = max_value (length, 1); + maxv_10 = maxv / 10; + + negative = 0; + value = 0; + + switch (*p) + { + case '-': + negative = 1; + /* Fall through */ + + case '+': + p++; + if (--w == 0) + goto bad; + /* Fall through */ + + default: + break; + } + + /* At this point we have a digit-string */ + value = 0; + + for (;;) + { + c = next_char (dtp, &p, &w); + if (c == '\0') + break; + + if (c == ' ') + { + if (dtp->u.p.blank_status == BLANK_NULL) continue; + if (dtp->u.p.blank_status == BLANK_ZERO) c = '0'; + } + + if (c < '0' || c > '9') + goto bad; + + if (value > maxv_10 && compile_options.range_check == 1) + goto overflow; + + c -= '0'; + value = 10 * value; + + if (value > maxv - c && compile_options.range_check == 1) + goto overflow; + value += c; + } + + v = value; + if (negative) + v = -v; + + set_integer (dest, v, length); + return; + + bad: + generate_error (&dtp->common, LIBERROR_READ_VALUE, + "Bad value during integer read"); + next_record (dtp, 1); + return; + + overflow: + generate_error (&dtp->common, LIBERROR_READ_OVERFLOW, + "Value overflowed during integer read"); + next_record (dtp, 1); + +} + + +/* read_radix()-- This function reads values for non-decimal radixes. + * The difference here is that we treat the values here as unsigned + * values for the purposes of overflow. If minus sign is present and + * the top bit is set, the value will be incorrect. */ + +void +read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length, + int radix) +{ + GFC_UINTEGER_LARGEST value, maxv, maxv_r; + GFC_INTEGER_LARGEST v; + int w, negative; + char c, *p; + + w = f->u.w; + + p = read_block_form (dtp, &w); + + if (p == NULL) + return; + + p = eat_leading_spaces (&w, p); + if (w == 0) + { + set_integer (dest, (GFC_INTEGER_LARGEST) 0, length); + return; + } + + maxv = max_value (length, 0); + maxv_r = maxv / radix; + + negative = 0; + value = 0; + + switch (*p) + { + case '-': + negative = 1; + /* Fall through */ + + case '+': + p++; + if (--w == 0) + goto bad; + /* Fall through */ + + default: + break; + } + + /* At this point we have a digit-string */ + value = 0; + + for (;;) + { + c = next_char (dtp, &p, &w); + if (c == '\0') + break; + if (c == ' ') + { + if (dtp->u.p.blank_status == BLANK_NULL) continue; + if (dtp->u.p.blank_status == BLANK_ZERO) c = '0'; + } + + switch (radix) + { + case 2: + if (c < '0' || c > '1') + goto bad; + break; + + case 8: + if (c < '0' || c > '7') + goto bad; + break; + + case 16: + switch (c) + { + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + break; + + case 'a': + case 'b': + case 'c': + case 'd': + case 'e': + case 'f': + c = c - 'a' + '9' + 1; + break; + + case 'A': + case 'B': + case 'C': + case 'D': + case 'E': + case 'F': + c = c - 'A' + '9' + 1; + break; + + default: + goto bad; + } + + break; + } + + if (value > maxv_r) + goto overflow; + + c -= '0'; + value = radix * value; + + if (maxv - c < value) + goto overflow; + value += c; + } + + v = value; + if (negative) + v = -v; + + set_integer (dest, v, length); + return; + + bad: + generate_error (&dtp->common, LIBERROR_READ_VALUE, + "Bad value during integer read"); + next_record (dtp, 1); + return; + + overflow: + generate_error (&dtp->common, LIBERROR_READ_OVERFLOW, + "Value overflowed during integer read"); + next_record (dtp, 1); + +} + + +/* read_f()-- Read a floating point number with F-style editing, which + is what all of the other floating point descriptors behave as. The + tricky part is that optional spaces are allowed after an E or D, + and the implicit decimal point if a decimal point is not present in + the input. */ + +void +read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length) +{ + int w, seen_dp, exponent; + int exponent_sign; + const char *p; + char *buffer; + char *out; + int seen_int_digit; /* Seen a digit before the decimal point? */ + int seen_dec_digit; /* Seen a digit after the decimal point? */ + + seen_dp = 0; + seen_int_digit = 0; + seen_dec_digit = 0; + exponent_sign = 1; + exponent = 0; + w = f->u.w; + + /* Read in the next block. */ + p = read_block_form (dtp, &w); + if (p == NULL) + return; + p = eat_leading_spaces (&w, (char*) p); + if (w == 0) + goto zero; + + /* In this buffer we're going to re-format the number cleanly to be parsed + by convert_real in the end; this assures we're using strtod from the + C library for parsing and thus probably get the best accuracy possible. + This process may add a '+0.0' in front of the number as well as change the + exponent because of an implicit decimal point or the like. Thus allocating + strlen ("+0.0e-1000") == 10 characters plus one for NUL more than the + original buffer had should be enough. */ + buffer = gfc_alloca (w + 11); + out = buffer; + + /* Optional sign */ + if (*p == '-' || *p == '+') + { + if (*p == '-') + *(out++) = '-'; + ++p; + --w; + } + + p = eat_leading_spaces (&w, (char*) p); + if (w == 0) + goto zero; + + /* Check for Infinity or NaN. */ + if (unlikely ((w >= 3 && (*p == 'i' || *p == 'I' || *p == 'n' || *p == 'N')))) + { + int seen_paren = 0; + char *save = out; + + /* Scan through the buffer keeping track of spaces and parenthesis. We + null terminate the string as soon as we see a left paren or if we are + BLANK_NULL mode. Leading spaces have already been skipped above, + trailing spaces are ignored by converting to '\0'. A space + between "NaN" and the optional perenthesis is not permitted. */ + while (w > 0) + { + *out = tolower (*p); + switch (*p) + { + case ' ': + if (dtp->u.p.blank_status == BLANK_ZERO) + { + *out = '0'; + break; + } + *out = '\0'; + if (seen_paren == 1) + goto bad_float; + break; + case '(': + seen_paren++; + *out = '\0'; + break; + case ')': + if (seen_paren++ != 1) + goto bad_float; + break; + default: + if (!isalnum (*out)) + goto bad_float; + } + --w; + ++p; + ++out; + } + + *out = '\0'; + + if (seen_paren != 0 && seen_paren != 2) + goto bad_float; + + if ((strcmp (save, "inf") == 0) || (strcmp (save, "infinity") == 0)) + { + if (seen_paren) + goto bad_float; + } + else if (strcmp (save, "nan") != 0) + goto bad_float; + + convert_real (dtp, dest, buffer, length); + return; + } + + /* Process the mantissa string. */ + while (w > 0) + { + switch (*p) + { + case ',': + if (dtp->u.p.current_unit->decimal_status != DECIMAL_COMMA) + goto bad_float; + /* Fall through. */ + case '.': + if (seen_dp) + goto bad_float; + if (!seen_int_digit) + *(out++) = '0'; + *(out++) = '.'; + seen_dp = 1; + break; + + case ' ': + if (dtp->u.p.blank_status == BLANK_ZERO) + { + *(out++) = '0'; + goto found_digit; + } + else if (dtp->u.p.blank_status == BLANK_NULL) + break; + else + /* TODO: Should we check instead that there are only trailing + blanks here, as is done below for exponents? */ + goto done; + /* Fall through. */ + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + *(out++) = *p; +found_digit: + if (!seen_dp) + seen_int_digit = 1; + else + seen_dec_digit = 1; + break; + + case '-': + case '+': + goto exponent; + + case 'e': + case 'E': + case 'd': + case 'D': + ++p; + --w; + goto exponent; + + default: + goto bad_float; + } + + ++p; + --w; + } + + /* No exponent has been seen, so we use the current scale factor. */ + exponent = - dtp->u.p.scale_factor; + goto done; + + /* At this point the start of an exponent has been found. */ +exponent: + p = eat_leading_spaces (&w, (char*) p); + if (*p == '-' || *p == '+') + { + if (*p == '-') + exponent_sign = -1; + ++p; + --w; + } + + /* At this point a digit string is required. We calculate the value + of the exponent in order to take account of the scale factor and + the d parameter before explict conversion takes place. */ + + if (w == 0) + goto bad_float; + + if (dtp->u.p.blank_status == BLANK_UNSPECIFIED) + { + while (w > 0 && isdigit (*p)) + { + exponent *= 10; + exponent += *p - '0'; + ++p; + --w; + } + + /* Only allow trailing blanks. */ + while (w > 0) + { + if (*p != ' ') + goto bad_float; + ++p; + --w; + } + } + else /* BZ or BN status is enabled. */ + { + while (w > 0) + { + if (*p == ' ') + { + if (dtp->u.p.blank_status == BLANK_ZERO) + exponent *= 10; + else + assert (dtp->u.p.blank_status == BLANK_NULL); + } + else if (!isdigit (*p)) + goto bad_float; + else + { + exponent *= 10; + exponent += *p - '0'; + } + + ++p; + --w; + } + } + + exponent *= exponent_sign; + +done: + /* Use the precision specified in the format if no decimal point has been + seen. */ + if (!seen_dp) + exponent -= f->u.real.d; + + /* Output a trailing '0' after decimal point if not yet found. */ + if (seen_dp && !seen_dec_digit) + *(out++) = '0'; + + /* Print out the exponent to finish the reformatted number. Maximum 4 + digits for the exponent. */ + if (exponent != 0) + { + int dig; + + *(out++) = 'e'; + if (exponent < 0) + { + *(out++) = '-'; + exponent = - exponent; + } + + assert (exponent < 10000); + for (dig = 3; dig >= 0; --dig) + { + out[dig] = (char) ('0' + exponent % 10); + exponent /= 10; + } + out += 4; + } + *(out++) = '\0'; + + /* Do the actual conversion. */ + convert_real (dtp, dest, buffer, length); + + return; + + /* The value read is zero. */ +zero: + switch (length) + { + case 4: + *((GFC_REAL_4 *) dest) = 0.0; + break; + + case 8: + *((GFC_REAL_8 *) dest) = 0.0; + break; + +#ifdef HAVE_GFC_REAL_10 + case 10: + *((GFC_REAL_10 *) dest) = 0.0; + break; +#endif + +#ifdef HAVE_GFC_REAL_16 + case 16: + *((GFC_REAL_16 *) dest) = 0.0; + break; +#endif + + default: + internal_error (&dtp->common, "Unsupported real kind during IO"); + } + return; + +bad_float: + generate_error (&dtp->common, LIBERROR_READ_VALUE, + "Bad value during floating point read"); + next_record (dtp, 1); + return; +} + + +/* read_x()-- Deal with the X/TR descriptor. We just read some data + * and never look at it. */ + +void +read_x (st_parameter_dt *dtp, int n) +{ + int length, q, q2; + + if ((dtp->u.p.current_unit->pad_status == PAD_NO || is_internal_unit (dtp)) + && dtp->u.p.current_unit->bytes_left < n) + n = dtp->u.p.current_unit->bytes_left; + + if (n == 0) + return; + + length = n; + + if (is_internal_unit (dtp)) + { + mem_alloc_r (dtp->u.p.current_unit->s, &length); + if (unlikely (length < n)) + n = length; + goto done; + } + + if (dtp->u.p.sf_seen_eor) + return; + + n = 0; + while (n < length) + { + q = fbuf_getc (dtp->u.p.current_unit); + if (q == EOF) + break; + else if (q == '\n' || q == '\r') + { + /* Unexpected end of line. Set the position. */ + dtp->u.p.sf_seen_eor = 1; + + /* If we see an EOR during non-advancing I/O, we need to skip + the rest of the I/O statement. Set the corresponding flag. */ + if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar) + dtp->u.p.eor_condition = 1; + + /* If we encounter a CR, it might be a CRLF. */ + if (q == '\r') /* Probably a CRLF */ + { + /* See if there is an LF. */ + q2 = fbuf_getc (dtp->u.p.current_unit); + if (q2 == '\n') + dtp->u.p.sf_seen_eor = 2; + else if (q2 != EOF) /* Oops, seek back. */ + fbuf_seek (dtp->u.p.current_unit, -1, SEEK_CUR); + } + goto done; + } + n++; + } + + done: + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (GFC_IO_INT) n; + dtp->u.p.current_unit->bytes_left -= n; + dtp->u.p.current_unit->strm_pos += (gfc_offset) n; +} + diff --git a/libgfortran/io/size_from_kind.c b/libgfortran/io/size_from_kind.c new file mode 100644 index 000000000..d467df015 --- /dev/null +++ b/libgfortran/io/size_from_kind.c @@ -0,0 +1,83 @@ +/* Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Janne Blomqvist + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* This file contains utility functions for determining the size of a + variable given its kind. */ + +#include "io.h" + +size_t +size_from_real_kind (int kind) +{ + switch (kind) + { +#ifdef HAVE_GFC_REAL_4 + case 4: + return sizeof (GFC_REAL_4); +#endif +#ifdef HAVE_GFC_REAL_8 + case 8: + return sizeof (GFC_REAL_8); +#endif +#ifdef HAVE_GFC_REAL_10 + case 10: + return sizeof (GFC_REAL_10); +#endif +#ifdef HAVE_GFC_REAL_16 + case 16: + return sizeof (GFC_REAL_16); +#endif + default: + return kind; + } +} + + +size_t +size_from_complex_kind (int kind) +{ + switch (kind) + { +#ifdef HAVE_GFC_COMPLEX_4 + case 4: + return sizeof (GFC_COMPLEX_4); +#endif +#ifdef HAVE_GFC_COMPLEX_8 + case 8: + return sizeof (GFC_COMPLEX_8); +#endif +#ifdef HAVE_GFC_COMPLEX_10 + case 10: + return sizeof (GFC_COMPLEX_10); +#endif +#ifdef HAVE_GFC_COMPLEX_16 + case 16: + return sizeof (GFC_COMPLEX_16); +#endif + default: + return 2 * kind; + } +} + diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c new file mode 100644 index 000000000..15f90e767 --- /dev/null +++ b/libgfortran/io/transfer.c @@ -0,0 +1,3745 @@ +/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 + Free Software Foundation, Inc. + Contributed by Andy Vaught + Namelist transfer functions contributed by Paul Thomas + F2003 I/O support contributed by Jerry DeLisle + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* transfer.c -- Top level handling of data transfer statements. */ + +#include "io.h" +#include "fbuf.h" +#include "format.h" +#include "unix.h" +#include +#include +#include +#include + + +/* Calling conventions: Data transfer statements are unlike other + library calls in that they extend over several calls. + + The first call is always a call to st_read() or st_write(). These + subroutines return no status unless a namelist read or write is + being done, in which case there is the usual status. No further + calls are necessary in this case. + + For other sorts of data transfer, there are zero or more data + transfer statement that depend on the format of the data transfer + statement. For READ (and for backwards compatibily: for WRITE), one has + + transfer_integer + transfer_logical + transfer_character + transfer_character_wide + transfer_real + transfer_complex + transfer_real128 + transfer_complex128 + + and for WRITE + + transfer_integer_write + transfer_logical_write + transfer_character_write + transfer_character_wide_write + transfer_real_write + transfer_complex_write + transfer_real128_write + transfer_complex128_write + + These subroutines do not return status. The *128 functions + are in the file transfer128.c. + + The last call is a call to st_[read|write]_done(). While + something can easily go wrong with the initial st_read() or + st_write(), an error inhibits any data from actually being + transferred. */ + +extern void transfer_integer (st_parameter_dt *, void *, int); +export_proto(transfer_integer); + +extern void transfer_integer_write (st_parameter_dt *, void *, int); +export_proto(transfer_integer_write); + +extern void transfer_real (st_parameter_dt *, void *, int); +export_proto(transfer_real); + +extern void transfer_real_write (st_parameter_dt *, void *, int); +export_proto(transfer_real_write); + +extern void transfer_logical (st_parameter_dt *, void *, int); +export_proto(transfer_logical); + +extern void transfer_logical_write (st_parameter_dt *, void *, int); +export_proto(transfer_logical_write); + +extern void transfer_character (st_parameter_dt *, void *, int); +export_proto(transfer_character); + +extern void transfer_character_write (st_parameter_dt *, void *, int); +export_proto(transfer_character_write); + +extern void transfer_character_wide (st_parameter_dt *, void *, int, int); +export_proto(transfer_character_wide); + +extern void transfer_character_wide_write (st_parameter_dt *, + void *, int, int); +export_proto(transfer_character_wide_write); + +extern void transfer_complex (st_parameter_dt *, void *, int); +export_proto(transfer_complex); + +extern void transfer_complex_write (st_parameter_dt *, void *, int); +export_proto(transfer_complex_write); + +extern void transfer_array (st_parameter_dt *, gfc_array_char *, int, + gfc_charlen_type); +export_proto(transfer_array); + +extern void transfer_array_write (st_parameter_dt *, gfc_array_char *, int, + gfc_charlen_type); +export_proto(transfer_array_write); + +static void us_read (st_parameter_dt *, int); +static void us_write (st_parameter_dt *, int); +static void next_record_r_unf (st_parameter_dt *, int); +static void next_record_w_unf (st_parameter_dt *, int); + +static const st_option advance_opt[] = { + {"yes", ADVANCE_YES}, + {"no", ADVANCE_NO}, + {NULL, 0} +}; + + +static const st_option decimal_opt[] = { + {"point", DECIMAL_POINT}, + {"comma", DECIMAL_COMMA}, + {NULL, 0} +}; + +static const st_option round_opt[] = { + {"up", ROUND_UP}, + {"down", ROUND_DOWN}, + {"zero", ROUND_ZERO}, + {"nearest", ROUND_NEAREST}, + {"compatible", ROUND_COMPATIBLE}, + {"processor_defined", ROUND_PROCDEFINED}, + {NULL, 0} +}; + + +static const st_option sign_opt[] = { + {"plus", SIGN_SP}, + {"suppress", SIGN_SS}, + {"processor_defined", SIGN_S}, + {NULL, 0} +}; + +static const st_option blank_opt[] = { + {"null", BLANK_NULL}, + {"zero", BLANK_ZERO}, + {NULL, 0} +}; + +static const st_option delim_opt[] = { + {"apostrophe", DELIM_APOSTROPHE}, + {"quote", DELIM_QUOTE}, + {"none", DELIM_NONE}, + {NULL, 0} +}; + +static const st_option pad_opt[] = { + {"yes", PAD_YES}, + {"no", PAD_NO}, + {NULL, 0} +}; + +typedef enum +{ FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL, + FORMATTED_DIRECT, UNFORMATTED_DIRECT, FORMATTED_STREAM, UNFORMATTED_STREAM +} +file_mode; + + +static file_mode +current_mode (st_parameter_dt *dtp) +{ + file_mode m; + + m = FORM_UNSPECIFIED; + + if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) + { + m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ? + FORMATTED_DIRECT : UNFORMATTED_DIRECT; + } + else if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) + { + m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ? + FORMATTED_SEQUENTIAL : UNFORMATTED_SEQUENTIAL; + } + else if (dtp->u.p.current_unit->flags.access == ACCESS_STREAM) + { + m = dtp->u.p.current_unit->flags.form == FORM_FORMATTED ? + FORMATTED_STREAM : UNFORMATTED_STREAM; + } + + return m; +} + + +/* Mid level data transfer statements. */ + +/* Read sequential file - internal unit */ + +static char * +read_sf_internal (st_parameter_dt *dtp, int * length) +{ + static char *empty_string[0]; + char *base; + int lorig; + + /* Zero size array gives internal unit len of 0. Nothing to read. */ + if (dtp->internal_unit_len == 0 + && dtp->u.p.current_unit->pad_status == PAD_NO) + hit_eof (dtp); + + /* If we have seen an eor previously, return a length of 0. The + caller is responsible for correctly padding the input field. */ + if (dtp->u.p.sf_seen_eor) + { + *length = 0; + /* Just return something that isn't a NULL pointer, otherwise the + caller thinks an error occured. */ + return (char*) empty_string; + } + + lorig = *length; + if (is_char4_unit(dtp)) + { + int i; + gfc_char4_t *p = (gfc_char4_t *) mem_alloc_r4 (dtp->u.p.current_unit->s, + length); + base = fbuf_alloc (dtp->u.p.current_unit, lorig); + for (i = 0; i < *length; i++, p++) + base[i] = *p > 255 ? '?' : (unsigned char) *p; + } + else + base = mem_alloc_r (dtp->u.p.current_unit->s, length); + + if (unlikely (lorig > *length)) + { + hit_eof (dtp); + return NULL; + } + + dtp->u.p.current_unit->bytes_left -= *length; + + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (GFC_IO_INT) *length; + + return base; + +} + +/* When reading sequential formatted records we have a problem. We + don't know how long the line is until we read the trailing newline, + and we don't want to read too much. If we read too much, we might + have to do a physical seek backwards depending on how much data is + present, and devices like terminals aren't seekable and would cause + an I/O error. + + Given this, the solution is to read a byte at a time, stopping if + we hit the newline. For small allocations, we use a static buffer. + For larger allocations, we are forced to allocate memory on the + heap. Hopefully this won't happen very often. */ + +/* Read sequential file - external unit */ + +static char * +read_sf (st_parameter_dt *dtp, int * length) +{ + static char *empty_string[0]; + int q, q2; + int n, lorig, seen_comma; + + /* If we have seen an eor previously, return a length of 0. The + caller is responsible for correctly padding the input field. */ + if (dtp->u.p.sf_seen_eor) + { + *length = 0; + /* Just return something that isn't a NULL pointer, otherwise the + caller thinks an error occured. */ + return (char*) empty_string; + } + + n = seen_comma = 0; + + /* Read data into format buffer and scan through it. */ + lorig = *length; + + while (n < *length) + { + q = fbuf_getc (dtp->u.p.current_unit); + if (q == EOF) + break; + else if (q == '\n' || q == '\r') + { + /* Unexpected end of line. Set the position. */ + dtp->u.p.sf_seen_eor = 1; + + /* If we see an EOR during non-advancing I/O, we need to skip + the rest of the I/O statement. Set the corresponding flag. */ + if (dtp->u.p.advance_status == ADVANCE_NO || dtp->u.p.seen_dollar) + dtp->u.p.eor_condition = 1; + + /* If we encounter a CR, it might be a CRLF. */ + if (q == '\r') /* Probably a CRLF */ + { + /* See if there is an LF. */ + q2 = fbuf_getc (dtp->u.p.current_unit); + if (q2 == '\n') + dtp->u.p.sf_seen_eor = 2; + else if (q2 != EOF) /* Oops, seek back. */ + fbuf_seek (dtp->u.p.current_unit, -1, SEEK_CUR); + } + + /* Without padding, terminate the I/O statement without assigning + the value. With padding, the value still needs to be assigned, + so we can just continue with a short read. */ + if (dtp->u.p.current_unit->pad_status == PAD_NO) + { + generate_error (&dtp->common, LIBERROR_EOR, NULL); + return NULL; + } + + *length = n; + goto done; + } + /* Short circuit the read if a comma is found during numeric input. + The flag is set to zero during character reads so that commas in + strings are not ignored */ + else if (q == ',') + if (dtp->u.p.sf_read_comma == 1) + { + seen_comma = 1; + notify_std (&dtp->common, GFC_STD_GNU, + "Comma in formatted numeric read."); + break; + } + n++; + } + + *length = n; + + /* A short read implies we hit EOF, unless we hit EOR, a comma, or + some other stuff. Set the relevant flags. */ + if (lorig > *length && !dtp->u.p.sf_seen_eor && !seen_comma) + { + if (n > 0) + { + if (dtp->u.p.advance_status == ADVANCE_NO) + { + if (dtp->u.p.current_unit->pad_status == PAD_NO) + { + hit_eof (dtp); + return NULL; + } + else + dtp->u.p.eor_condition = 1; + } + else + dtp->u.p.at_eof = 1; + } + else if (dtp->u.p.advance_status == ADVANCE_NO + || dtp->u.p.current_unit->pad_status == PAD_NO + || dtp->u.p.current_unit->bytes_left + == dtp->u.p.current_unit->recl) + { + hit_eof (dtp); + return NULL; + } + } + + done: + + dtp->u.p.current_unit->bytes_left -= n; + + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (GFC_IO_INT) n; + + /* We can't call fbuf_getptr before the loop doing fbuf_getc, because + fbuf_getc might reallocate the buffer. So return current pointer + minus all the advances, which is n plus up to two characters + of newline or comma. */ + return fbuf_getptr (dtp->u.p.current_unit) + - n - dtp->u.p.sf_seen_eor - seen_comma; +} + + +/* Function for reading the next couple of bytes from the current + file, advancing the current position. We return FAILURE on end of record or + end of file. This function is only for formatted I/O, unformatted uses + read_block_direct. + + If the read is short, then it is because the current record does not + have enough data to satisfy the read request and the file was + opened with PAD=YES. The caller must assume tailing spaces for + short reads. */ + +void * +read_block_form (st_parameter_dt *dtp, int * nbytes) +{ + char *source; + int norig; + + if (!is_stream_io (dtp)) + { + if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes) + { + /* For preconnected units with default record length, set bytes left + to unit record length and proceed, otherwise error. */ + if (dtp->u.p.current_unit->unit_number == options.stdin_unit + && dtp->u.p.current_unit->recl == DEFAULT_RECL) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + else + { + if (unlikely (dtp->u.p.current_unit->pad_status == PAD_NO) + && !is_internal_unit (dtp)) + { + /* Not enough data left. */ + generate_error (&dtp->common, LIBERROR_EOR, NULL); + return NULL; + } + } + + if (unlikely (dtp->u.p.current_unit->bytes_left == 0 + && !is_internal_unit(dtp))) + { + hit_eof (dtp); + return NULL; + } + + *nbytes = dtp->u.p.current_unit->bytes_left; + } + } + + if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && + (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL || + dtp->u.p.current_unit->flags.access == ACCESS_STREAM)) + { + if (is_internal_unit (dtp)) + source = read_sf_internal (dtp, nbytes); + else + source = read_sf (dtp, nbytes); + + dtp->u.p.current_unit->strm_pos += + (gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor); + return source; + } + + /* If we reach here, we can assume it's direct access. */ + + dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes; + + norig = *nbytes; + source = fbuf_read (dtp->u.p.current_unit, nbytes); + fbuf_seek (dtp->u.p.current_unit, *nbytes, SEEK_CUR); + + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (GFC_IO_INT) *nbytes; + + if (norig != *nbytes) + { + /* Short read, this shouldn't happen. */ + if (!dtp->u.p.current_unit->pad_status == PAD_YES) + { + generate_error (&dtp->common, LIBERROR_EOR, NULL); + source = NULL; + } + } + + dtp->u.p.current_unit->strm_pos += (gfc_offset) *nbytes; + + return source; +} + + +/* Read a block from a character(kind=4) internal unit, to be transferred into + a character(kind=4) variable. Note: Portions of this code borrowed from + read_sf_internal. */ +void * +read_block_form4 (st_parameter_dt *dtp, int * nbytes) +{ + static gfc_char4_t *empty_string[0]; + gfc_char4_t *source; + int lorig; + + if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes) + *nbytes = dtp->u.p.current_unit->bytes_left; + + /* Zero size array gives internal unit len of 0. Nothing to read. */ + if (dtp->internal_unit_len == 0 + && dtp->u.p.current_unit->pad_status == PAD_NO) + hit_eof (dtp); + + /* If we have seen an eor previously, return a length of 0. The + caller is responsible for correctly padding the input field. */ + if (dtp->u.p.sf_seen_eor) + { + *nbytes = 0; + /* Just return something that isn't a NULL pointer, otherwise the + caller thinks an error occured. */ + return empty_string; + } + + lorig = *nbytes; + source = (gfc_char4_t *) mem_alloc_r4 (dtp->u.p.current_unit->s, nbytes); + + if (unlikely (lorig > *nbytes)) + { + hit_eof (dtp); + return NULL; + } + + dtp->u.p.current_unit->bytes_left -= *nbytes; + + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (GFC_IO_INT) *nbytes; + + return source; +} + + +/* Reads a block directly into application data space. This is for + unformatted files. */ + +static void +read_block_direct (st_parameter_dt *dtp, void *buf, size_t nbytes) +{ + ssize_t to_read_record; + ssize_t have_read_record; + ssize_t to_read_subrecord; + ssize_t have_read_subrecord; + int short_record; + + if (is_stream_io (dtp)) + { + have_read_record = sread (dtp->u.p.current_unit->s, buf, + nbytes); + if (unlikely (have_read_record < 0)) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return; + } + + dtp->u.p.current_unit->strm_pos += (gfc_offset) have_read_record; + + if (unlikely ((ssize_t) nbytes != have_read_record)) + { + /* Short read, e.g. if we hit EOF. For stream files, + we have to set the end-of-file condition. */ + hit_eof (dtp); + } + return; + } + + if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) + { + if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes) + { + short_record = 1; + to_read_record = dtp->u.p.current_unit->bytes_left; + nbytes = to_read_record; + } + else + { + short_record = 0; + to_read_record = nbytes; + } + + dtp->u.p.current_unit->bytes_left -= to_read_record; + + to_read_record = sread (dtp->u.p.current_unit->s, buf, to_read_record); + if (unlikely (to_read_record < 0)) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return; + } + + if (to_read_record != (ssize_t) nbytes) + { + /* Short read, e.g. if we hit EOF. Apparently, we read + more than was written to the last record. */ + return; + } + + if (unlikely (short_record)) + { + generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); + } + return; + } + + /* Unformatted sequential. We loop over the subrecords, reading + until the request has been fulfilled or the record has run out + of continuation subrecords. */ + + /* Check whether we exceed the total record length. */ + + if (dtp->u.p.current_unit->flags.has_recl + && ((gfc_offset) nbytes > dtp->u.p.current_unit->bytes_left)) + { + to_read_record = dtp->u.p.current_unit->bytes_left; + short_record = 1; + } + else + { + to_read_record = nbytes; + short_record = 0; + } + have_read_record = 0; + + while(1) + { + if (dtp->u.p.current_unit->bytes_left_subrecord + < (gfc_offset) to_read_record) + { + to_read_subrecord = dtp->u.p.current_unit->bytes_left_subrecord; + to_read_record -= to_read_subrecord; + } + else + { + to_read_subrecord = to_read_record; + to_read_record = 0; + } + + dtp->u.p.current_unit->bytes_left_subrecord -= to_read_subrecord; + + have_read_subrecord = sread (dtp->u.p.current_unit->s, + buf + have_read_record, to_read_subrecord); + if (unlikely (have_read_subrecord) < 0) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return; + } + + have_read_record += have_read_subrecord; + + if (unlikely (to_read_subrecord != have_read_subrecord)) + { + /* Short read, e.g. if we hit EOF. This means the record + structure has been corrupted, or the trailing record + marker would still be present. */ + + generate_error (&dtp->common, LIBERROR_CORRUPT_FILE, NULL); + return; + } + + if (to_read_record > 0) + { + if (likely (dtp->u.p.current_unit->continued)) + { + next_record_r_unf (dtp, 0); + us_read (dtp, 1); + } + else + { + /* Let's make sure the file position is correctly pre-positioned + for the next read statement. */ + + dtp->u.p.current_unit->current_record = 0; + next_record_r_unf (dtp, 0); + generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); + return; + } + } + else + { + /* Normal exit, the read request has been fulfilled. */ + break; + } + } + + dtp->u.p.current_unit->bytes_left -= have_read_record; + if (unlikely (short_record)) + { + generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); + return; + } + return; +} + + +/* Function for writing a block of bytes to the current file at the + current position, advancing the file pointer. We are given a length + and return a pointer to a buffer that the caller must (completely) + fill in. Returns NULL on error. */ + +void * +write_block (st_parameter_dt *dtp, int length) +{ + char *dest; + + if (!is_stream_io (dtp)) + { + if (dtp->u.p.current_unit->bytes_left < (gfc_offset) length) + { + /* For preconnected units with default record length, set bytes left + to unit record length and proceed, otherwise error. */ + if (likely ((dtp->u.p.current_unit->unit_number + == options.stdout_unit + || dtp->u.p.current_unit->unit_number + == options.stderr_unit) + && dtp->u.p.current_unit->recl == DEFAULT_RECL)) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + else + { + generate_error (&dtp->common, LIBERROR_EOR, NULL); + return NULL; + } + } + + dtp->u.p.current_unit->bytes_left -= (gfc_offset) length; + } + + if (is_internal_unit (dtp)) + { + if (dtp->common.unit) /* char4 internel unit. */ + { + gfc_char4_t *dest4; + dest4 = mem_alloc_w4 (dtp->u.p.current_unit->s, &length); + if (dest4 == NULL) + { + generate_error (&dtp->common, LIBERROR_END, NULL); + return NULL; + } + return dest4; + } + else + dest = mem_alloc_w (dtp->u.p.current_unit->s, &length); + + if (dest == NULL) + { + generate_error (&dtp->common, LIBERROR_END, NULL); + return NULL; + } + + if (unlikely (dtp->u.p.current_unit->endfile == AT_ENDFILE)) + generate_error (&dtp->common, LIBERROR_END, NULL); + } + else + { + dest = fbuf_alloc (dtp->u.p.current_unit, length); + if (dest == NULL) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return NULL; + } + } + + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used += (GFC_IO_INT) length; + + dtp->u.p.current_unit->strm_pos += (gfc_offset) length; + + return dest; +} + + +/* High level interface to swrite(), taking care of errors. This is only + called for unformatted files. There are three cases to consider: + Stream I/O, unformatted direct, unformatted sequential. */ + +static try +write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) +{ + + ssize_t have_written; + ssize_t to_write_subrecord; + int short_record; + + /* Stream I/O. */ + + if (is_stream_io (dtp)) + { + have_written = swrite (dtp->u.p.current_unit->s, buf, nbytes); + if (unlikely (have_written < 0)) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return FAILURE; + } + + dtp->u.p.current_unit->strm_pos += (gfc_offset) have_written; + + return SUCCESS; + } + + /* Unformatted direct access. */ + + if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) + { + if (unlikely (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes)) + { + generate_error (&dtp->common, LIBERROR_DIRECT_EOR, NULL); + return FAILURE; + } + + if (buf == NULL && nbytes == 0) + return SUCCESS; + + have_written = swrite (dtp->u.p.current_unit->s, buf, nbytes); + if (unlikely (have_written < 0)) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return FAILURE; + } + + dtp->u.p.current_unit->strm_pos += (gfc_offset) have_written; + dtp->u.p.current_unit->bytes_left -= (gfc_offset) have_written; + + return SUCCESS; + } + + /* Unformatted sequential. */ + + have_written = 0; + + if (dtp->u.p.current_unit->flags.has_recl + && (gfc_offset) nbytes > dtp->u.p.current_unit->bytes_left) + { + nbytes = dtp->u.p.current_unit->bytes_left; + short_record = 1; + } + else + { + short_record = 0; + } + + while (1) + { + + to_write_subrecord = + (size_t) dtp->u.p.current_unit->bytes_left_subrecord < nbytes ? + (size_t) dtp->u.p.current_unit->bytes_left_subrecord : nbytes; + + dtp->u.p.current_unit->bytes_left_subrecord -= + (gfc_offset) to_write_subrecord; + + to_write_subrecord = swrite (dtp->u.p.current_unit->s, + buf + have_written, to_write_subrecord); + if (unlikely (to_write_subrecord < 0)) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return FAILURE; + } + + dtp->u.p.current_unit->strm_pos += (gfc_offset) to_write_subrecord; + nbytes -= to_write_subrecord; + have_written += to_write_subrecord; + + if (nbytes == 0) + break; + + next_record_w_unf (dtp, 1); + us_write (dtp, 1); + } + dtp->u.p.current_unit->bytes_left -= have_written; + if (unlikely (short_record)) + { + generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); + return FAILURE; + } + return SUCCESS; +} + + +/* Master function for unformatted reads. */ + +static void +unformatted_read (st_parameter_dt *dtp, bt type, + void *dest, int kind, size_t size, size_t nelems) +{ + if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE) + || kind == 1) + { + if (type == BT_CHARACTER) + size *= GFC_SIZE_OF_CHAR_KIND(kind); + read_block_direct (dtp, dest, size * nelems); + } + else + { + char buffer[16]; + char *p; + size_t i; + + p = dest; + + /* Handle wide chracters. */ + if (type == BT_CHARACTER && kind != 1) + { + nelems *= size; + size = kind; + } + + /* Break up complex into its constituent reals. */ + if (type == BT_COMPLEX) + { + nelems *= 2; + size /= 2; + } + + /* By now, all complex variables have been split into their + constituent reals. */ + + for (i = 0; i < nelems; i++) + { + read_block_direct (dtp, buffer, size); + reverse_memcpy (p, buffer, size); + p += size; + } + } +} + + +/* Master function for unformatted writes. NOTE: For kind=10 the size is 16 + bytes on 64 bit machines. The unused bytes are not initialized and never + used, which can show an error with memory checking analyzers like + valgrind. */ + +static void +unformatted_write (st_parameter_dt *dtp, bt type, + void *source, int kind, size_t size, size_t nelems) +{ + if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE) + || kind == 1) + { + size_t stride = type == BT_CHARACTER ? + size * GFC_SIZE_OF_CHAR_KIND(kind) : size; + + write_buf (dtp, source, stride * nelems); + } + else + { + char buffer[16]; + char *p; + size_t i; + + p = source; + + /* Handle wide chracters. */ + if (type == BT_CHARACTER && kind != 1) + { + nelems *= size; + size = kind; + } + + /* Break up complex into its constituent reals. */ + if (type == BT_COMPLEX) + { + nelems *= 2; + size /= 2; + } + + /* By now, all complex variables have been split into their + constituent reals. */ + + for (i = 0; i < nelems; i++) + { + reverse_memcpy(buffer, p, size); + p += size; + write_buf (dtp, buffer, size); + } + } +} + + +/* Return a pointer to the name of a type. */ + +const char * +type_name (bt type) +{ + const char *p; + + switch (type) + { + case BT_INTEGER: + p = "INTEGER"; + break; + case BT_LOGICAL: + p = "LOGICAL"; + break; + case BT_CHARACTER: + p = "CHARACTER"; + break; + case BT_REAL: + p = "REAL"; + break; + case BT_COMPLEX: + p = "COMPLEX"; + break; + default: + internal_error (NULL, "type_name(): Bad type"); + } + + return p; +} + + +/* Write a constant string to the output. + This is complicated because the string can have doubled delimiters + in it. The length in the format node is the true length. */ + +static void +write_constant_string (st_parameter_dt *dtp, const fnode *f) +{ + char c, delimiter, *p, *q; + int length; + + length = f->u.string.length; + if (length == 0) + return; + + p = write_block (dtp, length); + if (p == NULL) + return; + + q = f->u.string.p; + delimiter = q[-1]; + + for (; length > 0; length--) + { + c = *p++ = *q++; + if (c == delimiter && c != 'H' && c != 'h') + q++; /* Skip the doubled delimiter. */ + } +} + + +/* Given actual and expected types in a formatted data transfer, make + sure they agree. If not, an error message is generated. Returns + nonzero if something went wrong. */ + +static int +require_type (st_parameter_dt *dtp, bt expected, bt actual, const fnode *f) +{ + char buffer[100]; + + if (actual == expected) + return 0; + + /* Adjust item_count before emitting error message. */ + sprintf (buffer, "Expected %s for item %d in formatted transfer, got %s", + type_name (expected), dtp->u.p.item_count - 1, type_name (actual)); + + format_error (dtp, f, buffer); + return 1; +} + + +/* This function is in the main loop for a formatted data transfer + statement. It would be natural to implement this as a coroutine + with the user program, but C makes that awkward. We loop, + processing format elements. When we actually have to transfer + data instead of just setting flags, we return control to the user + program which calls a function that supplies the address and type + of the next element, then comes back here to process it. */ + +static void +formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind, + size_t size) +{ + int pos, bytes_used; + const fnode *f; + format_token t; + int n; + int consume_data_flag; + + /* Change a complex data item into a pair of reals. */ + + n = (p == NULL) ? 0 : ((type != BT_COMPLEX) ? 1 : 2); + if (type == BT_COMPLEX) + { + type = BT_REAL; + size /= 2; + } + + /* If there's an EOR condition, we simulate finalizing the transfer + by doing nothing. */ + if (dtp->u.p.eor_condition) + return; + + /* Set this flag so that commas in reads cause the read to complete before + the entire field has been read. The next read field will start right after + the comma in the stream. (Set to 0 for character reads). */ + dtp->u.p.sf_read_comma = + dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1; + + for (;;) + { + /* If reversion has occurred and there is another real data item, + then we have to move to the next record. */ + if (dtp->u.p.reversion_flag && n > 0) + { + dtp->u.p.reversion_flag = 0; + next_record (dtp, 0); + } + + consume_data_flag = 1; + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + break; + + f = next_format (dtp); + if (f == NULL) + { + /* No data descriptors left. */ + if (unlikely (n > 0)) + generate_error (&dtp->common, LIBERROR_FORMAT, + "Insufficient data descriptors in format after reversion"); + return; + } + + t = f->format; + + bytes_used = (int)(dtp->u.p.current_unit->recl + - dtp->u.p.current_unit->bytes_left); + + if (is_stream_io(dtp)) + bytes_used = 0; + + switch (t) + { + case FMT_I: + if (n == 0) + goto need_read_data; + if (require_type (dtp, BT_INTEGER, type, f)) + return; + read_decimal (dtp, f, p, kind); + break; + + case FMT_B: + if (n == 0) + goto need_read_data; + if (!(compile_options.allow_std & GFC_STD_GNU) + && require_type (dtp, BT_INTEGER, type, f)) + return; + read_radix (dtp, f, p, kind, 2); + break; + + case FMT_O: + if (n == 0) + goto need_read_data; + if (!(compile_options.allow_std & GFC_STD_GNU) + && require_type (dtp, BT_INTEGER, type, f)) + return; + read_radix (dtp, f, p, kind, 8); + break; + + case FMT_Z: + if (n == 0) + goto need_read_data; + if (!(compile_options.allow_std & GFC_STD_GNU) + && require_type (dtp, BT_INTEGER, type, f)) + return; + read_radix (dtp, f, p, kind, 16); + break; + + case FMT_A: + if (n == 0) + goto need_read_data; + + /* It is possible to have FMT_A with something not BT_CHARACTER such + as when writing out hollerith strings, so check both type + and kind before calling wide character routines. */ + if (type == BT_CHARACTER && kind == 4) + read_a_char4 (dtp, f, p, size); + else + read_a (dtp, f, p, size); + break; + + case FMT_L: + if (n == 0) + goto need_read_data; + read_l (dtp, f, p, kind); + break; + + case FMT_D: + if (n == 0) + goto need_read_data; + if (require_type (dtp, BT_REAL, type, f)) + return; + read_f (dtp, f, p, kind); + break; + + case FMT_E: + if (n == 0) + goto need_read_data; + if (require_type (dtp, BT_REAL, type, f)) + return; + read_f (dtp, f, p, kind); + break; + + case FMT_EN: + if (n == 0) + goto need_read_data; + if (require_type (dtp, BT_REAL, type, f)) + return; + read_f (dtp, f, p, kind); + break; + + case FMT_ES: + if (n == 0) + goto need_read_data; + if (require_type (dtp, BT_REAL, type, f)) + return; + read_f (dtp, f, p, kind); + break; + + case FMT_F: + if (n == 0) + goto need_read_data; + if (require_type (dtp, BT_REAL, type, f)) + return; + read_f (dtp, f, p, kind); + break; + + case FMT_G: + if (n == 0) + goto need_read_data; + switch (type) + { + case BT_INTEGER: + read_decimal (dtp, f, p, kind); + break; + case BT_LOGICAL: + read_l (dtp, f, p, kind); + break; + case BT_CHARACTER: + if (kind == 4) + read_a_char4 (dtp, f, p, size); + else + read_a (dtp, f, p, size); + break; + case BT_REAL: + read_f (dtp, f, p, kind); + break; + default: + internal_error (&dtp->common, "formatted_transfer(): Bad type"); + } + break; + + case FMT_STRING: + consume_data_flag = 0; + format_error (dtp, f, "Constant string in input format"); + return; + + /* Format codes that don't transfer data. */ + case FMT_X: + case FMT_TR: + consume_data_flag = 0; + dtp->u.p.skips += f->u.n; + pos = bytes_used + dtp->u.p.skips - 1; + dtp->u.p.pending_spaces = pos - dtp->u.p.max_pos + 1; + read_x (dtp, f->u.n); + break; + + case FMT_TL: + case FMT_T: + consume_data_flag = 0; + + if (f->format == FMT_TL) + { + /* Handle the special case when no bytes have been used yet. + Cannot go below zero. */ + if (bytes_used == 0) + { + dtp->u.p.pending_spaces -= f->u.n; + dtp->u.p.skips -= f->u.n; + dtp->u.p.skips = dtp->u.p.skips < 0 ? 0 : dtp->u.p.skips; + } + + pos = bytes_used - f->u.n; + } + else /* FMT_T */ + pos = f->u.n - 1; + + /* Standard 10.6.1.1: excessive left tabbing is reset to the + left tab limit. We do not check if the position has gone + beyond the end of record because a subsequent tab could + bring us back again. */ + pos = pos < 0 ? 0 : pos; + + dtp->u.p.skips = dtp->u.p.skips + pos - bytes_used; + dtp->u.p.pending_spaces = dtp->u.p.pending_spaces + + pos - dtp->u.p.max_pos; + dtp->u.p.pending_spaces = dtp->u.p.pending_spaces < 0 + ? 0 : dtp->u.p.pending_spaces; + if (dtp->u.p.skips == 0) + break; + + /* Adjust everything for end-of-record condition */ + if (dtp->u.p.sf_seen_eor && !is_internal_unit (dtp)) + { + dtp->u.p.current_unit->bytes_left -= dtp->u.p.sf_seen_eor; + dtp->u.p.skips -= dtp->u.p.sf_seen_eor; + bytes_used = pos; + dtp->u.p.sf_seen_eor = 0; + } + if (dtp->u.p.skips < 0) + { + if (is_internal_unit (dtp)) + sseek (dtp->u.p.current_unit->s, dtp->u.p.skips, SEEK_CUR); + else + fbuf_seek (dtp->u.p.current_unit, dtp->u.p.skips, SEEK_CUR); + dtp->u.p.current_unit->bytes_left -= (gfc_offset) dtp->u.p.skips; + dtp->u.p.skips = dtp->u.p.pending_spaces = 0; + } + else + read_x (dtp, dtp->u.p.skips); + break; + + case FMT_S: + consume_data_flag = 0; + dtp->u.p.sign_status = SIGN_S; + break; + + case FMT_SS: + consume_data_flag = 0; + dtp->u.p.sign_status = SIGN_SS; + break; + + case FMT_SP: + consume_data_flag = 0; + dtp->u.p.sign_status = SIGN_SP; + break; + + case FMT_BN: + consume_data_flag = 0 ; + dtp->u.p.blank_status = BLANK_NULL; + break; + + case FMT_BZ: + consume_data_flag = 0; + dtp->u.p.blank_status = BLANK_ZERO; + break; + + case FMT_DC: + consume_data_flag = 0; + dtp->u.p.current_unit->decimal_status = DECIMAL_COMMA; + break; + + case FMT_DP: + consume_data_flag = 0; + dtp->u.p.current_unit->decimal_status = DECIMAL_POINT; + break; + + case FMT_RC: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_COMPATIBLE; + break; + + case FMT_RD: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_DOWN; + break; + + case FMT_RN: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_NEAREST; + break; + + case FMT_RP: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_PROCDEFINED; + break; + + case FMT_RU: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_UP; + break; + + case FMT_RZ: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_ZERO; + break; + + case FMT_P: + consume_data_flag = 0; + dtp->u.p.scale_factor = f->u.k; + break; + + case FMT_DOLLAR: + consume_data_flag = 0; + dtp->u.p.seen_dollar = 1; + break; + + case FMT_SLASH: + consume_data_flag = 0; + dtp->u.p.skips = dtp->u.p.pending_spaces = 0; + next_record (dtp, 0); + break; + + case FMT_COLON: + /* A colon descriptor causes us to exit this loop (in + particular preventing another / descriptor from being + processed) unless there is another data item to be + transferred. */ + consume_data_flag = 0; + if (n == 0) + return; + break; + + default: + internal_error (&dtp->common, "Bad format node"); + } + + /* Adjust the item count and data pointer. */ + + if ((consume_data_flag > 0) && (n > 0)) + { + n--; + p = ((char *) p) + size; + } + + dtp->u.p.skips = 0; + + pos = (int)(dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left); + dtp->u.p.max_pos = (dtp->u.p.max_pos > pos) ? dtp->u.p.max_pos : pos; + } + + return; + + /* Come here when we need a data descriptor but don't have one. We + push the current format node back onto the input, then return and + let the user program call us back with the data. */ + need_read_data: + unget_format (dtp, f); +} + + +static void +formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kind, + size_t size) +{ + int pos, bytes_used; + const fnode *f; + format_token t; + int n; + int consume_data_flag; + + /* Change a complex data item into a pair of reals. */ + + n = (p == NULL) ? 0 : ((type != BT_COMPLEX) ? 1 : 2); + if (type == BT_COMPLEX) + { + type = BT_REAL; + size /= 2; + } + + /* If there's an EOR condition, we simulate finalizing the transfer + by doing nothing. */ + if (dtp->u.p.eor_condition) + return; + + /* Set this flag so that commas in reads cause the read to complete before + the entire field has been read. The next read field will start right after + the comma in the stream. (Set to 0 for character reads). */ + dtp->u.p.sf_read_comma = + dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA ? 0 : 1; + + for (;;) + { + /* If reversion has occurred and there is another real data item, + then we have to move to the next record. */ + if (dtp->u.p.reversion_flag && n > 0) + { + dtp->u.p.reversion_flag = 0; + next_record (dtp, 0); + } + + consume_data_flag = 1; + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + break; + + f = next_format (dtp); + if (f == NULL) + { + /* No data descriptors left. */ + if (unlikely (n > 0)) + generate_error (&dtp->common, LIBERROR_FORMAT, + "Insufficient data descriptors in format after reversion"); + return; + } + + /* Now discharge T, TR and X movements to the right. This is delayed + until a data producing format to suppress trailing spaces. */ + + t = f->format; + if (dtp->u.p.mode == WRITING && dtp->u.p.skips != 0 + && ((n>0 && ( t == FMT_I || t == FMT_B || t == FMT_O + || t == FMT_Z || t == FMT_F || t == FMT_E + || t == FMT_EN || t == FMT_ES || t == FMT_G + || t == FMT_L || t == FMT_A || t == FMT_D)) + || t == FMT_STRING)) + { + if (dtp->u.p.skips > 0) + { + int tmp; + write_x (dtp, dtp->u.p.skips, dtp->u.p.pending_spaces); + tmp = (int)(dtp->u.p.current_unit->recl + - dtp->u.p.current_unit->bytes_left); + dtp->u.p.max_pos = + dtp->u.p.max_pos > tmp ? dtp->u.p.max_pos : tmp; + } + if (dtp->u.p.skips < 0) + { + if (is_internal_unit (dtp)) + sseek (dtp->u.p.current_unit->s, dtp->u.p.skips, SEEK_CUR); + else + fbuf_seek (dtp->u.p.current_unit, dtp->u.p.skips, SEEK_CUR); + dtp->u.p.current_unit->bytes_left -= (gfc_offset) dtp->u.p.skips; + } + dtp->u.p.skips = dtp->u.p.pending_spaces = 0; + } + + bytes_used = (int)(dtp->u.p.current_unit->recl + - dtp->u.p.current_unit->bytes_left); + + if (is_stream_io(dtp)) + bytes_used = 0; + + switch (t) + { + case FMT_I: + if (n == 0) + goto need_data; + if (require_type (dtp, BT_INTEGER, type, f)) + return; + write_i (dtp, f, p, kind); + break; + + case FMT_B: + if (n == 0) + goto need_data; + if (!(compile_options.allow_std & GFC_STD_GNU) + && require_type (dtp, BT_INTEGER, type, f)) + return; + write_b (dtp, f, p, kind); + break; + + case FMT_O: + if (n == 0) + goto need_data; + if (!(compile_options.allow_std & GFC_STD_GNU) + && require_type (dtp, BT_INTEGER, type, f)) + return; + write_o (dtp, f, p, kind); + break; + + case FMT_Z: + if (n == 0) + goto need_data; + if (!(compile_options.allow_std & GFC_STD_GNU) + && require_type (dtp, BT_INTEGER, type, f)) + return; + write_z (dtp, f, p, kind); + break; + + case FMT_A: + if (n == 0) + goto need_data; + + /* It is possible to have FMT_A with something not BT_CHARACTER such + as when writing out hollerith strings, so check both type + and kind before calling wide character routines. */ + if (type == BT_CHARACTER && kind == 4) + write_a_char4 (dtp, f, p, size); + else + write_a (dtp, f, p, size); + break; + + case FMT_L: + if (n == 0) + goto need_data; + write_l (dtp, f, p, kind); + break; + + case FMT_D: + if (n == 0) + goto need_data; + if (require_type (dtp, BT_REAL, type, f)) + return; + write_d (dtp, f, p, kind); + break; + + case FMT_E: + if (n == 0) + goto need_data; + if (require_type (dtp, BT_REAL, type, f)) + return; + write_e (dtp, f, p, kind); + break; + + case FMT_EN: + if (n == 0) + goto need_data; + if (require_type (dtp, BT_REAL, type, f)) + return; + write_en (dtp, f, p, kind); + break; + + case FMT_ES: + if (n == 0) + goto need_data; + if (require_type (dtp, BT_REAL, type, f)) + return; + write_es (dtp, f, p, kind); + break; + + case FMT_F: + if (n == 0) + goto need_data; + if (require_type (dtp, BT_REAL, type, f)) + return; + write_f (dtp, f, p, kind); + break; + + case FMT_G: + if (n == 0) + goto need_data; + switch (type) + { + case BT_INTEGER: + write_i (dtp, f, p, kind); + break; + case BT_LOGICAL: + write_l (dtp, f, p, kind); + break; + case BT_CHARACTER: + if (kind == 4) + write_a_char4 (dtp, f, p, size); + else + write_a (dtp, f, p, size); + break; + case BT_REAL: + if (f->u.real.w == 0) + write_real_g0 (dtp, p, kind, f->u.real.d); + else + write_d (dtp, f, p, kind); + break; + default: + internal_error (&dtp->common, + "formatted_transfer(): Bad type"); + } + break; + + case FMT_STRING: + consume_data_flag = 0; + write_constant_string (dtp, f); + break; + + /* Format codes that don't transfer data. */ + case FMT_X: + case FMT_TR: + consume_data_flag = 0; + + dtp->u.p.skips += f->u.n; + pos = bytes_used + dtp->u.p.skips - 1; + dtp->u.p.pending_spaces = pos - dtp->u.p.max_pos + 1; + /* Writes occur just before the switch on f->format, above, so + that trailing blanks are suppressed, unless we are doing a + non-advancing write in which case we want to output the blanks + now. */ + if (dtp->u.p.advance_status == ADVANCE_NO) + { + write_x (dtp, dtp->u.p.skips, dtp->u.p.pending_spaces); + dtp->u.p.skips = dtp->u.p.pending_spaces = 0; + } + break; + + case FMT_TL: + case FMT_T: + consume_data_flag = 0; + + if (f->format == FMT_TL) + { + + /* Handle the special case when no bytes have been used yet. + Cannot go below zero. */ + if (bytes_used == 0) + { + dtp->u.p.pending_spaces -= f->u.n; + dtp->u.p.skips -= f->u.n; + dtp->u.p.skips = dtp->u.p.skips < 0 ? 0 : dtp->u.p.skips; + } + + pos = bytes_used - f->u.n; + } + else /* FMT_T */ + pos = f->u.n - dtp->u.p.pending_spaces - 1; + + /* Standard 10.6.1.1: excessive left tabbing is reset to the + left tab limit. We do not check if the position has gone + beyond the end of record because a subsequent tab could + bring us back again. */ + pos = pos < 0 ? 0 : pos; + + dtp->u.p.skips = dtp->u.p.skips + pos - bytes_used; + dtp->u.p.pending_spaces = dtp->u.p.pending_spaces + + pos - dtp->u.p.max_pos; + dtp->u.p.pending_spaces = dtp->u.p.pending_spaces < 0 + ? 0 : dtp->u.p.pending_spaces; + break; + + case FMT_S: + consume_data_flag = 0; + dtp->u.p.sign_status = SIGN_S; + break; + + case FMT_SS: + consume_data_flag = 0; + dtp->u.p.sign_status = SIGN_SS; + break; + + case FMT_SP: + consume_data_flag = 0; + dtp->u.p.sign_status = SIGN_SP; + break; + + case FMT_BN: + consume_data_flag = 0 ; + dtp->u.p.blank_status = BLANK_NULL; + break; + + case FMT_BZ: + consume_data_flag = 0; + dtp->u.p.blank_status = BLANK_ZERO; + break; + + case FMT_DC: + consume_data_flag = 0; + dtp->u.p.current_unit->decimal_status = DECIMAL_COMMA; + break; + + case FMT_DP: + consume_data_flag = 0; + dtp->u.p.current_unit->decimal_status = DECIMAL_POINT; + break; + + case FMT_RC: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_COMPATIBLE; + break; + + case FMT_RD: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_DOWN; + break; + + case FMT_RN: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_NEAREST; + break; + + case FMT_RP: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_PROCDEFINED; + break; + + case FMT_RU: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_UP; + break; + + case FMT_RZ: + consume_data_flag = 0; + dtp->u.p.current_unit->round_status = ROUND_ZERO; + break; + + case FMT_P: + consume_data_flag = 0; + dtp->u.p.scale_factor = f->u.k; + break; + + case FMT_DOLLAR: + consume_data_flag = 0; + dtp->u.p.seen_dollar = 1; + break; + + case FMT_SLASH: + consume_data_flag = 0; + dtp->u.p.skips = dtp->u.p.pending_spaces = 0; + next_record (dtp, 0); + break; + + case FMT_COLON: + /* A colon descriptor causes us to exit this loop (in + particular preventing another / descriptor from being + processed) unless there is another data item to be + transferred. */ + consume_data_flag = 0; + if (n == 0) + return; + break; + + default: + internal_error (&dtp->common, "Bad format node"); + } + + /* Adjust the item count and data pointer. */ + + if ((consume_data_flag > 0) && (n > 0)) + { + n--; + p = ((char *) p) + size; + } + + pos = (int)(dtp->u.p.current_unit->recl - dtp->u.p.current_unit->bytes_left); + dtp->u.p.max_pos = (dtp->u.p.max_pos > pos) ? dtp->u.p.max_pos : pos; + } + + return; + + /* Come here when we need a data descriptor but don't have one. We + push the current format node back onto the input, then return and + let the user program call us back with the data. */ + need_data: + unget_format (dtp, f); +} + + /* This function is first called from data_init_transfer to initiate the loop + over each item in the format, transferring data as required. Subsequent + calls to this function occur for each data item foound in the READ/WRITE + statement. The item_count is incremented for each call. Since the first + call is from data_transfer_init, the item_count is always one greater than + the actual count number of the item being transferred. */ + +static void +formatted_transfer (st_parameter_dt *dtp, bt type, void *p, int kind, + size_t size, size_t nelems) +{ + size_t elem; + char *tmp; + + tmp = (char *) p; + size_t stride = type == BT_CHARACTER ? + size * GFC_SIZE_OF_CHAR_KIND(kind) : size; + if (dtp->u.p.mode == READING) + { + /* Big loop over all the elements. */ + for (elem = 0; elem < nelems; elem++) + { + dtp->u.p.item_count++; + formatted_transfer_scalar_read (dtp, type, tmp + stride*elem, kind, size); + } + } + else + { + /* Big loop over all the elements. */ + for (elem = 0; elem < nelems; elem++) + { + dtp->u.p.item_count++; + formatted_transfer_scalar_write (dtp, type, tmp + stride*elem, kind, size); + } + } +} + + +/* Data transfer entry points. The type of the data entity is + implicit in the subroutine call. This prevents us from having to + share a common enum with the compiler. */ + +void +transfer_integer (st_parameter_dt *dtp, void *p, int kind) +{ + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + return; + dtp->u.p.transfer (dtp, BT_INTEGER, p, kind, kind, 1); +} + +void +transfer_integer_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_integer (dtp, p, kind); +} + +void +transfer_real (st_parameter_dt *dtp, void *p, int kind) +{ + size_t size; + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + return; + size = size_from_real_kind (kind); + dtp->u.p.transfer (dtp, BT_REAL, p, kind, size, 1); +} + +void +transfer_real_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_real (dtp, p, kind); +} + +void +transfer_logical (st_parameter_dt *dtp, void *p, int kind) +{ + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + return; + dtp->u.p.transfer (dtp, BT_LOGICAL, p, kind, kind, 1); +} + +void +transfer_logical_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_logical (dtp, p, kind); +} + +void +transfer_character (st_parameter_dt *dtp, void *p, int len) +{ + static char *empty_string[0]; + + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + return; + + /* Strings of zero length can have p == NULL, which confuses the + transfer routines into thinking we need more data elements. To avoid + this, we give them a nice pointer. */ + if (len == 0 && p == NULL) + p = empty_string; + + /* Set kind here to 1. */ + dtp->u.p.transfer (dtp, BT_CHARACTER, p, 1, len, 1); +} + +void +transfer_character_write (st_parameter_dt *dtp, void *p, int len) +{ + transfer_character (dtp, p, len); +} + +void +transfer_character_wide (st_parameter_dt *dtp, void *p, int len, int kind) +{ + static char *empty_string[0]; + + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + return; + + /* Strings of zero length can have p == NULL, which confuses the + transfer routines into thinking we need more data elements. To avoid + this, we give them a nice pointer. */ + if (len == 0 && p == NULL) + p = empty_string; + + /* Here we pass the actual kind value. */ + dtp->u.p.transfer (dtp, BT_CHARACTER, p, kind, len, 1); +} + +void +transfer_character_wide_write (st_parameter_dt *dtp, void *p, int len, int kind) +{ + transfer_character_wide (dtp, p, len, kind); +} + +void +transfer_complex (st_parameter_dt *dtp, void *p, int kind) +{ + size_t size; + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + return; + size = size_from_complex_kind (kind); + dtp->u.p.transfer (dtp, BT_COMPLEX, p, kind, size, 1); +} + +void +transfer_complex_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_complex (dtp, p, kind); +} + +void +transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, + gfc_charlen_type charlen) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type stride[GFC_MAX_DIMENSIONS]; + index_type stride0, rank, size, n; + size_t tsize; + char *data; + bt iotype; + + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + return; + + iotype = (bt) GFC_DESCRIPTOR_TYPE (desc); + size = iotype == BT_CHARACTER ? charlen : GFC_DESCRIPTOR_SIZE (desc); + + rank = GFC_DESCRIPTOR_RANK (desc); + for (n = 0; n < rank; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(desc,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(desc,n); + + /* If the extent of even one dimension is zero, then the entire + array section contains zero elements, so we return after writing + a zero array record. */ + if (extent[n] <= 0) + { + data = NULL; + tsize = 0; + dtp->u.p.transfer (dtp, iotype, data, kind, size, tsize); + return; + } + } + + stride0 = stride[0]; + + /* If the innermost dimension has a stride of 1, we can do the transfer + in contiguous chunks. */ + if (stride0 == size) + tsize = extent[0]; + else + tsize = 1; + + data = GFC_DESCRIPTOR_DATA (desc); + + while (data) + { + dtp->u.p.transfer (dtp, iotype, data, kind, size, tsize); + data += stride0 * tsize; + count[0] += tsize; + n = 0; + while (count[n] == extent[n]) + { + count[n] = 0; + data -= stride[n] * extent[n]; + n++; + if (n == rank) + { + data = NULL; + break; + } + else + { + count[n]++; + data += stride[n]; + } + } + } +} + +void +transfer_array_write (st_parameter_dt *dtp, gfc_array_char *desc, int kind, + gfc_charlen_type charlen) +{ + transfer_array (dtp, desc, kind, charlen); +} + +/* Preposition a sequential unformatted file while reading. */ + +static void +us_read (st_parameter_dt *dtp, int continued) +{ + ssize_t n, nr; + GFC_INTEGER_4 i4; + GFC_INTEGER_8 i8; + gfc_offset i; + + if (compile_options.record_marker == 0) + n = sizeof (GFC_INTEGER_4); + else + n = compile_options.record_marker; + + nr = sread (dtp->u.p.current_unit->s, &i, n); + if (unlikely (nr < 0)) + { + generate_error (&dtp->common, LIBERROR_BAD_US, NULL); + return; + } + else if (nr == 0) + { + hit_eof (dtp); + return; /* end of file */ + } + else if (unlikely (n != nr)) + { + generate_error (&dtp->common, LIBERROR_BAD_US, NULL); + return; + } + + /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ + if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE)) + { + switch (nr) + { + case sizeof(GFC_INTEGER_4): + memcpy (&i4, &i, sizeof (i4)); + i = i4; + break; + + case sizeof(GFC_INTEGER_8): + memcpy (&i8, &i, sizeof (i8)); + i = i8; + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + } + else + switch (nr) + { + case sizeof(GFC_INTEGER_4): + reverse_memcpy (&i4, &i, sizeof (i4)); + i = i4; + break; + + case sizeof(GFC_INTEGER_8): + reverse_memcpy (&i8, &i, sizeof (i8)); + i = i8; + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + + if (i >= 0) + { + dtp->u.p.current_unit->bytes_left_subrecord = i; + dtp->u.p.current_unit->continued = 0; + } + else + { + dtp->u.p.current_unit->bytes_left_subrecord = -i; + dtp->u.p.current_unit->continued = 1; + } + + if (! continued) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; +} + + +/* Preposition a sequential unformatted file while writing. This + amount to writing a bogus length that will be filled in later. */ + +static void +us_write (st_parameter_dt *dtp, int continued) +{ + ssize_t nbytes; + gfc_offset dummy; + + dummy = 0; + + if (compile_options.record_marker == 0) + nbytes = sizeof (GFC_INTEGER_4); + else + nbytes = compile_options.record_marker ; + + if (swrite (dtp->u.p.current_unit->s, &dummy, nbytes) != nbytes) + generate_error (&dtp->common, LIBERROR_OS, NULL); + + /* For sequential unformatted, if RECL= was not specified in the OPEN + we write until we have more bytes than can fit in the subrecord + markers, then we write a new subrecord. */ + + dtp->u.p.current_unit->bytes_left_subrecord = + dtp->u.p.current_unit->recl_subrecord; + dtp->u.p.current_unit->continued = continued; +} + + +/* Position to the next record prior to transfer. We are assumed to + be before the next record. We also calculate the bytes in the next + record. */ + +static void +pre_position (st_parameter_dt *dtp) +{ + if (dtp->u.p.current_unit->current_record) + return; /* Already positioned. */ + + switch (current_mode (dtp)) + { + case FORMATTED_STREAM: + case UNFORMATTED_STREAM: + /* There are no records with stream I/O. If the position was specified + data_transfer_init has already positioned the file. If no position + was specified, we continue from where we last left off. I.e. + there is nothing to do here. */ + break; + + case UNFORMATTED_SEQUENTIAL: + if (dtp->u.p.mode == READING) + us_read (dtp, 0); + else + us_write (dtp, 0); + + break; + + case FORMATTED_SEQUENTIAL: + case FORMATTED_DIRECT: + case UNFORMATTED_DIRECT: + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + break; + } + + dtp->u.p.current_unit->current_record = 1; +} + + +/* Initialize things for a data transfer. This code is common for + both reading and writing. */ + +static void +data_transfer_init (st_parameter_dt *dtp, int read_flag) +{ + unit_flags u_flags; /* Used for creating a unit if needed. */ + GFC_INTEGER_4 cf = dtp->common.flags; + namelist_info *ionml; + + ionml = ((cf & IOPARM_DT_IONML_SET) != 0) ? dtp->u.p.ionml : NULL; + + memset (&dtp->u.p, 0, sizeof (dtp->u.p)); + + dtp->u.p.ionml = ionml; + dtp->u.p.mode = read_flag ? READING : WRITING; + + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + return; + + if ((cf & IOPARM_DT_HAS_SIZE) != 0) + dtp->u.p.size_used = 0; /* Initialize the count. */ + + dtp->u.p.current_unit = get_unit (dtp, 1); + if (dtp->u.p.current_unit->s == NULL) + { /* Open the unit with some default flags. */ + st_parameter_open opp; + unit_convert conv; + + if (dtp->common.unit < 0) + { + close_unit (dtp->u.p.current_unit); + dtp->u.p.current_unit = NULL; + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "Bad unit number in statement"); + return; + } + memset (&u_flags, '\0', sizeof (u_flags)); + u_flags.access = ACCESS_SEQUENTIAL; + u_flags.action = ACTION_READWRITE; + + /* Is it unformatted? */ + if (!(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT + | IOPARM_DT_IONML_SET))) + u_flags.form = FORM_UNFORMATTED; + else + u_flags.form = FORM_UNSPECIFIED; + + u_flags.delim = DELIM_UNSPECIFIED; + u_flags.blank = BLANK_UNSPECIFIED; + u_flags.pad = PAD_UNSPECIFIED; + u_flags.decimal = DECIMAL_UNSPECIFIED; + u_flags.encoding = ENCODING_UNSPECIFIED; + u_flags.async = ASYNC_UNSPECIFIED; + u_flags.round = ROUND_UNSPECIFIED; + u_flags.sign = SIGN_UNSPECIFIED; + + u_flags.status = STATUS_UNKNOWN; + + conv = get_unformatted_convert (dtp->common.unit); + + if (conv == GFC_CONVERT_NONE) + conv = compile_options.convert; + + /* We use big_endian, which is 0 on little-endian machines + and 1 on big-endian machines. */ + switch (conv) + { + case GFC_CONVERT_NATIVE: + case GFC_CONVERT_SWAP: + break; + + case GFC_CONVERT_BIG: + conv = big_endian ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP; + break; + + case GFC_CONVERT_LITTLE: + conv = big_endian ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE; + break; + + default: + internal_error (&opp.common, "Illegal value for CONVERT"); + break; + } + + u_flags.convert = conv; + + opp.common = dtp->common; + opp.common.flags &= IOPARM_COMMON_MASK; + dtp->u.p.current_unit = new_unit (&opp, dtp->u.p.current_unit, &u_flags); + dtp->common.flags &= ~IOPARM_COMMON_MASK; + dtp->common.flags |= (opp.common.flags & IOPARM_COMMON_MASK); + if (dtp->u.p.current_unit == NULL) + return; + } + + /* Check the action. */ + + if (read_flag && dtp->u.p.current_unit->flags.action == ACTION_WRITE) + { + generate_error (&dtp->common, LIBERROR_BAD_ACTION, + "Cannot read from file opened for WRITE"); + return; + } + + if (!read_flag && dtp->u.p.current_unit->flags.action == ACTION_READ) + { + generate_error (&dtp->common, LIBERROR_BAD_ACTION, + "Cannot write to file opened for READ"); + return; + } + + dtp->u.p.first_item = 1; + + /* Check the format. */ + + if ((cf & IOPARM_DT_HAS_FORMAT) != 0) + parse_format (dtp); + + if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED + && (cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT)) + != 0) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Format present for UNFORMATTED data transfer"); + return; + } + + if ((cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0 && dtp->u.p.ionml != NULL) + { + if ((cf & IOPARM_DT_HAS_FORMAT) != 0) + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "A format cannot be specified with a namelist"); + } + else if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && + !(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT))) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Missing format for FORMATTED data transfer"); + } + + if (is_internal_unit (dtp) + && dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Internal file cannot be accessed by UNFORMATTED " + "data transfer"); + return; + } + + /* Check the record or position number. */ + + if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT + && (cf & IOPARM_DT_HAS_REC) == 0) + { + generate_error (&dtp->common, LIBERROR_MISSING_OPTION, + "Direct access data transfer requires record number"); + return; + } + + if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) + { + if ((cf & IOPARM_DT_HAS_REC) != 0) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Record number not allowed for sequential access " + "data transfer"); + return; + } + + if (dtp->u.p.current_unit->endfile == AFTER_ENDFILE) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Sequential READ or WRITE not allowed after " + "EOF marker, possibly use REWIND or BACKSPACE"); + return; + } + + } + /* Process the ADVANCE option. */ + + dtp->u.p.advance_status + = !(cf & IOPARM_DT_HAS_ADVANCE) ? ADVANCE_UNSPECIFIED : + find_option (&dtp->common, dtp->advance, dtp->advance_len, advance_opt, + "Bad ADVANCE parameter in data transfer statement"); + + if (dtp->u.p.advance_status != ADVANCE_UNSPECIFIED) + { + if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "ADVANCE specification conflicts with sequential " + "access"); + return; + } + + if (is_internal_unit (dtp)) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "ADVANCE specification conflicts with internal file"); + return; + } + + if ((cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT)) + != IOPARM_DT_HAS_FORMAT) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "ADVANCE specification requires an explicit format"); + return; + } + } + + if (read_flag) + { + dtp->u.p.current_unit->previous_nonadvancing_write = 0; + + if ((cf & IOPARM_EOR) != 0 && dtp->u.p.advance_status != ADVANCE_NO) + { + generate_error (&dtp->common, LIBERROR_MISSING_OPTION, + "EOR specification requires an ADVANCE specification " + "of NO"); + return; + } + + if ((cf & IOPARM_DT_HAS_SIZE) != 0 + && dtp->u.p.advance_status != ADVANCE_NO) + { + generate_error (&dtp->common, LIBERROR_MISSING_OPTION, + "SIZE specification requires an ADVANCE " + "specification of NO"); + return; + } + } + else + { /* Write constraints. */ + if ((cf & IOPARM_END) != 0) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "END specification cannot appear in a write " + "statement"); + return; + } + + if ((cf & IOPARM_EOR) != 0) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "EOR specification cannot appear in a write " + "statement"); + return; + } + + if ((cf & IOPARM_DT_HAS_SIZE) != 0) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "SIZE specification cannot appear in a write " + "statement"); + return; + } + } + + if (dtp->u.p.advance_status == ADVANCE_UNSPECIFIED) + dtp->u.p.advance_status = ADVANCE_YES; + + /* Check the decimal mode. */ + dtp->u.p.current_unit->decimal_status + = !(cf & IOPARM_DT_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED : + find_option (&dtp->common, dtp->decimal, dtp->decimal_len, + decimal_opt, "Bad DECIMAL parameter in data transfer " + "statement"); + + if (dtp->u.p.current_unit->decimal_status == DECIMAL_UNSPECIFIED) + dtp->u.p.current_unit->decimal_status = dtp->u.p.current_unit->flags.decimal; + + /* Check the round mode. */ + dtp->u.p.current_unit->round_status + = !(cf & IOPARM_DT_HAS_ROUND) ? ROUND_UNSPECIFIED : + find_option (&dtp->common, dtp->round, dtp->round_len, + round_opt, "Bad ROUND parameter in data transfer " + "statement"); + + if (dtp->u.p.current_unit->round_status == ROUND_UNSPECIFIED) + dtp->u.p.current_unit->round_status = dtp->u.p.current_unit->flags.round; + + /* Check the sign mode. */ + dtp->u.p.sign_status + = !(cf & IOPARM_DT_HAS_SIGN) ? SIGN_UNSPECIFIED : + find_option (&dtp->common, dtp->sign, dtp->sign_len, sign_opt, + "Bad SIGN parameter in data transfer statement"); + + if (dtp->u.p.sign_status == SIGN_UNSPECIFIED) + dtp->u.p.sign_status = dtp->u.p.current_unit->flags.sign; + + /* Check the blank mode. */ + dtp->u.p.blank_status + = !(cf & IOPARM_DT_HAS_BLANK) ? BLANK_UNSPECIFIED : + find_option (&dtp->common, dtp->blank, dtp->blank_len, + blank_opt, + "Bad BLANK parameter in data transfer statement"); + + if (dtp->u.p.blank_status == BLANK_UNSPECIFIED) + dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank; + + /* Check the delim mode. */ + dtp->u.p.current_unit->delim_status + = !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED : + find_option (&dtp->common, dtp->delim, dtp->delim_len, + delim_opt, "Bad DELIM parameter in data transfer statement"); + + if (dtp->u.p.current_unit->delim_status == DELIM_UNSPECIFIED) + dtp->u.p.current_unit->delim_status = dtp->u.p.current_unit->flags.delim; + + /* Check the pad mode. */ + dtp->u.p.current_unit->pad_status + = !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED : + find_option (&dtp->common, dtp->pad, dtp->pad_len, pad_opt, + "Bad PAD parameter in data transfer statement"); + + if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED) + dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad; + + /* Check to see if we might be reading what we wrote before */ + + if (dtp->u.p.mode != dtp->u.p.current_unit->mode + && !is_internal_unit (dtp)) + { + int pos = fbuf_reset (dtp->u.p.current_unit); + if (pos != 0) + sseek (dtp->u.p.current_unit->s, pos, SEEK_CUR); + sflush(dtp->u.p.current_unit->s); + } + + /* Check the POS= specifier: that it is in range and that it is used with a + unit that has been connected for STREAM access. F2003 9.5.1.10. */ + + if (((cf & IOPARM_DT_HAS_POS) != 0)) + { + if (is_stream_io (dtp)) + { + + if (dtp->pos <= 0) + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "POS=specifier must be positive"); + return; + } + + if (dtp->pos >= dtp->u.p.current_unit->maxrec) + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "POS=specifier too large"); + return; + } + + dtp->rec = dtp->pos; + + if (dtp->u.p.mode == READING) + { + /* Reset the endfile flag; if we hit EOF during reading + we'll set the flag and generate an error at that point + rather than worrying about it here. */ + dtp->u.p.current_unit->endfile = NO_ENDFILE; + } + + if (dtp->pos != dtp->u.p.current_unit->strm_pos) + { + fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode); + if (sseek (dtp->u.p.current_unit->s, dtp->pos - 1, SEEK_SET) < 0) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return; + } + dtp->u.p.current_unit->strm_pos = dtp->pos; + } + } + else + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "POS=specifier not allowed, " + "Try OPEN with ACCESS='stream'"); + return; + } + } + + + /* Sanity checks on the record number. */ + if ((cf & IOPARM_DT_HAS_REC) != 0) + { + if (dtp->rec <= 0) + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "Record number must be positive"); + return; + } + + if (dtp->rec >= dtp->u.p.current_unit->maxrec) + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "Record number too large"); + return; + } + + /* Make sure format buffer is reset. */ + if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED) + fbuf_reset (dtp->u.p.current_unit); + + + /* Check whether the record exists to be read. Only + a partial record needs to exist. */ + + if (dtp->u.p.mode == READING && (dtp->rec - 1) + * dtp->u.p.current_unit->recl >= file_length (dtp->u.p.current_unit->s)) + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "Non-existing record number"); + return; + } + + /* Position the file. */ + if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1) + * dtp->u.p.current_unit->recl, SEEK_SET) < 0) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return; + } + + /* TODO: This is required to maintain compatibility between + 4.3 and 4.4 runtime. Remove when ABI changes from 4.3 */ + + if (is_stream_io (dtp)) + dtp->u.p.current_unit->strm_pos = dtp->rec; + + /* TODO: Un-comment this code when ABI changes from 4.3. + if (dtp->u.p.current_unit->flags.access == ACCESS_STREAM) + { + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, + "Record number not allowed for stream access " + "data transfer"); + return; + } */ + } + + /* Bugware for badly written mixed C-Fortran I/O. */ + if (!is_internal_unit (dtp)) + flush_if_preconnected(dtp->u.p.current_unit->s); + + dtp->u.p.current_unit->mode = dtp->u.p.mode; + + /* Set the maximum position reached from the previous I/O operation. This + could be greater than zero from a previous non-advancing write. */ + dtp->u.p.max_pos = dtp->u.p.current_unit->saved_pos; + + pre_position (dtp); + + + /* Set up the subroutine that will handle the transfers. */ + + if (read_flag) + { + if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED) + dtp->u.p.transfer = unformatted_read; + else + { + if ((cf & IOPARM_DT_LIST_FORMAT) != 0) + { + dtp->u.p.last_char = EOF - 1; + dtp->u.p.transfer = list_formatted_read; + } + else + dtp->u.p.transfer = formatted_transfer; + } + } + else + { + if (dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED) + dtp->u.p.transfer = unformatted_write; + else + { + if ((cf & IOPARM_DT_LIST_FORMAT) != 0) + dtp->u.p.transfer = list_formatted_write; + else + dtp->u.p.transfer = formatted_transfer; + } + } + + /* Make sure that we don't do a read after a nonadvancing write. */ + + if (read_flag) + { + if (dtp->u.p.current_unit->read_bad && !is_stream_io (dtp)) + { + generate_error (&dtp->common, LIBERROR_BAD_OPTION, + "Cannot READ after a nonadvancing WRITE"); + return; + } + } + else + { + if (dtp->u.p.advance_status == ADVANCE_YES && !dtp->u.p.seen_dollar) + dtp->u.p.current_unit->read_bad = 1; + } + + /* Start the data transfer if we are doing a formatted transfer. */ + if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED + && ((cf & (IOPARM_DT_LIST_FORMAT | IOPARM_DT_HAS_NAMELIST_NAME)) == 0) + && dtp->u.p.ionml == NULL) + formatted_transfer (dtp, 0, NULL, 0, 0, 1); +} + +/* Initialize an array_loop_spec given the array descriptor. The function + returns the index of the last element of the array, and also returns + starting record, where the first I/O goes to (necessary in case of + negative strides). */ + +gfc_offset +init_loop_spec (gfc_array_char *desc, array_loop_spec *ls, + gfc_offset *start_record) +{ + int rank = GFC_DESCRIPTOR_RANK(desc); + int i; + gfc_offset index; + int empty; + + empty = 0; + index = 1; + *start_record = 0; + + for (i=0; i 0) + { + index += (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) + * GFC_DESCRIPTOR_STRIDE(desc,i); + } + else + { + index -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) + * GFC_DESCRIPTOR_STRIDE(desc,i); + *start_record -= (GFC_DESCRIPTOR_EXTENT(desc,i) - 1) + * GFC_DESCRIPTOR_STRIDE(desc,i); + } + } + + if (empty) + return 0; + else + return index; +} + +/* Determine the index to the next record in an internal unit array by + by incrementing through the array_loop_spec. */ + +gfc_offset +next_array_record (st_parameter_dt *dtp, array_loop_spec *ls, int *finished) +{ + int i, carry; + gfc_offset index; + + carry = 1; + index = 0; + + for (i = 0; i < dtp->u.p.current_unit->rank; i++) + { + if (carry) + { + ls[i].idx++; + if (ls[i].idx > ls[i].end) + { + ls[i].idx = ls[i].start; + carry = 1; + } + else + carry = 0; + } + index = index + (ls[i].idx - ls[i].start) * ls[i].step; + } + + *finished = carry; + + return index; +} + + + +/* Skip to the end of the current record, taking care of an optional + record marker of size bytes. If the file is not seekable, we + read chunks of size MAX_READ until we get to the right + position. */ + +static void +skip_record (st_parameter_dt *dtp, ssize_t bytes) +{ + ssize_t rlength, readb; + static const ssize_t MAX_READ = 4096; + char p[MAX_READ]; + + dtp->u.p.current_unit->bytes_left_subrecord += bytes; + if (dtp->u.p.current_unit->bytes_left_subrecord == 0) + return; + + if (is_seekable (dtp->u.p.current_unit->s)) + { + /* Direct access files do not generate END conditions, + only I/O errors. */ + if (sseek (dtp->u.p.current_unit->s, + dtp->u.p.current_unit->bytes_left_subrecord, SEEK_CUR) < 0) + generate_error (&dtp->common, LIBERROR_OS, NULL); + + dtp->u.p.current_unit->bytes_left_subrecord = 0; + } + else + { /* Seek by reading data. */ + while (dtp->u.p.current_unit->bytes_left_subrecord > 0) + { + rlength = + (MAX_READ < dtp->u.p.current_unit->bytes_left_subrecord) ? + MAX_READ : dtp->u.p.current_unit->bytes_left_subrecord; + + readb = sread (dtp->u.p.current_unit->s, p, rlength); + if (readb < 0) + { + generate_error (&dtp->common, LIBERROR_OS, NULL); + return; + } + + dtp->u.p.current_unit->bytes_left_subrecord -= readb; + } + } + +} + + +/* Advance to the next record reading unformatted files, taking + care of subrecords. If complete_record is nonzero, we loop + until all subrecords are cleared. */ + +static void +next_record_r_unf (st_parameter_dt *dtp, int complete_record) +{ + size_t bytes; + + bytes = compile_options.record_marker == 0 ? + sizeof (GFC_INTEGER_4) : compile_options.record_marker; + + while(1) + { + + /* Skip over tail */ + + skip_record (dtp, bytes); + + if ( ! (complete_record && dtp->u.p.current_unit->continued)) + return; + + us_read (dtp, 1); + } +} + + +static inline gfc_offset +min_off (gfc_offset a, gfc_offset b) +{ + return (a < b ? a : b); +} + + +/* Space to the next record for read mode. */ + +static void +next_record_r (st_parameter_dt *dtp, int done) +{ + gfc_offset record; + int bytes_left; + char p; + int cc; + + switch (current_mode (dtp)) + { + /* No records in unformatted STREAM I/O. */ + case UNFORMATTED_STREAM: + return; + + case UNFORMATTED_SEQUENTIAL: + next_record_r_unf (dtp, 1); + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + break; + + case FORMATTED_DIRECT: + case UNFORMATTED_DIRECT: + skip_record (dtp, dtp->u.p.current_unit->bytes_left); + break; + + case FORMATTED_STREAM: + case FORMATTED_SEQUENTIAL: + /* read_sf has already terminated input because of an '\n', or + we have hit EOF. */ + if (dtp->u.p.sf_seen_eor) + { + dtp->u.p.sf_seen_eor = 0; + break; + } + + if (is_internal_unit (dtp)) + { + if (is_array_io (dtp)) + { + int finished; + + record = next_array_record (dtp, dtp->u.p.current_unit->ls, + &finished); + if (!done && finished) + hit_eof (dtp); + + /* Now seek to this record. */ + record = record * dtp->u.p.current_unit->recl; + if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0) + { + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); + break; + } + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + } + else + { + bytes_left = (int) dtp->u.p.current_unit->bytes_left; + bytes_left = min_off (bytes_left, + file_length (dtp->u.p.current_unit->s) + - stell (dtp->u.p.current_unit->s)); + if (sseek (dtp->u.p.current_unit->s, + bytes_left, SEEK_CUR) < 0) + { + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); + break; + } + dtp->u.p.current_unit->bytes_left + = dtp->u.p.current_unit->recl; + } + break; + } + else + { + do + { + errno = 0; + cc = fbuf_getc (dtp->u.p.current_unit); + if (cc == EOF) + { + if (errno != 0) + generate_error (&dtp->common, LIBERROR_OS, NULL); + else + { + if (is_stream_io (dtp) + || dtp->u.p.current_unit->pad_status == PAD_NO + || dtp->u.p.current_unit->bytes_left + == dtp->u.p.current_unit->recl) + hit_eof (dtp); + } + break; + } + + if (is_stream_io (dtp)) + dtp->u.p.current_unit->strm_pos++; + + p = (char) cc; + } + while (p != '\n'); + } + break; + } +} + + +/* Small utility function to write a record marker, taking care of + byte swapping and of choosing the correct size. */ + +static int +write_us_marker (st_parameter_dt *dtp, const gfc_offset buf) +{ + size_t len; + GFC_INTEGER_4 buf4; + GFC_INTEGER_8 buf8; + char p[sizeof (GFC_INTEGER_8)]; + + if (compile_options.record_marker == 0) + len = sizeof (GFC_INTEGER_4); + else + len = compile_options.record_marker; + + /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ + if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE)) + { + switch (len) + { + case sizeof (GFC_INTEGER_4): + buf4 = buf; + return swrite (dtp->u.p.current_unit->s, &buf4, len); + break; + + case sizeof (GFC_INTEGER_8): + buf8 = buf; + return swrite (dtp->u.p.current_unit->s, &buf8, len); + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + } + else + { + switch (len) + { + case sizeof (GFC_INTEGER_4): + buf4 = buf; + reverse_memcpy (p, &buf4, sizeof (GFC_INTEGER_4)); + return swrite (dtp->u.p.current_unit->s, p, len); + break; + + case sizeof (GFC_INTEGER_8): + buf8 = buf; + reverse_memcpy (p, &buf8, sizeof (GFC_INTEGER_8)); + return swrite (dtp->u.p.current_unit->s, p, len); + break; + + default: + runtime_error ("Illegal value for record marker"); + break; + } + } + +} + +/* Position to the next (sub)record in write mode for + unformatted sequential files. */ + +static void +next_record_w_unf (st_parameter_dt *dtp, int next_subrecord) +{ + gfc_offset m, m_write, record_marker; + + /* Bytes written. */ + m = dtp->u.p.current_unit->recl_subrecord + - dtp->u.p.current_unit->bytes_left_subrecord; + + /* Write the length tail. If we finish a record containing + subrecords, we write out the negative length. */ + + if (dtp->u.p.current_unit->continued) + m_write = -m; + else + m_write = m; + + if (unlikely (write_us_marker (dtp, m_write) < 0)) + goto io_error; + + if (compile_options.record_marker == 0) + record_marker = sizeof (GFC_INTEGER_4); + else + record_marker = compile_options.record_marker; + + /* Seek to the head and overwrite the bogus length with the real + length. */ + + if (unlikely (sseek (dtp->u.p.current_unit->s, - m - 2 * record_marker, + SEEK_CUR) < 0)) + goto io_error; + + if (next_subrecord) + m_write = -m; + else + m_write = m; + + if (unlikely (write_us_marker (dtp, m_write) < 0)) + goto io_error; + + /* Seek past the end of the current record. */ + + if (unlikely (sseek (dtp->u.p.current_unit->s, m + record_marker, + SEEK_CUR) < 0)) + goto io_error; + + return; + + io_error: + generate_error (&dtp->common, LIBERROR_OS, NULL); + return; + +} + + +/* Utility function like memset() but operating on streams. Return + value is same as for POSIX write(). */ + +static ssize_t +sset (stream * s, int c, ssize_t nbyte) +{ + static const int WRITE_CHUNK = 256; + char p[WRITE_CHUNK]; + ssize_t bytes_left, trans; + + if (nbyte < WRITE_CHUNK) + memset (p, c, nbyte); + else + memset (p, c, WRITE_CHUNK); + + bytes_left = nbyte; + while (bytes_left > 0) + { + trans = (bytes_left < WRITE_CHUNK) ? bytes_left : WRITE_CHUNK; + trans = swrite (s, p, trans); + if (trans <= 0) + return trans; + bytes_left -= trans; + } + + return nbyte - bytes_left; +} + +static inline void +memset4 (gfc_char4_t *p, gfc_char4_t c, int k) +{ + int j; + for (j = 0; j < k; j++) + *p++ = c; +} + +/* Position to the next record in write mode. */ + +static void +next_record_w (st_parameter_dt *dtp, int done) +{ + gfc_offset m, record, max_pos; + int length; + + /* Zero counters for X- and T-editing. */ + max_pos = dtp->u.p.max_pos; + dtp->u.p.max_pos = dtp->u.p.skips = dtp->u.p.pending_spaces = 0; + + switch (current_mode (dtp)) + { + /* No records in unformatted STREAM I/O. */ + case UNFORMATTED_STREAM: + return; + + case FORMATTED_DIRECT: + if (dtp->u.p.current_unit->bytes_left == 0) + break; + + fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END); + fbuf_flush (dtp->u.p.current_unit, WRITING); + if (sset (dtp->u.p.current_unit->s, ' ', + dtp->u.p.current_unit->bytes_left) + != dtp->u.p.current_unit->bytes_left) + goto io_error; + + break; + + case UNFORMATTED_DIRECT: + if (dtp->u.p.current_unit->bytes_left > 0) + { + length = (int) dtp->u.p.current_unit->bytes_left; + if (sset (dtp->u.p.current_unit->s, 0, length) != length) + goto io_error; + } + break; + + case UNFORMATTED_SEQUENTIAL: + next_record_w_unf (dtp, 0); + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + break; + + case FORMATTED_STREAM: + case FORMATTED_SEQUENTIAL: + + if (is_internal_unit (dtp)) + { + char *p; + if (is_array_io (dtp)) + { + int finished; + + length = (int) dtp->u.p.current_unit->bytes_left; + + /* If the farthest position reached is greater than current + position, adjust the position and set length to pad out + whats left. Otherwise just pad whats left. + (for character array unit) */ + m = dtp->u.p.current_unit->recl + - dtp->u.p.current_unit->bytes_left; + if (max_pos > m) + { + length = (int) (max_pos - m); + if (sseek (dtp->u.p.current_unit->s, + length, SEEK_CUR) < 0) + { + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); + return; + } + length = (int) (dtp->u.p.current_unit->recl - max_pos); + } + + p = write_block (dtp, length); + if (p == NULL) + return; + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, ' ', length); + } + else + memset (p, ' ', length); + + /* Now that the current record has been padded out, + determine where the next record in the array is. */ + record = next_array_record (dtp, dtp->u.p.current_unit->ls, + &finished); + if (finished) + dtp->u.p.current_unit->endfile = AT_ENDFILE; + + /* Now seek to this record */ + record = record * dtp->u.p.current_unit->recl; + + if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0) + { + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); + return; + } + + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + } + else + { + length = 1; + + /* If this is the last call to next_record move to the farthest + position reached and set length to pad out the remainder + of the record. (for character scaler unit) */ + if (done) + { + m = dtp->u.p.current_unit->recl + - dtp->u.p.current_unit->bytes_left; + if (max_pos > m) + { + length = (int) (max_pos - m); + if (sseek (dtp->u.p.current_unit->s, + length, SEEK_CUR) < 0) + { + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); + return; + } + length = (int) (dtp->u.p.current_unit->recl - max_pos); + } + else + length = (int) dtp->u.p.current_unit->bytes_left; + } + if (length > 0) + { + p = write_block (dtp, length); + if (p == NULL) + return; + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, (gfc_char4_t) ' ', length); + } + else + memset (p, ' ', length); + } + } + } + else + { +#ifdef HAVE_CRLF + const int len = 2; +#else + const int len = 1; +#endif + fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END); + char * p = fbuf_alloc (dtp->u.p.current_unit, len); + if (!p) + goto io_error; +#ifdef HAVE_CRLF + *(p++) = '\r'; +#endif + *p = '\n'; + if (is_stream_io (dtp)) + { + dtp->u.p.current_unit->strm_pos += len; + if (dtp->u.p.current_unit->strm_pos + < file_length (dtp->u.p.current_unit->s)) + unit_truncate (dtp->u.p.current_unit, + dtp->u.p.current_unit->strm_pos - 1, + &dtp->common); + } + } + + break; + + io_error: + generate_error (&dtp->common, LIBERROR_OS, NULL); + break; + } +} + +/* Position to the next record, which means moving to the end of the + current record. This can happen under several different + conditions. If the done flag is not set, we get ready to process + the next record. */ + +void +next_record (st_parameter_dt *dtp, int done) +{ + gfc_offset fp; /* File position. */ + + dtp->u.p.current_unit->read_bad = 0; + + if (dtp->u.p.mode == READING) + next_record_r (dtp, done); + else + next_record_w (dtp, done); + + if (!is_stream_io (dtp)) + { + /* Keep position up to date for INQUIRE */ + if (done) + update_position (dtp->u.p.current_unit); + + dtp->u.p.current_unit->current_record = 0; + if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) + { + fp = stell (dtp->u.p.current_unit->s); + /* Calculate next record, rounding up partial records. */ + dtp->u.p.current_unit->last_record = + (fp + dtp->u.p.current_unit->recl - 1) / + dtp->u.p.current_unit->recl; + } + else + dtp->u.p.current_unit->last_record++; + } + + if (!done) + pre_position (dtp); + + fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode); +} + + +/* Finalize the current data transfer. For a nonadvancing transfer, + this means advancing to the next record. For internal units close the + stream associated with the unit. */ + +static void +finalize_transfer (st_parameter_dt *dtp) +{ + GFC_INTEGER_4 cf = dtp->common.flags; + + if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) + *dtp->size = dtp->u.p.size_used; + + if (dtp->u.p.eor_condition) + { + generate_error (&dtp->common, LIBERROR_EOR, NULL); + return; + } + + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + { + if (dtp->u.p.current_unit && current_mode (dtp) == UNFORMATTED_SEQUENTIAL) + dtp->u.p.current_unit->current_record = 0; + return; + } + + if ((dtp->u.p.ionml != NULL) + && (cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0) + { + if ((cf & IOPARM_DT_NAMELIST_READ_MODE) != 0) + namelist_read (dtp); + else + namelist_write (dtp); + } + + dtp->u.p.transfer = NULL; + if (dtp->u.p.current_unit == NULL) + return; + + if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING) + { + finish_list_read (dtp); + return; + } + + if (dtp->u.p.mode == WRITING) + dtp->u.p.current_unit->previous_nonadvancing_write + = dtp->u.p.advance_status == ADVANCE_NO; + + if (is_stream_io (dtp)) + { + if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED + && dtp->u.p.advance_status != ADVANCE_NO) + next_record (dtp, 1); + + return; + } + + dtp->u.p.current_unit->current_record = 0; + + if (!is_internal_unit (dtp) && dtp->u.p.seen_dollar) + { + fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode); + dtp->u.p.seen_dollar = 0; + return; + } + + /* For non-advancing I/O, save the current maximum position for use in the + next I/O operation if needed. */ + if (dtp->u.p.advance_status == ADVANCE_NO) + { + int bytes_written = (int) (dtp->u.p.current_unit->recl + - dtp->u.p.current_unit->bytes_left); + dtp->u.p.current_unit->saved_pos = + dtp->u.p.max_pos > 0 ? dtp->u.p.max_pos - bytes_written : 0; + fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode); + return; + } + else if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED + && dtp->u.p.mode == WRITING && !is_internal_unit (dtp)) + fbuf_seek (dtp->u.p.current_unit, 0, SEEK_END); + + dtp->u.p.current_unit->saved_pos = 0; + + next_record (dtp, 1); +} + +/* Transfer function for IOLENGTH. It doesn't actually do any + data transfer, it just updates the length counter. */ + +static void +iolength_transfer (st_parameter_dt *dtp, bt type __attribute__((unused)), + void *dest __attribute__ ((unused)), + int kind __attribute__((unused)), + size_t size, size_t nelems) +{ + if ((dtp->common.flags & IOPARM_DT_HAS_IOLENGTH) != 0) + *dtp->iolength += (GFC_IO_INT) (size * nelems); +} + + +/* Initialize the IOLENGTH data transfer. This function is in essence + a very much simplified version of data_transfer_init(), because it + doesn't have to deal with units at all. */ + +static void +iolength_transfer_init (st_parameter_dt *dtp) +{ + if ((dtp->common.flags & IOPARM_DT_HAS_IOLENGTH) != 0) + *dtp->iolength = 0; + + memset (&dtp->u.p, 0, sizeof (dtp->u.p)); + + /* Set up the subroutine that will handle the transfers. */ + + dtp->u.p.transfer = iolength_transfer; +} + + +/* Library entry point for the IOLENGTH form of the INQUIRE + statement. The IOLENGTH form requires no I/O to be performed, but + it must still be a runtime library call so that we can determine + the iolength for dynamic arrays and such. */ + +extern void st_iolength (st_parameter_dt *); +export_proto(st_iolength); + +void +st_iolength (st_parameter_dt *dtp) +{ + library_start (&dtp->common); + iolength_transfer_init (dtp); +} + +extern void st_iolength_done (st_parameter_dt *); +export_proto(st_iolength_done); + +void +st_iolength_done (st_parameter_dt *dtp __attribute__((unused))) +{ + free_ionml (dtp); + library_end (); +} + + +/* The READ statement. */ + +extern void st_read (st_parameter_dt *); +export_proto(st_read); + +void +st_read (st_parameter_dt *dtp) +{ + library_start (&dtp->common); + + data_transfer_init (dtp, 1); +} + +extern void st_read_done (st_parameter_dt *); +export_proto(st_read_done); + +void +st_read_done (st_parameter_dt *dtp) +{ + finalize_transfer (dtp); + if (is_internal_unit (dtp) || dtp->u.p.format_not_saved) + free_format_data (dtp->u.p.fmt); + free_ionml (dtp); + if (dtp->u.p.current_unit != NULL) + unlock_unit (dtp->u.p.current_unit); + + free_internal_unit (dtp); + + library_end (); +} + +extern void st_write (st_parameter_dt *); +export_proto(st_write); + +void +st_write (st_parameter_dt *dtp) +{ + library_start (&dtp->common); + data_transfer_init (dtp, 0); +} + +extern void st_write_done (st_parameter_dt *); +export_proto(st_write_done); + +void +st_write_done (st_parameter_dt *dtp) +{ + finalize_transfer (dtp); + + /* Deal with endfile conditions associated with sequential files. */ + + if (dtp->u.p.current_unit != NULL + && dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) + switch (dtp->u.p.current_unit->endfile) + { + case AT_ENDFILE: /* Remain at the endfile record. */ + break; + + case AFTER_ENDFILE: + dtp->u.p.current_unit->endfile = AT_ENDFILE; /* Just at it now. */ + break; + + case NO_ENDFILE: + /* Get rid of whatever is after this record. */ + if (!is_internal_unit (dtp)) + unit_truncate (dtp->u.p.current_unit, + stell (dtp->u.p.current_unit->s), + &dtp->common); + dtp->u.p.current_unit->endfile = AT_ENDFILE; + break; + } + + if (is_internal_unit (dtp) || dtp->u.p.format_not_saved) + free_format_data (dtp->u.p.fmt); + free_ionml (dtp); + if (dtp->u.p.current_unit != NULL) + unlock_unit (dtp->u.p.current_unit); + + free_internal_unit (dtp); + + library_end (); +} + + +/* F2003: This is a stub for the runtime portion of the WAIT statement. */ +void +st_wait (st_parameter_wait *wtp __attribute__((unused))) +{ +} + + +/* Receives the scalar information for namelist objects and stores it + in a linked list of namelist_info types. */ + +extern void st_set_nml_var (st_parameter_dt *dtp, void *, char *, + GFC_INTEGER_4, gfc_charlen_type, GFC_INTEGER_4); +export_proto(st_set_nml_var); + + +void +st_set_nml_var (st_parameter_dt *dtp, void * var_addr, char * var_name, + GFC_INTEGER_4 len, gfc_charlen_type string_length, + GFC_INTEGER_4 dtype) +{ + namelist_info *t1 = NULL; + namelist_info *nml; + size_t var_name_len = strlen (var_name); + + nml = (namelist_info*) get_mem (sizeof (namelist_info)); + + nml->mem_pos = var_addr; + + nml->var_name = (char*) get_mem (var_name_len + 1); + memcpy (nml->var_name, var_name, var_name_len); + nml->var_name[var_name_len] = '\0'; + + nml->len = (int) len; + nml->string_length = (index_type) string_length; + + nml->var_rank = (int) (dtype & GFC_DTYPE_RANK_MASK); + nml->size = (index_type) (dtype >> GFC_DTYPE_SIZE_SHIFT); + nml->type = (bt) ((dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT); + + if (nml->var_rank > 0) + { + nml->dim = (descriptor_dimension*) + get_mem (nml->var_rank * sizeof (descriptor_dimension)); + nml->ls = (array_loop_spec*) + get_mem (nml->var_rank * sizeof (array_loop_spec)); + } + else + { + nml->dim = NULL; + nml->ls = NULL; + } + + nml->next = NULL; + + if ((dtp->common.flags & IOPARM_DT_IONML_SET) == 0) + { + dtp->common.flags |= IOPARM_DT_IONML_SET; + dtp->u.p.ionml = nml; + } + else + { + for (t1 = dtp->u.p.ionml; t1->next; t1 = t1->next); + t1->next = nml; + } +} + +/* Store the dimensional information for the namelist object. */ +extern void st_set_nml_var_dim (st_parameter_dt *, GFC_INTEGER_4, + index_type, index_type, + index_type); +export_proto(st_set_nml_var_dim); + +void +st_set_nml_var_dim (st_parameter_dt *dtp, GFC_INTEGER_4 n_dim, + index_type stride, index_type lbound, + index_type ubound) +{ + namelist_info * nml; + int n; + + n = (int)n_dim; + + for (nml = dtp->u.p.ionml; nml->next; nml = nml->next); + + GFC_DIMENSION_SET(nml->dim[n],lbound,ubound,stride); +} + +/* Reverse memcpy - used for byte swapping. */ + +void reverse_memcpy (void *dest, const void *src, size_t n) +{ + char *d, *s; + size_t i; + + d = (char *) dest; + s = (char *) src + n - 1; + + /* Write with ascending order - this is likely faster + on modern architectures because of write combining. */ + for (i=0; iu.p.current_unit->flags.position = POSITION_APPEND; + + if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL) + switch (dtp->u.p.current_unit->endfile) + { + case NO_ENDFILE: + case AT_ENDFILE: + generate_error (&dtp->common, LIBERROR_END, NULL); + if (!is_internal_unit (dtp)) + { + dtp->u.p.current_unit->endfile = AFTER_ENDFILE; + dtp->u.p.current_unit->current_record = 0; + } + else + dtp->u.p.current_unit->endfile = AT_ENDFILE; + break; + + case AFTER_ENDFILE: + generate_error (&dtp->common, LIBERROR_ENDFILE, NULL); + dtp->u.p.current_unit->current_record = 0; + break; + } + else + { + /* Non-sequential files don't have an ENDFILE record, so we + can't be at AFTER_ENDFILE. */ + dtp->u.p.current_unit->endfile = AT_ENDFILE; + generate_error (&dtp->common, LIBERROR_END, NULL); + dtp->u.p.current_unit->current_record = 0; + } +} diff --git a/libgfortran/io/transfer128.c b/libgfortran/io/transfer128.c new file mode 100644 index 000000000..d94ccacc0 --- /dev/null +++ b/libgfortran/io/transfer128.c @@ -0,0 +1,98 @@ +/* Copyright (C) 2010, 2011 + Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +/* Note: This file needs to be a separate translation unit (.o file) + to make sure that for static linkage, the libquad dependence only + occurs if needed. */ + +#include "io.h" + + +#if defined(GFC_REAL_16_IS_FLOAT128) + +/* The prototypes for the called procedures in transfer.c. */ + +extern void transfer_real (st_parameter_dt *, void *, int); +export_proto(transfer_real); + +extern void transfer_real_write (st_parameter_dt *, void *, int); +export_proto(transfer_real_write); + +extern void transfer_complex (st_parameter_dt *, void *, int); +export_proto(transfer_complex); + +extern void transfer_complex_write (st_parameter_dt *, void *, int); +export_proto(transfer_complex_write); + + +/* The prototypes for the procedures in this file. */ + +extern void transfer_real128 (st_parameter_dt *, void *, int); +export_proto(transfer_real128); + +extern void transfer_real128_write (st_parameter_dt *, void *, int); +export_proto(transfer_real128_write); + +extern void transfer_complex128 (st_parameter_dt *, void *, int); +export_proto(transfer_complex128); + +extern void transfer_complex128_write (st_parameter_dt *, void *, int); +export_proto(transfer_complex128_write); + + +/* Make sure that libquadmath is pulled in. The functions strtoflt128 + and quadmath_snprintf are weakly referrenced in convert_real and + write_float; the pointer assignment with USED attribute make sure + that there is a non-weakref dependence if the quadmath functions + are used. That avoids segfault when libquadmath is statically linked. */ +static void __attribute__((used)) *tmp1 = strtoflt128; +static void __attribute__((used)) *tmp2 = quadmath_snprintf; + +void +transfer_real128 (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_real (dtp, p, kind); +} + + +void +transfer_real128_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_real (dtp, p, kind); +} + + +void +transfer_complex128 (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_complex (dtp, p, kind); +} + + +void +transfer_complex128_write (st_parameter_dt *dtp, void *p, int kind) +{ + transfer_complex_write (dtp, p, kind); +} +#endif diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c new file mode 100644 index 000000000..1d5221726 --- /dev/null +++ b/libgfortran/io/unit.c @@ -0,0 +1,860 @@ +/* Copyright (C) 2002, 2003, 2005, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. + Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "io.h" +#include "fbuf.h" +#include "format.h" +#include "unix.h" +#include +#include + + +/* IO locking rules: + UNIT_LOCK is a master lock, protecting UNIT_ROOT tree and UNIT_CACHE. + Concurrent use of different units should be supported, so + each unit has its own lock, LOCK. + Open should be atomic with its reopening of units and list_read.c + in several places needs find_unit another unit while holding stdin + unit's lock, so it must be possible to acquire UNIT_LOCK while holding + some unit's lock. Therefore to avoid deadlocks, it is forbidden + to acquire unit's private locks while holding UNIT_LOCK, except + for freshly created units (where no other thread can get at their + address yet) or when using just trylock rather than lock operation. + In addition to unit's private lock each unit has a WAITERS counter + and CLOSED flag. WAITERS counter must be either only + atomically incremented/decremented in all places (if atomic builtins + are supported), or protected by UNIT_LOCK in all places (otherwise). + CLOSED flag must be always protected by unit's LOCK. + After finding a unit in UNIT_CACHE or UNIT_ROOT with UNIT_LOCK held, + WAITERS must be incremented to avoid concurrent close from freeing + the unit between unlocking UNIT_LOCK and acquiring unit's LOCK. + Unit freeing is always done under UNIT_LOCK. If close_unit sees any + WAITERS, it doesn't free the unit but instead sets the CLOSED flag + and the thread that decrements WAITERS to zero while CLOSED flag is + set is responsible for freeing it (while holding UNIT_LOCK). + flush_all_units operation is iterating over the unit tree with + increasing UNIT_NUMBER while holding UNIT_LOCK and attempting to + flush each unit (and therefore needs the unit's LOCK held as well). + To avoid deadlocks, it just trylocks the LOCK and if unsuccessful, + remembers the current unit's UNIT_NUMBER, unlocks UNIT_LOCK, acquires + unit's LOCK and after flushing reacquires UNIT_LOCK and restarts with + the smallest UNIT_NUMBER above the last one flushed. + + If find_unit/find_or_create_unit/find_file/get_unit routines return + non-NULL, the returned unit has its private lock locked and when the + caller is done with it, it must call either unlock_unit or close_unit + on it. unlock_unit or close_unit must be always called only with the + private lock held. */ + +/* Subroutines related to units */ + +GFC_INTEGER_4 next_available_newunit; +#define GFC_FIRST_NEWUNIT -10 + +#define CACHE_SIZE 3 +static gfc_unit *unit_cache[CACHE_SIZE]; +gfc_offset max_offset; +gfc_unit *unit_root; +#ifdef __GTHREAD_MUTEX_INIT +__gthread_mutex_t unit_lock = __GTHREAD_MUTEX_INIT; +#else +__gthread_mutex_t unit_lock; +#endif + +/* We use these filenames for error reporting. */ + +static char stdin_name[] = "stdin"; +static char stdout_name[] = "stdout"; +static char stderr_name[] = "stderr"; + +/* This implementation is based on Stefan Nilsson's article in the + * July 1997 Doctor Dobb's Journal, "Treaps in Java". */ + +/* pseudo_random()-- Simple linear congruential pseudorandom number + * generator. The period of this generator is 44071, which is plenty + * for our purposes. */ + +static int +pseudo_random (void) +{ + static int x0 = 5341; + + x0 = (22611 * x0 + 10) % 44071; + return x0; +} + + +/* rotate_left()-- Rotate the treap left */ + +static gfc_unit * +rotate_left (gfc_unit * t) +{ + gfc_unit *temp; + + temp = t->right; + t->right = t->right->left; + temp->left = t; + + return temp; +} + + +/* rotate_right()-- Rotate the treap right */ + +static gfc_unit * +rotate_right (gfc_unit * t) +{ + gfc_unit *temp; + + temp = t->left; + t->left = t->left->right; + temp->right = t; + + return temp; +} + + +static int +compare (int a, int b) +{ + if (a < b) + return -1; + if (a > b) + return 1; + + return 0; +} + + +/* insert()-- Recursive insertion function. Returns the updated treap. */ + +static gfc_unit * +insert (gfc_unit *new, gfc_unit *t) +{ + int c; + + if (t == NULL) + return new; + + c = compare (new->unit_number, t->unit_number); + + if (c < 0) + { + t->left = insert (new, t->left); + if (t->priority < t->left->priority) + t = rotate_right (t); + } + + if (c > 0) + { + t->right = insert (new, t->right); + if (t->priority < t->right->priority) + t = rotate_left (t); + } + + if (c == 0) + internal_error (NULL, "insert(): Duplicate key found!"); + + return t; +} + + +/* insert_unit()-- Create a new node, insert it into the treap. */ + +static gfc_unit * +insert_unit (int n) +{ + gfc_unit *u = get_mem (sizeof (gfc_unit)); + memset (u, '\0', sizeof (gfc_unit)); + u->unit_number = n; +#ifdef __GTHREAD_MUTEX_INIT + { + __gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT; + u->lock = tmp; + } +#else + __GTHREAD_MUTEX_INIT_FUNCTION (&u->lock); +#endif + __gthread_mutex_lock (&u->lock); + u->priority = pseudo_random (); + unit_root = insert (u, unit_root); + return u; +} + + +/* destroy_unit_mutex()-- Destroy the mutex and free memory of unit. */ + +static void +destroy_unit_mutex (gfc_unit * u) +{ + __gthread_mutex_destroy (&u->lock); + free (u); +} + + +static gfc_unit * +delete_root (gfc_unit * t) +{ + gfc_unit *temp; + + if (t->left == NULL) + return t->right; + if (t->right == NULL) + return t->left; + + if (t->left->priority > t->right->priority) + { + temp = rotate_right (t); + temp->right = delete_root (t); + } + else + { + temp = rotate_left (t); + temp->left = delete_root (t); + } + + return temp; +} + + +/* delete_treap()-- Delete an element from a tree. The 'old' value + * does not necessarily have to point to the element to be deleted, it + * must just point to a treap structure with the key to be deleted. + * Returns the new root node of the tree. */ + +static gfc_unit * +delete_treap (gfc_unit * old, gfc_unit * t) +{ + int c; + + if (t == NULL) + return NULL; + + c = compare (old->unit_number, t->unit_number); + + if (c < 0) + t->left = delete_treap (old, t->left); + if (c > 0) + t->right = delete_treap (old, t->right); + if (c == 0) + t = delete_root (t); + + return t; +} + + +/* delete_unit()-- Delete a unit from a tree */ + +static void +delete_unit (gfc_unit * old) +{ + unit_root = delete_treap (old, unit_root); +} + + +/* get_external_unit()-- Given an integer, return a pointer to the unit + * structure. Returns NULL if the unit does not exist, + * otherwise returns a locked unit. */ + +static gfc_unit * +get_external_unit (int n, int do_create) +{ + gfc_unit *p; + int c, created = 0; + + __gthread_mutex_lock (&unit_lock); +retry: + for (c = 0; c < CACHE_SIZE; c++) + if (unit_cache[c] != NULL && unit_cache[c]->unit_number == n) + { + p = unit_cache[c]; + goto found; + } + + p = unit_root; + while (p != NULL) + { + c = compare (n, p->unit_number); + if (c < 0) + p = p->left; + if (c > 0) + p = p->right; + if (c == 0) + break; + } + + if (p == NULL && do_create) + { + p = insert_unit (n); + created = 1; + } + + if (p != NULL) + { + for (c = 0; c < CACHE_SIZE - 1; c++) + unit_cache[c] = unit_cache[c + 1]; + + unit_cache[CACHE_SIZE - 1] = p; + } + + if (created) + { + /* Newly created units have their lock held already + from insert_unit. Just unlock UNIT_LOCK and return. */ + __gthread_mutex_unlock (&unit_lock); + return p; + } + +found: + if (p != NULL) + { + /* Fast path. */ + if (! __gthread_mutex_trylock (&p->lock)) + { + /* assert (p->closed == 0); */ + __gthread_mutex_unlock (&unit_lock); + return p; + } + + inc_waiting_locked (p); + } + + __gthread_mutex_unlock (&unit_lock); + + if (p != NULL) + { + __gthread_mutex_lock (&p->lock); + if (p->closed) + { + __gthread_mutex_lock (&unit_lock); + __gthread_mutex_unlock (&p->lock); + if (predec_waiting_locked (p) == 0) + destroy_unit_mutex (p); + goto retry; + } + + dec_waiting_unlocked (p); + } + return p; +} + + +gfc_unit * +find_unit (int n) +{ + return get_external_unit (n, 0); +} + + +gfc_unit * +find_or_create_unit (int n) +{ + return get_external_unit (n, 1); +} + + +gfc_unit * +get_internal_unit (st_parameter_dt *dtp) +{ + gfc_unit * iunit; + gfc_offset start_record = 0; + + /* Allocate memory for a unit structure. */ + + iunit = get_mem (sizeof (gfc_unit)); + if (iunit == NULL) + { + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); + return NULL; + } + + memset (iunit, '\0', sizeof (gfc_unit)); +#ifdef __GTHREAD_MUTEX_INIT + { + __gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT; + iunit->lock = tmp; + } +#else + __GTHREAD_MUTEX_INIT_FUNCTION (&iunit->lock); +#endif + __gthread_mutex_lock (&iunit->lock); + + iunit->recl = dtp->internal_unit_len; + + /* For internal units we set the unit number to -1. + Otherwise internal units can be mistaken for a pre-connected unit or + some other file I/O unit. */ + iunit->unit_number = -1; + + /* Set up the looping specification from the array descriptor, if any. */ + + if (is_array_io (dtp)) + { + iunit->rank = GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc); + iunit->ls = (array_loop_spec *) + get_mem (iunit->rank * sizeof (array_loop_spec)); + dtp->internal_unit_len *= + init_loop_spec (dtp->internal_unit_desc, iunit->ls, &start_record); + + start_record *= iunit->recl; + } + + /* Set initial values for unit parameters. */ + if (dtp->common.unit) + { + iunit->s = open_internal4 (dtp->internal_unit - start_record, + dtp->internal_unit_len, -start_record); + fbuf_init (iunit, 256); + } + else + iunit->s = open_internal (dtp->internal_unit - start_record, + dtp->internal_unit_len, -start_record); + + iunit->bytes_left = iunit->recl; + iunit->last_record=0; + iunit->maxrec=0; + iunit->current_record=0; + iunit->read_bad = 0; + iunit->endfile = NO_ENDFILE; + + /* Set flags for the internal unit. */ + + iunit->flags.access = ACCESS_SEQUENTIAL; + iunit->flags.action = ACTION_READWRITE; + iunit->flags.blank = BLANK_NULL; + iunit->flags.form = FORM_FORMATTED; + iunit->flags.pad = PAD_YES; + iunit->flags.status = STATUS_UNSPECIFIED; + iunit->flags.sign = SIGN_SUPPRESS; + iunit->flags.decimal = DECIMAL_POINT; + iunit->flags.encoding = ENCODING_DEFAULT; + iunit->flags.async = ASYNC_NO; + iunit->flags.round = ROUND_COMPATIBLE; + + /* Initialize the data transfer parameters. */ + + dtp->u.p.advance_status = ADVANCE_YES; + dtp->u.p.seen_dollar = 0; + dtp->u.p.skips = 0; + dtp->u.p.pending_spaces = 0; + dtp->u.p.max_pos = 0; + dtp->u.p.at_eof = 0; + + /* This flag tells us the unit is assigned to internal I/O. */ + + dtp->u.p.unit_is_internal = 1; + + return iunit; +} + + +/* free_internal_unit()-- Free memory allocated for internal units if any. */ +void +free_internal_unit (st_parameter_dt *dtp) +{ + if (!is_internal_unit (dtp)) + return; + + if (unlikely (is_char4_unit (dtp))) + fbuf_destroy (dtp->u.p.current_unit); + + if (dtp->u.p.current_unit != NULL) + { + if (dtp->u.p.current_unit->ls != NULL) + free (dtp->u.p.current_unit->ls); + + if (dtp->u.p.current_unit->s) + free (dtp->u.p.current_unit->s); + + destroy_unit_mutex (dtp->u.p.current_unit); + } +} + + + +/* get_unit()-- Returns the unit structure associated with the integer + unit or the internal file. */ + +gfc_unit * +get_unit (st_parameter_dt *dtp, int do_create) +{ + + if ((dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT) != 0) + return get_internal_unit (dtp); + + /* Has to be an external unit. */ + + dtp->u.p.unit_is_internal = 0; + dtp->internal_unit_desc = NULL; + + return get_external_unit (dtp->common.unit, do_create); +} + + +/*************************/ +/* Initialize everything. */ + +void +init_units (void) +{ + gfc_unit *u; + unsigned int i; + +#ifndef __GTHREAD_MUTEX_INIT + __GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock); +#endif + + next_available_newunit = GFC_FIRST_NEWUNIT; + + if (options.stdin_unit >= 0) + { /* STDIN */ + u = insert_unit (options.stdin_unit); + u->s = input_stream (); + + u->flags.action = ACTION_READ; + + u->flags.access = ACCESS_SEQUENTIAL; + u->flags.form = FORM_FORMATTED; + u->flags.status = STATUS_OLD; + u->flags.blank = BLANK_NULL; + u->flags.pad = PAD_YES; + u->flags.position = POSITION_ASIS; + u->flags.sign = SIGN_SUPPRESS; + u->flags.decimal = DECIMAL_POINT; + u->flags.encoding = ENCODING_DEFAULT; + u->flags.async = ASYNC_NO; + u->flags.round = ROUND_COMPATIBLE; + + u->recl = options.default_recl; + u->endfile = NO_ENDFILE; + + u->file_len = strlen (stdin_name); + u->file = get_mem (u->file_len); + memmove (u->file, stdin_name, u->file_len); + + fbuf_init (u, 0); + + __gthread_mutex_unlock (&u->lock); + } + + if (options.stdout_unit >= 0) + { /* STDOUT */ + u = insert_unit (options.stdout_unit); + u->s = output_stream (); + + u->flags.action = ACTION_WRITE; + + u->flags.access = ACCESS_SEQUENTIAL; + u->flags.form = FORM_FORMATTED; + u->flags.status = STATUS_OLD; + u->flags.blank = BLANK_NULL; + u->flags.position = POSITION_ASIS; + u->flags.sign = SIGN_SUPPRESS; + u->flags.decimal = DECIMAL_POINT; + u->flags.encoding = ENCODING_DEFAULT; + u->flags.async = ASYNC_NO; + u->flags.round = ROUND_COMPATIBLE; + + u->recl = options.default_recl; + u->endfile = AT_ENDFILE; + + u->file_len = strlen (stdout_name); + u->file = get_mem (u->file_len); + memmove (u->file, stdout_name, u->file_len); + + fbuf_init (u, 0); + + __gthread_mutex_unlock (&u->lock); + } + + if (options.stderr_unit >= 0) + { /* STDERR */ + u = insert_unit (options.stderr_unit); + u->s = error_stream (); + + u->flags.action = ACTION_WRITE; + + u->flags.access = ACCESS_SEQUENTIAL; + u->flags.form = FORM_FORMATTED; + u->flags.status = STATUS_OLD; + u->flags.blank = BLANK_NULL; + u->flags.position = POSITION_ASIS; + u->flags.sign = SIGN_SUPPRESS; + u->flags.decimal = DECIMAL_POINT; + u->flags.encoding = ENCODING_DEFAULT; + u->flags.async = ASYNC_NO; + u->flags.round = ROUND_COMPATIBLE; + + u->recl = options.default_recl; + u->endfile = AT_ENDFILE; + + u->file_len = strlen (stderr_name); + u->file = get_mem (u->file_len); + memmove (u->file, stderr_name, u->file_len); + + fbuf_init (u, 256); /* 256 bytes should be enough, probably not doing + any kind of exotic formatting to stderr. */ + + __gthread_mutex_unlock (&u->lock); + } + + /* Calculate the maximum file offset in a portable manner. + max will be the largest signed number for the type gfc_offset. + set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */ + max_offset = 0; + for (i = 0; i < sizeof (max_offset) * 8 - 1; i++) + max_offset = max_offset + ((gfc_offset) 1 << i); +} + + +static int +close_unit_1 (gfc_unit *u, int locked) +{ + int i, rc; + + /* If there are previously written bytes from a write with ADVANCE="no" + Reposition the buffer before closing. */ + if (u->previous_nonadvancing_write) + finish_last_advance_record (u); + + rc = (u->s == NULL) ? 0 : sclose (u->s) == -1; + + u->closed = 1; + if (!locked) + __gthread_mutex_lock (&unit_lock); + + for (i = 0; i < CACHE_SIZE; i++) + if (unit_cache[i] == u) + unit_cache[i] = NULL; + + delete_unit (u); + + if (u->file) + free (u->file); + u->file = NULL; + u->file_len = 0; + + free_format_hash_table (u); + fbuf_destroy (u); + + if (!locked) + __gthread_mutex_unlock (&u->lock); + + /* If there are any threads waiting in find_unit for this unit, + avoid freeing the memory, the last such thread will free it + instead. */ + if (u->waiting == 0) + destroy_unit_mutex (u); + + if (!locked) + __gthread_mutex_unlock (&unit_lock); + + return rc; +} + +void +unlock_unit (gfc_unit *u) +{ + __gthread_mutex_unlock (&u->lock); +} + +/* close_unit()-- Close a unit. The stream is closed, and any memory + associated with the stream is freed. Returns nonzero on I/O error. + Should be called with the u->lock locked. */ + +int +close_unit (gfc_unit *u) +{ + return close_unit_1 (u, 0); +} + + +/* close_units()-- Delete units on completion. We just keep deleting + the root of the treap until there is nothing left. + Not sure what to do with locking here. Some other thread might be + holding some unit's lock and perhaps hold it indefinitely + (e.g. waiting for input from some pipe) and close_units shouldn't + delay the program too much. */ + +void +close_units (void) +{ + __gthread_mutex_lock (&unit_lock); + while (unit_root != NULL) + close_unit_1 (unit_root, 1); + __gthread_mutex_unlock (&unit_lock); +} + + +/* update_position()-- Update the flags position for later use by inquire. */ + +void +update_position (gfc_unit *u) +{ + /* If unit is not seekable, this makes no sense (and the standard is + silent on this matter), and thus we don't change the position for + a non-seekable file. */ + if (is_seekable (u->s)) + { + gfc_offset cur = stell (u->s); + if (cur == 0) + u->flags.position = POSITION_REWIND; + else if (cur != -1 && (file_length (u->s) == cur)) + u->flags.position = POSITION_APPEND; + else + u->flags.position = POSITION_ASIS; + } +} + + +/* High level interface to truncate a file safely, i.e. flush format + buffers, check that it's a regular file, and generate error if that + occurs. Just like POSIX ftruncate, returns 0 on success, -1 on + failure. */ + +int +unit_truncate (gfc_unit * u, gfc_offset pos, st_parameter_common * common) +{ + int ret; + + /* Make sure format buffer is flushed. */ + if (u->flags.form == FORM_FORMATTED) + { + if (u->mode == READING) + pos += fbuf_reset (u); + else + fbuf_flush (u, u->mode); + } + + /* Don't try to truncate a special file, just pretend that it + succeeds. */ + if (is_special (u->s) || !is_seekable (u->s)) + { + sflush (u->s); + return 0; + } + + /* struncate() should flush the stream buffer if necessary, so don't + bother calling sflush() here. */ + ret = struncate (u->s, pos); + + if (ret != 0) + { + generate_error (common, LIBERROR_OS, NULL); + u->endfile = NO_ENDFILE; + u->flags.position = POSITION_ASIS; + } + else + { + u->endfile = AT_ENDFILE; + u->flags.position = POSITION_APPEND; + } + + return ret; +} + + +/* filename_from_unit()-- If the unit_number exists, return a pointer to the + name of the associated file, otherwise return the empty string. The caller + must free memory allocated for the filename string. */ + +char * +filename_from_unit (int n) +{ + char *filename; + gfc_unit *u; + int c; + + /* Find the unit. */ + u = unit_root; + while (u != NULL) + { + c = compare (n, u->unit_number); + if (c < 0) + u = u->left; + if (c > 0) + u = u->right; + if (c == 0) + break; + } + + /* Get the filename. */ + if (u != NULL) + { + filename = (char *) get_mem (u->file_len + 1); + unpack_filename (filename, u->file, u->file_len); + return filename; + } + else + return (char *) NULL; +} + +void +finish_last_advance_record (gfc_unit *u) +{ + + if (u->saved_pos > 0) + fbuf_seek (u, u->saved_pos, SEEK_CUR); + + if (!(u->unit_number == options.stdout_unit + || u->unit_number == options.stderr_unit)) + { +#ifdef HAVE_CRLF + const int len = 2; +#else + const int len = 1; +#endif + char *p = fbuf_alloc (u, len); + if (!p) + os_error ("Completing record after ADVANCE_NO failed"); +#ifdef HAVE_CRLF + *(p++) = '\r'; +#endif + *p = '\n'; + } + + fbuf_flush (u, u->mode); +} + +/* Assign a negative number for NEWUNIT in OPEN statements. */ +GFC_INTEGER_4 +get_unique_unit_number (st_parameter_open *opp) +{ + GFC_INTEGER_4 num; + + __gthread_mutex_lock (&unit_lock); + num = next_available_newunit--; + + /* Do not allow NEWUNIT numbers to wrap. */ + if (next_available_newunit >= GFC_FIRST_NEWUNIT ) + { + __gthread_mutex_unlock (&unit_lock); + generate_error (&opp->common, LIBERROR_INTERNAL, "NEWUNIT exhausted"); + return 0; + } + __gthread_mutex_unlock (&unit_lock); + return num; +} diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c new file mode 100644 index 000000000..26bb06a09 --- /dev/null +++ b/libgfortran/io/unix.c @@ -0,0 +1,1891 @@ +/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, + 2011 + Free Software Foundation, Inc. + Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +/* Unix stream I/O module */ + +#include "io.h" +#include "unix.h" +#include +#include + +#include +#include +#include +#include + +#include +#include + + +/* For mingw, we don't identify files by their inode number, but by a + 64-bit identifier created from a BY_HANDLE_FILE_INFORMATION. */ +#ifdef __MINGW32__ + +#define WIN32_LEAN_AND_MEAN +#include + +#define lseek _lseeki64 +#define fstat _fstati64 +#define stat _stati64 +typedef struct _stati64 gfstat_t; + +#ifndef HAVE_WORKING_STAT +static uint64_t +id_from_handle (HANDLE hFile) +{ + BY_HANDLE_FILE_INFORMATION FileInformation; + + if (hFile == INVALID_HANDLE_VALUE) + return 0; + + memset (&FileInformation, 0, sizeof(FileInformation)); + if (!GetFileInformationByHandle (hFile, &FileInformation)) + return 0; + + return ((uint64_t) FileInformation.nFileIndexLow) + | (((uint64_t) FileInformation.nFileIndexHigh) << 32); +} + + +static uint64_t +id_from_path (const char *path) +{ + HANDLE hFile; + uint64_t res; + + if (!path || !*path || access (path, F_OK)) + return (uint64_t) -1; + + hFile = CreateFile (path, 0, 0, NULL, OPEN_EXISTING, + FILE_FLAG_BACKUP_SEMANTICS | FILE_ATTRIBUTE_READONLY, + NULL); + res = id_from_handle (hFile); + CloseHandle (hFile); + return res; +} + + +static uint64_t +id_from_fd (const int fd) +{ + return id_from_handle ((HANDLE) _get_osfhandle (fd)); +} + +#endif + +#else +typedef struct stat gfstat_t; +#endif + +#ifndef PATH_MAX +#define PATH_MAX 1024 +#endif + +/* These flags aren't defined on all targets (mingw32), so provide them + here. */ +#ifndef S_IRGRP +#define S_IRGRP 0 +#endif + +#ifndef S_IWGRP +#define S_IWGRP 0 +#endif + +#ifndef S_IROTH +#define S_IROTH 0 +#endif + +#ifndef S_IWOTH +#define S_IWOTH 0 +#endif + + +#ifndef HAVE_ACCESS + +#ifndef W_OK +#define W_OK 2 +#endif + +#ifndef R_OK +#define R_OK 4 +#endif + +#ifndef F_OK +#define F_OK 0 +#endif + +/* Fallback implementation of access() on systems that don't have it. + Only modes R_OK, W_OK and F_OK are used in this file. */ + +static int +fallback_access (const char *path, int mode) +{ + int fd; + + if ((mode & R_OK) && (fd = open (path, O_RDONLY)) < 0) + return -1; + close (fd); + + if ((mode & W_OK) && (fd = open (path, O_WRONLY)) < 0) + return -1; + close (fd); + + if (mode == F_OK) + { + gfstat_t st; + return stat (path, &st); + } + + return 0; +} + +#undef access +#define access fallback_access +#endif + + +/* Unix and internal stream I/O module */ + +static const int BUFFER_SIZE = 8192; + +typedef struct +{ + stream st; + + gfc_offset buffer_offset; /* File offset of the start of the buffer */ + gfc_offset physical_offset; /* Current physical file offset */ + gfc_offset logical_offset; /* Current logical file offset */ + gfc_offset file_length; /* Length of the file, -1 if not seekable. */ + + char *buffer; /* Pointer to the buffer. */ + int fd; /* The POSIX file descriptor. */ + + int active; /* Length of valid bytes in the buffer */ + + int ndirty; /* Dirty bytes starting at buffer_offset */ + + int special_file; /* =1 if the fd refers to a special file */ + + /* Cached stat(2) values. */ + dev_t st_dev; + ino_t st_ino; +} +unix_stream; + + +/* fix_fd()-- Given a file descriptor, make sure it is not one of the + * standard descriptors, returning a non-standard descriptor. If the + * user specifies that system errors should go to standard output, + * then closes standard output, we don't want the system errors to a + * file that has been given file descriptor 1 or 0. We want to send + * the error to the invalid descriptor. */ + +static int +fix_fd (int fd) +{ +#ifdef HAVE_DUP + int input, output, error; + + input = output = error = 0; + + /* Unix allocates the lowest descriptors first, so a loop is not + required, but this order is. */ + if (fd == STDIN_FILENO) + { + fd = dup (fd); + input = 1; + } + if (fd == STDOUT_FILENO) + { + fd = dup (fd); + output = 1; + } + if (fd == STDERR_FILENO) + { + fd = dup (fd); + error = 1; + } + + if (input) + close (STDIN_FILENO); + if (output) + close (STDOUT_FILENO); + if (error) + close (STDERR_FILENO); +#endif + + return fd; +} + + +/* If the stream corresponds to a preconnected unit, we flush the + corresponding C stream. This is bugware for mixed C-Fortran codes + where the C code doesn't flush I/O before returning. */ +void +flush_if_preconnected (stream * s) +{ + int fd; + + fd = ((unix_stream *) s)->fd; + if (fd == STDIN_FILENO) + fflush (stdin); + else if (fd == STDOUT_FILENO) + fflush (stdout); + else if (fd == STDERR_FILENO) + fflush (stderr); +} + + +/******************************************************************** +Raw I/O functions (read, write, seek, tell, truncate, close). + +These functions wrap the basic POSIX I/O syscalls. Any deviation in +semantics is a bug, except the following: write restarts in case +of being interrupted by a signal, and as the first argument the +functions take the unix_stream struct rather than an integer file +descriptor. Also, for POSIX read() and write() a nbyte argument larger +than SSIZE_MAX is undefined; here the type of nbyte is ssize_t rather +than size_t as for POSIX read/write. +*********************************************************************/ + +static int +raw_flush (unix_stream * s __attribute__ ((unused))) +{ + return 0; +} + +static ssize_t +raw_read (unix_stream * s, void * buf, ssize_t nbyte) +{ + /* For read we can't do I/O in a loop like raw_write does, because + that will break applications that wait for interactive I/O. */ + return read (s->fd, buf, nbyte); +} + +static ssize_t +raw_write (unix_stream * s, const void * buf, ssize_t nbyte) +{ + ssize_t trans, bytes_left; + char *buf_st; + + bytes_left = nbyte; + buf_st = (char *) buf; + + /* We must write in a loop since some systems don't restart system + calls in case of a signal. */ + while (bytes_left > 0) + { + trans = write (s->fd, buf_st, bytes_left); + if (trans < 0) + { + if (errno == EINTR) + continue; + else + return trans; + } + buf_st += trans; + bytes_left -= trans; + } + + return nbyte - bytes_left; +} + +static gfc_offset +raw_seek (unix_stream * s, gfc_offset offset, int whence) +{ + return lseek (s->fd, offset, whence); +} + +static gfc_offset +raw_tell (unix_stream * s) +{ + return lseek (s->fd, 0, SEEK_CUR); +} + +static int +raw_truncate (unix_stream * s, gfc_offset length) +{ +#ifdef __MINGW32__ + HANDLE h; + gfc_offset cur; + + if (isatty (s->fd)) + { + errno = EBADF; + return -1; + } + h = (HANDLE) _get_osfhandle (s->fd); + if (h == INVALID_HANDLE_VALUE) + { + errno = EBADF; + return -1; + } + cur = lseek (s->fd, 0, SEEK_CUR); + if (cur == -1) + return -1; + if (lseek (s->fd, length, SEEK_SET) == -1) + goto error; + if (!SetEndOfFile (h)) + { + errno = EBADF; + goto error; + } + if (lseek (s->fd, cur, SEEK_SET) == -1) + return -1; + return 0; + error: + lseek (s->fd, cur, SEEK_SET); + return -1; +#elif defined HAVE_FTRUNCATE + return ftruncate (s->fd, length); +#elif defined HAVE_CHSIZE + return chsize (s->fd, length); +#else + runtime_error ("required ftruncate or chsize support not present"); + return -1; +#endif +} + +static int +raw_close (unix_stream * s) +{ + int retval; + + if (s->fd != STDOUT_FILENO + && s->fd != STDERR_FILENO + && s->fd != STDIN_FILENO) + retval = close (s->fd); + else + retval = 0; + free (s); + return retval; +} + +static int +raw_init (unix_stream * s) +{ + s->st.read = (void *) raw_read; + s->st.write = (void *) raw_write; + s->st.seek = (void *) raw_seek; + s->st.tell = (void *) raw_tell; + s->st.trunc = (void *) raw_truncate; + s->st.close = (void *) raw_close; + s->st.flush = (void *) raw_flush; + + s->buffer = NULL; + return 0; +} + + +/********************************************************************* +Buffered I/O functions. These functions have the same semantics as the +raw I/O functions above, except that they are buffered in order to +improve performance. The buffer must be flushed when switching from +reading to writing and vice versa. +*********************************************************************/ + +static int +buf_flush (unix_stream * s) +{ + int writelen; + + /* Flushing in read mode means discarding read bytes. */ + s->active = 0; + + if (s->ndirty == 0) + return 0; + + if (s->file_length != -1 && s->physical_offset != s->buffer_offset + && lseek (s->fd, s->buffer_offset, SEEK_SET) < 0) + return -1; + + writelen = raw_write (s, s->buffer, s->ndirty); + + s->physical_offset = s->buffer_offset + writelen; + + /* Don't increment file_length if the file is non-seekable. */ + if (s->file_length != -1 && s->physical_offset > s->file_length) + s->file_length = s->physical_offset; + + s->ndirty -= writelen; + if (s->ndirty != 0) + return -1; + + return 0; +} + +static ssize_t +buf_read (unix_stream * s, void * buf, ssize_t nbyte) +{ + if (s->active == 0) + s->buffer_offset = s->logical_offset; + + /* Is the data we want in the buffer? */ + if (s->logical_offset + nbyte <= s->buffer_offset + s->active + && s->buffer_offset <= s->logical_offset) + memcpy (buf, s->buffer + (s->logical_offset - s->buffer_offset), nbyte); + else + { + /* First copy the active bytes if applicable, then read the rest + either directly or filling the buffer. */ + char *p; + int nread = 0; + ssize_t to_read, did_read; + gfc_offset new_logical; + + p = (char *) buf; + if (s->logical_offset >= s->buffer_offset + && s->buffer_offset + s->active >= s->logical_offset) + { + nread = s->active - (s->logical_offset - s->buffer_offset); + memcpy (buf, s->buffer + (s->logical_offset - s->buffer_offset), + nread); + p += nread; + } + /* At this point we consider all bytes in the buffer discarded. */ + to_read = nbyte - nread; + new_logical = s->logical_offset + nread; + if (s->file_length != -1 && s->physical_offset != new_logical + && lseek (s->fd, new_logical, SEEK_SET) < 0) + return -1; + s->buffer_offset = s->physical_offset = new_logical; + if (to_read <= BUFFER_SIZE/2) + { + did_read = raw_read (s, s->buffer, BUFFER_SIZE); + s->physical_offset += did_read; + s->active = did_read; + did_read = (did_read > to_read) ? to_read : did_read; + memcpy (p, s->buffer, did_read); + } + else + { + did_read = raw_read (s, p, to_read); + s->physical_offset += did_read; + s->active = 0; + } + nbyte = did_read + nread; + } + s->logical_offset += nbyte; + return nbyte; +} + +static ssize_t +buf_write (unix_stream * s, const void * buf, ssize_t nbyte) +{ + if (s->ndirty == 0) + s->buffer_offset = s->logical_offset; + + /* Does the data fit into the buffer? As a special case, if the + buffer is empty and the request is bigger than BUFFER_SIZE/2, + write directly. This avoids the case where the buffer would have + to be flushed at every write. */ + if (!(s->ndirty == 0 && nbyte > BUFFER_SIZE/2) + && s->logical_offset + nbyte <= s->buffer_offset + BUFFER_SIZE + && s->buffer_offset <= s->logical_offset + && s->buffer_offset + s->ndirty >= s->logical_offset) + { + memcpy (s->buffer + (s->logical_offset - s->buffer_offset), buf, nbyte); + int nd = (s->logical_offset - s->buffer_offset) + nbyte; + if (nd > s->ndirty) + s->ndirty = nd; + } + else + { + /* Flush, and either fill the buffer with the new data, or if + the request is bigger than the buffer size, write directly + bypassing the buffer. */ + buf_flush (s); + if (nbyte <= BUFFER_SIZE/2) + { + memcpy (s->buffer, buf, nbyte); + s->buffer_offset = s->logical_offset; + s->ndirty += nbyte; + } + else + { + if (s->file_length != -1 && s->physical_offset != s->logical_offset) + { + if (lseek (s->fd, s->logical_offset, SEEK_SET) < 0) + return -1; + s->physical_offset = s->logical_offset; + } + + nbyte = raw_write (s, buf, nbyte); + s->physical_offset += nbyte; + } + } + s->logical_offset += nbyte; + /* Don't increment file_length if the file is non-seekable. */ + if (s->file_length != -1 && s->logical_offset > s->file_length) + s->file_length = s->logical_offset; + return nbyte; +} + +static gfc_offset +buf_seek (unix_stream * s, gfc_offset offset, int whence) +{ + switch (whence) + { + case SEEK_SET: + break; + case SEEK_CUR: + offset += s->logical_offset; + break; + case SEEK_END: + offset += s->file_length; + break; + default: + return -1; + } + if (offset < 0) + { + errno = EINVAL; + return -1; + } + s->logical_offset = offset; + return offset; +} + +static gfc_offset +buf_tell (unix_stream * s) +{ + return s->logical_offset; +} + +static int +buf_truncate (unix_stream * s, gfc_offset length) +{ + int r; + + if (buf_flush (s) != 0) + return -1; + r = raw_truncate (s, length); + if (r == 0) + s->file_length = length; + return r; +} + +static int +buf_close (unix_stream * s) +{ + if (buf_flush (s) != 0) + return -1; + free (s->buffer); + return raw_close (s); +} + +static int +buf_init (unix_stream * s) +{ + s->st.read = (void *) buf_read; + s->st.write = (void *) buf_write; + s->st.seek = (void *) buf_seek; + s->st.tell = (void *) buf_tell; + s->st.trunc = (void *) buf_truncate; + s->st.close = (void *) buf_close; + s->st.flush = (void *) buf_flush; + + s->buffer = get_mem (BUFFER_SIZE); + return 0; +} + + +/********************************************************************* + memory stream functions - These are used for internal files + + The idea here is that a single stream structure is created and all + requests must be satisfied from it. The location and size of the + buffer is the character variable supplied to the READ or WRITE + statement. + +*********************************************************************/ + +char * +mem_alloc_r (stream * strm, int * len) +{ + unix_stream * s = (unix_stream *) strm; + gfc_offset n; + gfc_offset where = s->logical_offset; + + if (where < s->buffer_offset || where > s->buffer_offset + s->active) + return NULL; + + n = s->buffer_offset + s->active - where; + if (*len > n) + *len = n; + + s->logical_offset = where + *len; + + return s->buffer + (where - s->buffer_offset); +} + + +char * +mem_alloc_r4 (stream * strm, int * len) +{ + unix_stream * s = (unix_stream *) strm; + gfc_offset n; + gfc_offset where = s->logical_offset; + + if (where < s->buffer_offset || where > s->buffer_offset + s->active) + return NULL; + + n = s->buffer_offset + s->active - where; + if (*len > n) + *len = n; + + s->logical_offset = where + *len; + + return s->buffer + (where - s->buffer_offset) * 4; +} + + +char * +mem_alloc_w (stream * strm, int * len) +{ + unix_stream * s = (unix_stream *) strm; + gfc_offset m; + gfc_offset where = s->logical_offset; + + m = where + *len; + + if (where < s->buffer_offset) + return NULL; + + if (m > s->file_length) + return NULL; + + s->logical_offset = m; + + return s->buffer + (where - s->buffer_offset); +} + + +gfc_char4_t * +mem_alloc_w4 (stream * strm, int * len) +{ + unix_stream * s = (unix_stream *) strm; + gfc_offset m; + gfc_offset where = s->logical_offset; + gfc_char4_t *result = (gfc_char4_t *) s->buffer; + + m = where + *len; + + if (where < s->buffer_offset) + return NULL; + + if (m > s->file_length) + return NULL; + + s->logical_offset = m; + return &result[where - s->buffer_offset]; +} + + +/* Stream read function for character(kine=1) internal units. */ + +static ssize_t +mem_read (stream * s, void * buf, ssize_t nbytes) +{ + void *p; + int nb = nbytes; + + p = mem_alloc_r (s, &nb); + if (p) + { + memcpy (buf, p, nb); + return (ssize_t) nb; + } + else + return 0; +} + + +/* Stream read function for chracter(kind=4) internal units. */ + +static ssize_t +mem_read4 (stream * s, void * buf, ssize_t nbytes) +{ + void *p; + int nb = nbytes; + + p = mem_alloc_r (s, &nb); + if (p) + { + memcpy (buf, p, nb); + return (ssize_t) nb; + } + else + return 0; +} + + +/* Stream write function for character(kind=1) internal units. */ + +static ssize_t +mem_write (stream * s, const void * buf, ssize_t nbytes) +{ + void *p; + int nb = nbytes; + + p = mem_alloc_w (s, &nb); + if (p) + { + memcpy (p, buf, nb); + return (ssize_t) nb; + } + else + return 0; +} + + +/* Stream write function for character(kind=4) internal units. */ + +static ssize_t +mem_write4 (stream * s, const void * buf, ssize_t nwords) +{ + gfc_char4_t *p; + int nw = nwords; + + p = mem_alloc_w4 (s, &nw); + if (p) + { + while (nw--) + *p++ = (gfc_char4_t) *((char *) buf); + return nwords; + } + else + return 0; +} + + +static gfc_offset +mem_seek (stream * strm, gfc_offset offset, int whence) +{ + unix_stream * s = (unix_stream *) strm; + switch (whence) + { + case SEEK_SET: + break; + case SEEK_CUR: + offset += s->logical_offset; + break; + case SEEK_END: + offset += s->file_length; + break; + default: + return -1; + } + + /* Note that for internal array I/O it's actually possible to have a + negative offset, so don't check for that. */ + if (offset > s->file_length) + { + errno = EINVAL; + return -1; + } + + s->logical_offset = offset; + + /* Returning < 0 is the error indicator for sseek(), so return 0 if + offset is negative. Thus if the return value is 0, the caller + has to use stell() to get the real value of logical_offset. */ + if (offset >= 0) + return offset; + return 0; +} + + +static gfc_offset +mem_tell (stream * s) +{ + return ((unix_stream *)s)->logical_offset; +} + + +static int +mem_truncate (unix_stream * s __attribute__ ((unused)), + gfc_offset length __attribute__ ((unused))) +{ + return 0; +} + + +static int +mem_flush (unix_stream * s __attribute__ ((unused))) +{ + return 0; +} + + +static int +mem_close (unix_stream * s) +{ + if (s != NULL) + free (s); + + return 0; +} + + +/********************************************************************* + Public functions -- A reimplementation of this module needs to + define functional equivalents of the following. +*********************************************************************/ + +/* open_internal()-- Returns a stream structure from a character(kind=1) + internal file */ + +stream * +open_internal (char *base, int length, gfc_offset offset) +{ + unix_stream *s; + + s = get_mem (sizeof (unix_stream)); + memset (s, '\0', sizeof (unix_stream)); + + s->buffer = base; + s->buffer_offset = offset; + + s->logical_offset = 0; + s->active = s->file_length = length; + + s->st.close = (void *) mem_close; + s->st.seek = (void *) mem_seek; + s->st.tell = (void *) mem_tell; + s->st.trunc = (void *) mem_truncate; + s->st.read = (void *) mem_read; + s->st.write = (void *) mem_write; + s->st.flush = (void *) mem_flush; + + return (stream *) s; +} + +/* open_internal4()-- Returns a stream structure from a character(kind=4) + internal file */ + +stream * +open_internal4 (char *base, int length, gfc_offset offset) +{ + unix_stream *s; + + s = get_mem (sizeof (unix_stream)); + memset (s, '\0', sizeof (unix_stream)); + + s->buffer = base; + s->buffer_offset = offset; + + s->logical_offset = 0; + s->active = s->file_length = length; + + s->st.close = (void *) mem_close; + s->st.seek = (void *) mem_seek; + s->st.tell = (void *) mem_tell; + s->st.trunc = (void *) mem_truncate; + s->st.read = (void *) mem_read4; + s->st.write = (void *) mem_write4; + s->st.flush = (void *) mem_flush; + + return (stream *) s; +} + + +/* fd_to_stream()-- Given an open file descriptor, build a stream + * around it. */ + +static stream * +fd_to_stream (int fd) +{ + gfstat_t statbuf; + unix_stream *s; + + s = get_mem (sizeof (unix_stream)); + memset (s, '\0', sizeof (unix_stream)); + + s->fd = fd; + s->buffer_offset = 0; + s->physical_offset = 0; + s->logical_offset = 0; + + /* Get the current length of the file. */ + + fstat (fd, &statbuf); + + s->st_dev = statbuf.st_dev; + s->st_ino = statbuf.st_ino; + s->special_file = !S_ISREG (statbuf.st_mode); + + if (S_ISREG (statbuf.st_mode)) + s->file_length = statbuf.st_size; + else if (S_ISBLK (statbuf.st_mode)) + { + /* Hopefully more portable than ioctl(fd, BLKGETSIZE64, &size)? */ + gfc_offset cur = lseek (fd, 0, SEEK_CUR); + s->file_length = lseek (fd, 0, SEEK_END); + lseek (fd, cur, SEEK_SET); + } + else + s->file_length = -1; + + if (!(S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode)) + || options.all_unbuffered + ||(options.unbuffered_preconnected && + (s->fd == STDIN_FILENO + || s->fd == STDOUT_FILENO + || s->fd == STDERR_FILENO)) + || isatty (s->fd)) + raw_init (s); + else + buf_init (s); + + return (stream *) s; +} + + +/* Given the Fortran unit number, convert it to a C file descriptor. */ + +int +unit_to_fd (int unit) +{ + gfc_unit *us; + int fd; + + us = find_unit (unit); + if (us == NULL) + return -1; + + fd = ((unix_stream *) us->s)->fd; + unlock_unit (us); + return fd; +} + + +/* unpack_filename()-- Given a fortran string and a pointer to a + * buffer that is PATH_MAX characters, convert the fortran string to a + * C string in the buffer. Returns nonzero if this is not possible. */ + +int +unpack_filename (char *cstring, const char *fstring, int len) +{ + if (fstring == NULL) + return 1; + len = fstrlen (fstring, len); + if (len >= PATH_MAX) + return 1; + + memmove (cstring, fstring, len); + cstring[len] = '\0'; + + return 0; +} + + +/* tempfile()-- Generate a temporary filename for a scratch file and + * open it. mkstemp() opens the file for reading and writing, but the + * library mode prevents anything that is not allowed. The descriptor + * is returned, which is -1 on error. The template is pointed to by + * opp->file, which is copied into the unit structure + * and freed later. */ + +static int +tempfile (st_parameter_open *opp) +{ + const char *tempdir; + char *template; + const char *slash = "/"; + int fd; + + tempdir = getenv ("GFORTRAN_TMPDIR"); +#ifdef __MINGW32__ + if (tempdir == NULL) + { + char buffer[MAX_PATH + 1]; + DWORD ret; + ret = GetTempPath (MAX_PATH, buffer); + /* If we are not able to get a temp-directory, we use + current directory. */ + if (ret > MAX_PATH || !ret) + buffer[0] = 0; + else + buffer[ret] = 0; + tempdir = strdup (buffer); + } +#else + if (tempdir == NULL) + tempdir = getenv ("TMP"); + if (tempdir == NULL) + tempdir = getenv ("TEMP"); + if (tempdir == NULL) + tempdir = DEFAULT_TEMPDIR; +#endif + /* Check for special case that tempdir contains slash + or backslash at end. */ + if (*tempdir == 0 || tempdir[strlen (tempdir) - 1] == '/' +#ifdef __MINGW32__ + || tempdir[strlen (tempdir) - 1] == '\\' +#endif + ) + slash = ""; + + template = get_mem (strlen (tempdir) + 20); + +#ifdef HAVE_MKSTEMP + sprintf (template, "%s%sgfortrantmpXXXXXX", tempdir, slash); + + fd = mkstemp (template); + +#else /* HAVE_MKSTEMP */ + fd = -1; + do + { + sprintf (template, "%s%sgfortrantmpXXXXXX", tempdir, slash); + if (!mktemp (template)) + break; +#if defined(HAVE_CRLF) && defined(O_BINARY) + fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY, + S_IREAD | S_IWRITE); +#else + fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE); +#endif + } + while (fd == -1 && errno == EEXIST); +#endif /* HAVE_MKSTEMP */ + + opp->file = template; + opp->file_len = strlen (template); /* Don't include trailing nul */ + + return fd; +} + + +/* regular_file()-- Open a regular file. + * Change flags->action if it is ACTION_UNSPECIFIED on entry, + * unless an error occurs. + * Returns the descriptor, which is less than zero on error. */ + +static int +regular_file (st_parameter_open *opp, unit_flags *flags) +{ + char path[PATH_MAX + 1]; + int mode; + int rwflag; + int crflag; + int fd; + + if (unpack_filename (path, opp->file, opp->file_len)) + { + errno = ENOENT; /* Fake an OS error */ + return -1; + } + +#ifdef __CYGWIN__ + if (opp->file_len == 7) + { + if (strncmp (path, "CONOUT$", 7) == 0 + || strncmp (path, "CONERR$", 7) == 0) + { + fd = open ("/dev/conout", O_WRONLY); + flags->action = ACTION_WRITE; + return fd; + } + } + + if (opp->file_len == 6 && strncmp (path, "CONIN$", 6) == 0) + { + fd = open ("/dev/conin", O_RDONLY); + flags->action = ACTION_READ; + return fd; + } +#endif + + +#ifdef __MINGW32__ + if (opp->file_len == 7) + { + if (strncmp (path, "CONOUT$", 7) == 0 + || strncmp (path, "CONERR$", 7) == 0) + { + fd = open ("CONOUT$", O_WRONLY); + flags->action = ACTION_WRITE; + return fd; + } + } + + if (opp->file_len == 6 && strncmp (path, "CONIN$", 6) == 0) + { + fd = open ("CONIN$", O_RDONLY); + flags->action = ACTION_READ; + return fd; + } +#endif + + rwflag = 0; + + switch (flags->action) + { + case ACTION_READ: + rwflag = O_RDONLY; + break; + + case ACTION_WRITE: + rwflag = O_WRONLY; + break; + + case ACTION_READWRITE: + case ACTION_UNSPECIFIED: + rwflag = O_RDWR; + break; + + default: + internal_error (&opp->common, "regular_file(): Bad action"); + } + + switch (flags->status) + { + case STATUS_NEW: + crflag = O_CREAT | O_EXCL; + break; + + case STATUS_OLD: /* open will fail if the file does not exist*/ + crflag = 0; + break; + + case STATUS_UNKNOWN: + case STATUS_SCRATCH: + crflag = O_CREAT; + break; + + case STATUS_REPLACE: + crflag = O_CREAT | O_TRUNC; + break; + + default: + internal_error (&opp->common, "regular_file(): Bad status"); + } + + /* rwflag |= O_LARGEFILE; */ + +#if defined(HAVE_CRLF) && defined(O_BINARY) + crflag |= O_BINARY; +#endif + + mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH; + fd = open (path, rwflag | crflag, mode); + if (flags->action != ACTION_UNSPECIFIED) + return fd; + + if (fd >= 0) + { + flags->action = ACTION_READWRITE; + return fd; + } + if (errno != EACCES && errno != EROFS) + return fd; + + /* retry for read-only access */ + rwflag = O_RDONLY; + fd = open (path, rwflag | crflag, mode); + if (fd >=0) + { + flags->action = ACTION_READ; + return fd; /* success */ + } + + if (errno != EACCES) + return fd; /* failure */ + + /* retry for write-only access */ + rwflag = O_WRONLY; + fd = open (path, rwflag | crflag, mode); + if (fd >=0) + { + flags->action = ACTION_WRITE; + return fd; /* success */ + } + return fd; /* failure */ +} + + +/* open_external()-- Open an external file, unix specific version. + * Change flags->action if it is ACTION_UNSPECIFIED on entry. + * Returns NULL on operating system error. */ + +stream * +open_external (st_parameter_open *opp, unit_flags *flags) +{ + int fd; + + if (flags->status == STATUS_SCRATCH) + { + fd = tempfile (opp); + if (flags->action == ACTION_UNSPECIFIED) + flags->action = ACTION_READWRITE; + +#if HAVE_UNLINK_OPEN_FILE + /* We can unlink scratch files now and it will go away when closed. */ + if (fd >= 0) + unlink (opp->file); +#endif + } + else + { + /* regular_file resets flags->action if it is ACTION_UNSPECIFIED and + * if it succeeds */ + fd = regular_file (opp, flags); + } + + if (fd < 0) + return NULL; + fd = fix_fd (fd); + + return fd_to_stream (fd); +} + + +/* input_stream()-- Return a stream pointer to the default input stream. + * Called on initialization. */ + +stream * +input_stream (void) +{ + return fd_to_stream (STDIN_FILENO); +} + + +/* output_stream()-- Return a stream pointer to the default output stream. + * Called on initialization. */ + +stream * +output_stream (void) +{ + stream * s; + +#if defined(HAVE_CRLF) && defined(HAVE_SETMODE) + setmode (STDOUT_FILENO, O_BINARY); +#endif + + s = fd_to_stream (STDOUT_FILENO); + return s; +} + + +/* error_stream()-- Return a stream pointer to the default error stream. + * Called on initialization. */ + +stream * +error_stream (void) +{ + stream * s; + +#if defined(HAVE_CRLF) && defined(HAVE_SETMODE) + setmode (STDERR_FILENO, O_BINARY); +#endif + + s = fd_to_stream (STDERR_FILENO); + return s; +} + + +/* st_vprintf()-- vprintf function for error output. To avoid buffer + overruns, we limit the length of the buffer to ST_VPRINTF_SIZE. 2k + is big enough to completely fill a 80x25 terminal, so it shuld be + OK. We use a direct write() because it is simpler and least likely + to be clobbered by memory corruption. Writing an error message + longer than that is an error. */ + +#define ST_VPRINTF_SIZE 2048 + +int +st_vprintf (const char *format, va_list ap) +{ + static char buffer[ST_VPRINTF_SIZE]; + int written; + int fd; + + fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO; +#ifdef HAVE_VSNPRINTF + written = vsnprintf(buffer, ST_VPRINTF_SIZE, format, ap); +#else + written = vsprintf(buffer, format, ap); + + if (written >= ST_VPRINTF_SIZE-1) + { + /* The error message was longer than our buffer. Ouch. Because + we may have messed up things badly, report the error and + quit. */ +#define ERROR_MESSAGE "Internal error: buffer overrun in st_vprintf()\n" + write (fd, buffer, ST_VPRINTF_SIZE-1); + write (fd, ERROR_MESSAGE, strlen(ERROR_MESSAGE)); + sys_exit(2); +#undef ERROR_MESSAGE + + } +#endif + + written = write (fd, buffer, written); + return written; +} + +/* st_printf()-- printf() function for error output. This just calls + st_vprintf() to do the actual work. */ + +int +st_printf (const char *format, ...) +{ + int written; + va_list ap; + va_start (ap, format); + written = st_vprintf(format, ap); + va_end (ap); + return written; +} + + +/* compare_file_filename()-- Given an open stream and a fortran string + * that is a filename, figure out if the file is the same as the + * filename. */ + +int +compare_file_filename (gfc_unit *u, const char *name, int len) +{ + char path[PATH_MAX + 1]; + gfstat_t st; +#ifdef HAVE_WORKING_STAT + unix_stream *s; +#else +# ifdef __MINGW32__ + uint64_t id1, id2; +# endif +#endif + + if (unpack_filename (path, name, len)) + return 0; /* Can't be the same */ + + /* If the filename doesn't exist, then there is no match with the + * existing file. */ + + if (stat (path, &st) < 0) + return 0; + +#ifdef HAVE_WORKING_STAT + s = (unix_stream *) (u->s); + return (st.st_dev == s->st_dev) && (st.st_ino == s->st_ino); +#else + +# ifdef __MINGW32__ + /* We try to match files by a unique ID. On some filesystems (network + fs and FAT), we can't generate this unique ID, and will simply compare + filenames. */ + id1 = id_from_path (path); + id2 = id_from_fd (((unix_stream *) (u->s))->fd); + if (id1 || id2) + return (id1 == id2); +# endif + + if (len != u->file_len) + return 0; + return (memcmp(path, u->file, len) == 0); +#endif +} + + +#ifdef HAVE_WORKING_STAT +# define FIND_FILE0_DECL gfstat_t *st +# define FIND_FILE0_ARGS st +#else +# define FIND_FILE0_DECL uint64_t id, const char *file, gfc_charlen_type file_len +# define FIND_FILE0_ARGS id, file, file_len +#endif + +/* find_file0()-- Recursive work function for find_file() */ + +static gfc_unit * +find_file0 (gfc_unit *u, FIND_FILE0_DECL) +{ + gfc_unit *v; +#if defined(__MINGW32__) && !HAVE_WORKING_STAT + uint64_t id1; +#endif + + if (u == NULL) + return NULL; + +#ifdef HAVE_WORKING_STAT + if (u->s != NULL) + { + unix_stream *s = (unix_stream *) (u->s); + if (st[0].st_dev == s->st_dev && st[0].st_ino == s->st_ino) + return u; + } +#else +# ifdef __MINGW32__ + if (u->s && ((id1 = id_from_fd (((unix_stream *) u->s)->fd)) || id1)) + { + if (id == id1) + return u; + } + else +# endif + if (compare_string (u->file_len, u->file, file_len, file) == 0) + return u; +#endif + + v = find_file0 (u->left, FIND_FILE0_ARGS); + if (v != NULL) + return v; + + v = find_file0 (u->right, FIND_FILE0_ARGS); + if (v != NULL) + return v; + + return NULL; +} + + +/* find_file()-- Take the current filename and see if there is a unit + * that has the file already open. Returns a pointer to the unit if so. */ + +gfc_unit * +find_file (const char *file, gfc_charlen_type file_len) +{ + char path[PATH_MAX + 1]; + gfstat_t st[1]; + gfc_unit *u; +#if defined(__MINGW32__) && !HAVE_WORKING_STAT + uint64_t id = 0ULL; +#endif + + if (unpack_filename (path, file, file_len)) + return NULL; + + if (stat (path, &st[0]) < 0) + return NULL; + +#if defined(__MINGW32__) && !HAVE_WORKING_STAT + id = id_from_path (path); +#endif + + __gthread_mutex_lock (&unit_lock); +retry: + u = find_file0 (unit_root, FIND_FILE0_ARGS); + if (u != NULL) + { + /* Fast path. */ + if (! __gthread_mutex_trylock (&u->lock)) + { + /* assert (u->closed == 0); */ + __gthread_mutex_unlock (&unit_lock); + return u; + } + + inc_waiting_locked (u); + } + __gthread_mutex_unlock (&unit_lock); + if (u != NULL) + { + __gthread_mutex_lock (&u->lock); + if (u->closed) + { + __gthread_mutex_lock (&unit_lock); + __gthread_mutex_unlock (&u->lock); + if (predec_waiting_locked (u) == 0) + free (u); + goto retry; + } + + dec_waiting_unlocked (u); + } + return u; +} + + +/* Flush dirty data, making sure that OS metadata is updated as + well. Note that this is VERY slow on mingw due to committing data + to stable storage. */ +int +flush_sync (stream * s) +{ + if (sflush (s) == -1) + return -1; +#ifdef __MINGW32__ + if (_commit (((unix_stream *)s)->fd) == -1) + return -1; +#endif + return 0; +} + + +static gfc_unit * +flush_all_units_1 (gfc_unit *u, int min_unit) +{ + while (u != NULL) + { + if (u->unit_number > min_unit) + { + gfc_unit *r = flush_all_units_1 (u->left, min_unit); + if (r != NULL) + return r; + } + if (u->unit_number >= min_unit) + { + if (__gthread_mutex_trylock (&u->lock)) + return u; + if (u->s) + flush_sync (u->s); + __gthread_mutex_unlock (&u->lock); + } + u = u->right; + } + return NULL; +} + +void +flush_all_units (void) +{ + gfc_unit *u; + int min_unit = 0; + + __gthread_mutex_lock (&unit_lock); + do + { + u = flush_all_units_1 (unit_root, min_unit); + if (u != NULL) + inc_waiting_locked (u); + __gthread_mutex_unlock (&unit_lock); + if (u == NULL) + return; + + __gthread_mutex_lock (&u->lock); + + min_unit = u->unit_number + 1; + + if (u->closed == 0) + { + flush_sync (u->s); + __gthread_mutex_lock (&unit_lock); + __gthread_mutex_unlock (&u->lock); + (void) predec_waiting_locked (u); + } + else + { + __gthread_mutex_lock (&unit_lock); + __gthread_mutex_unlock (&u->lock); + if (predec_waiting_locked (u) == 0) + free (u); + } + } + while (1); +} + + +/* delete_file()-- Given a unit structure, delete the file associated + * with the unit. Returns nonzero if something went wrong. */ + +int +delete_file (gfc_unit * u) +{ + char path[PATH_MAX + 1]; + + if (unpack_filename (path, u->file, u->file_len)) + { /* Shouldn't be possible */ + errno = ENOENT; + return 1; + } + + return unlink (path); +} + + +/* file_exists()-- Returns nonzero if the current filename exists on + * the system */ + +int +file_exists (const char *file, gfc_charlen_type file_len) +{ + char path[PATH_MAX + 1]; + + if (unpack_filename (path, file, file_len)) + return 0; + + return !(access (path, F_OK)); +} + + +/* file_size()-- Returns the size of the file. */ + +GFC_IO_INT +file_size (const char *file, gfc_charlen_type file_len) +{ + char path[PATH_MAX + 1]; + gfstat_t statbuf; + + if (unpack_filename (path, file, file_len)) + return -1; + + if (stat (path, &statbuf) < 0) + return -1; + + return (GFC_IO_INT) statbuf.st_size; +} + +static const char yes[] = "YES", no[] = "NO", unknown[] = "UNKNOWN"; + +/* inquire_sequential()-- Given a fortran string, determine if the + * file is suitable for sequential access. Returns a C-style + * string. */ + +const char * +inquire_sequential (const char *string, int len) +{ + char path[PATH_MAX + 1]; + gfstat_t statbuf; + + if (string == NULL || + unpack_filename (path, string, len) || stat (path, &statbuf) < 0) + return unknown; + + if (S_ISREG (statbuf.st_mode) || + S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode)) + return unknown; + + if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode)) + return no; + + return unknown; +} + + +/* inquire_direct()-- Given a fortran string, determine if the file is + * suitable for direct access. Returns a C-style string. */ + +const char * +inquire_direct (const char *string, int len) +{ + char path[PATH_MAX + 1]; + gfstat_t statbuf; + + if (string == NULL || + unpack_filename (path, string, len) || stat (path, &statbuf) < 0) + return unknown; + + if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode)) + return unknown; + + if (S_ISDIR (statbuf.st_mode) || + S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode)) + return no; + + return unknown; +} + + +/* inquire_formatted()-- Given a fortran string, determine if the file + * is suitable for formatted form. Returns a C-style string. */ + +const char * +inquire_formatted (const char *string, int len) +{ + char path[PATH_MAX + 1]; + gfstat_t statbuf; + + if (string == NULL || + unpack_filename (path, string, len) || stat (path, &statbuf) < 0) + return unknown; + + if (S_ISREG (statbuf.st_mode) || + S_ISBLK (statbuf.st_mode) || + S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode)) + return unknown; + + if (S_ISDIR (statbuf.st_mode)) + return no; + + return unknown; +} + + +/* inquire_unformatted()-- Given a fortran string, determine if the file + * is suitable for unformatted form. Returns a C-style string. */ + +const char * +inquire_unformatted (const char *string, int len) +{ + return inquire_formatted (string, len); +} + + +/* inquire_access()-- Given a fortran string, determine if the file is + * suitable for access. */ + +static const char * +inquire_access (const char *string, int len, int mode) +{ + char path[PATH_MAX + 1]; + + if (string == NULL || unpack_filename (path, string, len) || + access (path, mode) < 0) + return no; + + return yes; +} + + +/* inquire_read()-- Given a fortran string, determine if the file is + * suitable for READ access. */ + +const char * +inquire_read (const char *string, int len) +{ + return inquire_access (string, len, R_OK); +} + + +/* inquire_write()-- Given a fortran string, determine if the file is + * suitable for READ access. */ + +const char * +inquire_write (const char *string, int len) +{ + return inquire_access (string, len, W_OK); +} + + +/* inquire_readwrite()-- Given a fortran string, determine if the file is + * suitable for read and write access. */ + +const char * +inquire_readwrite (const char *string, int len) +{ + return inquire_access (string, len, R_OK | W_OK); +} + + +/* file_length()-- Return the file length in bytes, -1 if unknown */ + +gfc_offset +file_length (stream * s) +{ + gfc_offset curr, end; + if (!is_seekable (s)) + return -1; + curr = stell (s); + if (curr == -1) + return curr; + end = sseek (s, 0, SEEK_END); + sseek (s, curr, SEEK_SET); + return end; +} + + +/* is_seekable()-- Return nonzero if the stream is seekable, zero if + * it is not */ + +int +is_seekable (stream *s) +{ + /* By convention, if file_length == -1, the file is not + seekable. */ + return ((unix_stream *) s)->file_length!=-1; +} + + +/* is_special()-- Return nonzero if the stream is not a regular file. */ + +int +is_special (stream *s) +{ + return ((unix_stream *) s)->special_file; +} + + +int +stream_isatty (stream *s) +{ + return isatty (((unix_stream *) s)->fd); +} + +int +stream_ttyname (stream *s __attribute__ ((unused)), + char * buf __attribute__ ((unused)), + size_t buflen __attribute__ ((unused))) +{ +#ifdef HAVE_TTYNAME_R + return ttyname_r (((unix_stream *) s)->fd, buf, buflen); +#elif defined HAVE_TTYNAME + char *p; + size_t plen; + p = ttyname (((unix_stream *) s)->fd); + if (!p) + return errno; + plen = strlen (p); + if (buflen < plen) + plen = buflen; + memcpy (buf, p, plen); + return 0; +#else + return ENOSYS; +#endif +} + + + + +/* How files are stored: This is an operating-system specific issue, + and therefore belongs here. There are three cases to consider. + + Direct Access: + Records are written as block of bytes corresponding to the record + length of the file. This goes for both formatted and unformatted + records. Positioning is done explicitly for each data transfer, + so positioning is not much of an issue. + + Sequential Formatted: + Records are separated by newline characters. The newline character + is prohibited from appearing in a string. If it does, this will be + messed up on the next read. End of file is also the end of a record. + + Sequential Unformatted: + In this case, we are merely copying bytes to and from main storage, + yet we need to keep track of varying record lengths. We adopt + the solution used by f2c. Each record contains a pair of length + markers: + + Length of record n in bytes + Data of record n + Length of record n in bytes + + Length of record n+1 in bytes + Data of record n+1 + Length of record n+1 in bytes + + The length is stored at the end of a record to allow backspacing to the + previous record. Between data transfer statements, the file pointer + is left pointing to the first length of the current record. + + ENDFILE records are never explicitly stored. + +*/ diff --git a/libgfortran/io/unix.h b/libgfortran/io/unix.h new file mode 100644 index 000000000..5e42268e6 --- /dev/null +++ b/libgfortran/io/unix.h @@ -0,0 +1,192 @@ +/* Copyright (C) 2009, 2010 + Free Software Foundation, Inc. + Contributed by Janne Blomqvist + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#ifndef GFOR_UNIX_H +#define GFOR_UNIX_H + +#include "io.h" + + +struct stream +{ + ssize_t (*read) (struct stream *, void *, ssize_t); + ssize_t (*write) (struct stream *, const void *, ssize_t); + gfc_offset (*seek) (struct stream *, gfc_offset, int); + gfc_offset (*tell) (struct stream *); + /* Avoid keyword truncate due to AIX namespace collision. */ + int (*trunc) (struct stream *, gfc_offset); + int (*flush) (struct stream *); + int (*close) (struct stream *); +}; + + +/* Inline functions for doing file I/O given a stream. */ +static inline ssize_t +sread (stream * s, void * buf, ssize_t nbyte) +{ + return s->read (s, buf, nbyte); +} + +static inline ssize_t +swrite (stream * s, const void * buf, ssize_t nbyte) +{ + return s->write (s, buf, nbyte); +} + +static inline gfc_offset +sseek (stream * s, gfc_offset offset, int whence) +{ + return s->seek (s, offset, whence); +} + +static inline gfc_offset +stell (stream * s) +{ + return s->tell (s); +} + +static inline int +struncate (stream * s, gfc_offset length) +{ + return s->trunc (s, length); +} + +static inline int +sflush (stream * s) +{ + return s->flush (s); +} + +static inline int +sclose (stream * s) +{ + return s->close (s); +} + + +extern int compare_files (stream *, stream *); +internal_proto(compare_files); + +extern stream *open_external (st_parameter_open *, unit_flags *); +internal_proto(open_external); + +extern stream *open_internal (char *, int, gfc_offset); +internal_proto(open_internal); + +extern stream *open_internal4 (char *, int, gfc_offset); +internal_proto(open_internal4); + +extern char * mem_alloc_w (stream *, int *); +internal_proto(mem_alloc_w); + +extern char * mem_alloc_r (stream *, int *); +internal_proto(mem_alloc_r); + +extern gfc_char4_t * mem_alloc_w4 (stream *, int *); +internal_proto(mem_alloc_w4); + +extern char * mem_alloc_r4 (stream *, int *); +internal_proto(mem_alloc_r4); + +extern stream *input_stream (void); +internal_proto(input_stream); + +extern stream *output_stream (void); +internal_proto(output_stream); + +extern stream *error_stream (void); +internal_proto(error_stream); + +extern int compare_file_filename (gfc_unit *, const char *, int); +internal_proto(compare_file_filename); + +extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len); +internal_proto(find_file); + +extern int delete_file (gfc_unit *); +internal_proto(delete_file); + +extern int file_exists (const char *file, gfc_charlen_type file_len); +internal_proto(file_exists); + +extern GFC_IO_INT file_size (const char *file, gfc_charlen_type file_len); +internal_proto(file_size); + +extern const char *inquire_sequential (const char *, int); +internal_proto(inquire_sequential); + +extern const char *inquire_direct (const char *, int); +internal_proto(inquire_direct); + +extern const char *inquire_formatted (const char *, int); +internal_proto(inquire_formatted); + +extern const char *inquire_unformatted (const char *, int); +internal_proto(inquire_unformatted); + +extern const char *inquire_read (const char *, int); +internal_proto(inquire_read); + +extern const char *inquire_write (const char *, int); +internal_proto(inquire_write); + +extern const char *inquire_readwrite (const char *, int); +internal_proto(inquire_readwrite); + +extern gfc_offset file_length (stream *); +internal_proto(file_length); + +extern int is_seekable (stream *); +internal_proto(is_seekable); + +extern int is_special (stream *); +internal_proto(is_special); + +extern void flush_if_preconnected (stream *); +internal_proto(flush_if_preconnected); + +extern int flush_sync (stream *); +internal_proto(flush_sync); + +extern int stream_isatty (stream *); +internal_proto(stream_isatty); + +#ifndef TTY_NAME_MAX +#ifdef _POSIX_TTY_NAME_MAX +#define TTY_NAME_MAX _POSIX_TTY_NAME_MAX +#else +/* sysconf(_SC_TTY_NAME_MAX) = 32 which should be enough. */ +#define TTY_NAME_MAX 32 +#endif +#endif + +extern int stream_ttyname (stream *, char *, size_t); +internal_proto(stream_ttyname); + +extern int unpack_filename (char *, const char *, int); +internal_proto(unpack_filename); + + +#endif diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c new file mode 100644 index 000000000..987c3cd88 --- /dev/null +++ b/libgfortran/io/write.c @@ -0,0 +1,1997 @@ +/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Free Software Foundation, Inc. + Contributed by Andy Vaught + Namelist output contributed by Paul Thomas + F2003 I/O support contributed by Jerry DeLisle + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "io.h" +#include "format.h" +#include "unix.h" +#include +#include +#include +#include +#include +#include +#define star_fill(p, n) memset(p, '*', n) + +typedef unsigned char uchar; + +/* Helper functions for character(kind=4) internal units. These are needed + by write_float.def. */ + +static inline void +memset4 (gfc_char4_t *p, gfc_char4_t c, int k) +{ + int j; + for (j = 0; j < k; j++) + *p++ = c; +} + +static inline void +memcpy4 (gfc_char4_t *dest, const char *source, int k) +{ + int j; + + const char *p = source; + for (j = 0; j < k; j++) + *dest++ = (gfc_char4_t) *p++; +} + +/* This include contains the heart and soul of formatted floating point. */ +#include "write_float.def" + +/* Write out default char4. */ + +static void +write_default_char4 (st_parameter_dt *dtp, const gfc_char4_t *source, + int src_len, int w_len) +{ + char *p; + int j, k = 0; + gfc_char4_t c; + uchar d; + + /* Take care of preceding blanks. */ + if (w_len > src_len) + { + k = w_len - src_len; + p = write_block (dtp, k); + if (p == NULL) + return; + if (is_char4_unit (dtp)) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, ' ', k); + } + else + memset (p, ' ', k); + } + + /* Get ready to handle delimiters if needed. */ + switch (dtp->u.p.current_unit->delim_status) + { + case DELIM_APOSTROPHE: + d = '\''; + break; + case DELIM_QUOTE: + d = '"'; + break; + default: + d = ' '; + break; + } + + /* Now process the remaining characters, one at a time. */ + for (j = 0; j < src_len; j++) + { + c = source[j]; + if (is_char4_unit (dtp)) + { + gfc_char4_t *q; + /* Handle delimiters if any. */ + if (c == d && d != ' ') + { + p = write_block (dtp, 2); + if (p == NULL) + return; + q = (gfc_char4_t *) p; + *q++ = c; + } + else + { + p = write_block (dtp, 1); + if (p == NULL) + return; + q = (gfc_char4_t *) p; + } + *q = c; + } + else + { + /* Handle delimiters if any. */ + if (c == d && d != ' ') + { + p = write_block (dtp, 2); + if (p == NULL) + return; + *p++ = (uchar) c; + } + else + { + p = write_block (dtp, 1); + if (p == NULL) + return; + } + *p = c > 255 ? '?' : (uchar) c; + } + } +} + + +/* Write out UTF-8 converted from char4. */ + +static void +write_utf8_char4 (st_parameter_dt *dtp, gfc_char4_t *source, + int src_len, int w_len) +{ + char *p; + int j, k = 0; + gfc_char4_t c; + static const uchar masks[6] = { 0x00, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC }; + static const uchar limits[6] = { 0x80, 0xE0, 0xF0, 0xF8, 0xFC, 0xFE }; + int nbytes; + uchar buf[6], d, *q; + + /* Take care of preceding blanks. */ + if (w_len > src_len) + { + k = w_len - src_len; + p = write_block (dtp, k); + if (p == NULL) + return; + memset (p, ' ', k); + } + + /* Get ready to handle delimiters if needed. */ + switch (dtp->u.p.current_unit->delim_status) + { + case DELIM_APOSTROPHE: + d = '\''; + break; + case DELIM_QUOTE: + d = '"'; + break; + default: + d = ' '; + break; + } + + /* Now process the remaining characters, one at a time. */ + for (j = k; j < src_len; j++) + { + c = source[j]; + if (c < 0x80) + { + /* Handle the delimiters if any. */ + if (c == d && d != ' ') + { + p = write_block (dtp, 2); + if (p == NULL) + return; + *p++ = (uchar) c; + } + else + { + p = write_block (dtp, 1); + if (p == NULL) + return; + } + *p = (uchar) c; + } + else + { + /* Convert to UTF-8 sequence. */ + nbytes = 1; + q = &buf[6]; + + do + { + *--q = ((c & 0x3F) | 0x80); + c >>= 6; + nbytes++; + } + while (c >= 0x3F || (c & limits[nbytes-1])); + + *--q = (c | masks[nbytes-1]); + + p = write_block (dtp, nbytes); + if (p == NULL) + return; + + while (q < &buf[6]) + *p++ = *q++; + } + } +} + + +void +write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len) +{ + int wlen; + char *p; + + wlen = f->u.string.length < 0 + || (f->format == FMT_G && f->u.string.length == 0) + ? len : f->u.string.length; + +#ifdef HAVE_CRLF + /* If this is formatted STREAM IO convert any embedded line feed characters + to CR_LF on systems that use that sequence for newlines. See F2003 + Standard sections 10.6.3 and 9.9 for further information. */ + if (is_stream_io (dtp)) + { + const char crlf[] = "\r\n"; + int i, q, bytes; + q = bytes = 0; + + /* Write out any padding if needed. */ + if (len < wlen) + { + p = write_block (dtp, wlen - len); + if (p == NULL) + return; + memset (p, ' ', wlen - len); + } + + /* Scan the source string looking for '\n' and convert it if found. */ + for (i = 0; i < wlen; i++) + { + if (source[i] == '\n') + { + /* Write out the previously scanned characters in the string. */ + if (bytes > 0) + { + p = write_block (dtp, bytes); + if (p == NULL) + return; + memcpy (p, &source[q], bytes); + q += bytes; + bytes = 0; + } + + /* Write out the CR_LF sequence. */ + q++; + p = write_block (dtp, 2); + if (p == NULL) + return; + memcpy (p, crlf, 2); + } + else + bytes++; + } + + /* Write out any remaining bytes if no LF was found. */ + if (bytes > 0) + { + p = write_block (dtp, bytes); + if (p == NULL) + return; + memcpy (p, &source[q], bytes); + } + } + else + { +#endif + p = write_block (dtp, wlen); + if (p == NULL) + return; + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + if (wlen < len) + memcpy4 (p4, source, wlen); + else + { + memset4 (p4, ' ', wlen - len); + memcpy4 (p4 + wlen - len, source, len); + } + return; + } + + if (wlen < len) + memcpy (p, source, wlen); + else + { + memset (p, ' ', wlen - len); + memcpy (p + wlen - len, source, len); + } +#ifdef HAVE_CRLF + } +#endif +} + + +/* The primary difference between write_a_char4 and write_a is that we have to + deal with writing from the first byte of the 4-byte character and pay + attention to the most significant bytes. For ENCODING="default" write the + lowest significant byte. If the 3 most significant bytes contain + non-zero values, emit a '?'. For ENCODING="utf-8", convert the UCS-32 value + to the UTF-8 encoded string before writing out. */ + +void +write_a_char4 (st_parameter_dt *dtp, const fnode *f, const char *source, int len) +{ + int wlen; + gfc_char4_t *q; + + wlen = f->u.string.length < 0 + || (f->format == FMT_G && f->u.string.length == 0) + ? len : f->u.string.length; + + q = (gfc_char4_t *) source; +#ifdef HAVE_CRLF + /* If this is formatted STREAM IO convert any embedded line feed characters + to CR_LF on systems that use that sequence for newlines. See F2003 + Standard sections 10.6.3 and 9.9 for further information. */ + if (is_stream_io (dtp)) + { + const gfc_char4_t crlf[] = {0x000d,0x000a}; + int i, bytes; + gfc_char4_t *qq; + bytes = 0; + + /* Write out any padding if needed. */ + if (len < wlen) + { + char *p; + p = write_block (dtp, wlen - len); + if (p == NULL) + return; + memset (p, ' ', wlen - len); + } + + /* Scan the source string looking for '\n' and convert it if found. */ + qq = (gfc_char4_t *) source; + for (i = 0; i < wlen; i++) + { + if (qq[i] == '\n') + { + /* Write out the previously scanned characters in the string. */ + if (bytes > 0) + { + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + write_utf8_char4 (dtp, q, bytes, 0); + else + write_default_char4 (dtp, q, bytes, 0); + bytes = 0; + } + + /* Write out the CR_LF sequence. */ + write_default_char4 (dtp, crlf, 2, 0); + } + else + bytes++; + } + + /* Write out any remaining bytes if no LF was found. */ + if (bytes > 0) + { + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + write_utf8_char4 (dtp, q, bytes, 0); + else + write_default_char4 (dtp, q, bytes, 0); + } + } + else + { +#endif + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + write_utf8_char4 (dtp, q, len, wlen); + else + write_default_char4 (dtp, q, len, wlen); +#ifdef HAVE_CRLF + } +#endif +} + + +static GFC_INTEGER_LARGEST +extract_int (const void *p, int len) +{ + GFC_INTEGER_LARGEST i = 0; + + if (p == NULL) + return i; + + switch (len) + { + case 1: + { + GFC_INTEGER_1 tmp; + memcpy ((void *) &tmp, p, len); + i = tmp; + } + break; + case 2: + { + GFC_INTEGER_2 tmp; + memcpy ((void *) &tmp, p, len); + i = tmp; + } + break; + case 4: + { + GFC_INTEGER_4 tmp; + memcpy ((void *) &tmp, p, len); + i = tmp; + } + break; + case 8: + { + GFC_INTEGER_8 tmp; + memcpy ((void *) &tmp, p, len); + i = tmp; + } + break; +#ifdef HAVE_GFC_INTEGER_16 + case 16: + { + GFC_INTEGER_16 tmp; + memcpy ((void *) &tmp, p, len); + i = tmp; + } + break; +#endif + default: + internal_error (NULL, "bad integer kind"); + } + + return i; +} + +static GFC_UINTEGER_LARGEST +extract_uint (const void *p, int len) +{ + GFC_UINTEGER_LARGEST i = 0; + + if (p == NULL) + return i; + + switch (len) + { + case 1: + { + GFC_INTEGER_1 tmp; + memcpy ((void *) &tmp, p, len); + i = (GFC_UINTEGER_1) tmp; + } + break; + case 2: + { + GFC_INTEGER_2 tmp; + memcpy ((void *) &tmp, p, len); + i = (GFC_UINTEGER_2) tmp; + } + break; + case 4: + { + GFC_INTEGER_4 tmp; + memcpy ((void *) &tmp, p, len); + i = (GFC_UINTEGER_4) tmp; + } + break; + case 8: + { + GFC_INTEGER_8 tmp; + memcpy ((void *) &tmp, p, len); + i = (GFC_UINTEGER_8) tmp; + } + break; +#ifdef HAVE_GFC_INTEGER_16 + case 10: + case 16: + { + GFC_INTEGER_16 tmp = 0; + memcpy ((void *) &tmp, p, len); + i = (GFC_UINTEGER_16) tmp; + } + break; +#endif + default: + internal_error (NULL, "bad integer kind"); + } + + return i; +} + + +void +write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len) +{ + char *p; + int wlen; + GFC_INTEGER_LARGEST n; + + wlen = (f->format == FMT_G && f->u.w == 0) ? 1 : f->u.w; + + p = write_block (dtp, wlen); + if (p == NULL) + return; + + n = extract_int (source, len); + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, ' ', wlen -1); + p4[wlen - 1] = (n) ? 'T' : 'F'; + return; + } + + memset (p, ' ', wlen -1); + p[wlen - 1] = (n) ? 'T' : 'F'; +} + + +static void +write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n) +{ + int w, m, digits, nzero, nblank; + char *p; + + w = f->u.integer.w; + m = f->u.integer.m; + + /* Special case: */ + + if (m == 0 && n == 0) + { + if (w == 0) + w = 1; + + p = write_block (dtp, w); + if (p == NULL) + return; + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, ' ', w); + } + else + memset (p, ' ', w); + goto done; + } + + digits = strlen (q); + + /* Select a width if none was specified. The idea here is to always + print something. */ + + if (w == 0) + w = ((digits < m) ? m : digits); + + p = write_block (dtp, w); + if (p == NULL) + return; + + nzero = 0; + if (digits < m) + nzero = m - digits; + + /* See if things will work. */ + + nblank = w - (nzero + digits); + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + if (nblank < 0) + { + memset4 (p4, '*', w); + return; + } + + if (!dtp->u.p.no_leading_blank) + { + memset4 (p4, ' ', nblank); + q += nblank; + memset4 (p4, '0', nzero); + q += nzero; + memcpy4 (p4, q, digits); + } + else + { + memset4 (p4, '0', nzero); + q += nzero; + memcpy4 (p4, q, digits); + q += digits; + memset4 (p4, ' ', nblank); + dtp->u.p.no_leading_blank = 0; + } + return; + } + + if (nblank < 0) + { + star_fill (p, w); + goto done; + } + + if (!dtp->u.p.no_leading_blank) + { + memset (p, ' ', nblank); + p += nblank; + memset (p, '0', nzero); + p += nzero; + memcpy (p, q, digits); + } + else + { + memset (p, '0', nzero); + p += nzero; + memcpy (p, q, digits); + p += digits; + memset (p, ' ', nblank); + dtp->u.p.no_leading_blank = 0; + } + + done: + return; +} + +static void +write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, + int len, + const char *(*conv) (GFC_INTEGER_LARGEST, char *, size_t)) +{ + GFC_INTEGER_LARGEST n = 0; + int w, m, digits, nsign, nzero, nblank; + char *p; + const char *q; + sign_t sign; + char itoa_buf[GFC_BTOA_BUF_SIZE]; + + w = f->u.integer.w; + m = f->format == FMT_G ? -1 : f->u.integer.m; + + n = extract_int (source, len); + + /* Special case: */ + if (m == 0 && n == 0) + { + if (w == 0) + w = 1; + + p = write_block (dtp, w); + if (p == NULL) + return; + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, ' ', w); + } + else + memset (p, ' ', w); + goto done; + } + + sign = calculate_sign (dtp, n < 0); + if (n < 0) + n = -n; + nsign = sign == S_NONE ? 0 : 1; + + /* conv calls itoa which sets the negative sign needed + by write_integer. The sign '+' or '-' is set below based on sign + calculated above, so we just point past the sign in the string + before proceeding to avoid double signs in corner cases. + (see PR38504) */ + q = conv (n, itoa_buf, sizeof (itoa_buf)); + if (*q == '-') + q++; + + digits = strlen (q); + + /* Select a width if none was specified. The idea here is to always + print something. */ + + if (w == 0) + w = ((digits < m) ? m : digits) + nsign; + + p = write_block (dtp, w); + if (p == NULL) + return; + + nzero = 0; + if (digits < m) + nzero = m - digits; + + /* See if things will work. */ + + nblank = w - (nsign + nzero + digits); + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t * p4 = (gfc_char4_t *) p; + if (nblank < 0) + { + memset4 (p4, '*', w); + goto done; + } + + memset4 (p4, ' ', nblank); + p4 += nblank; + + switch (sign) + { + case S_PLUS: + *p4++ = '+'; + break; + case S_MINUS: + *p4++ = '-'; + break; + case S_NONE: + break; + } + + memset4 (p4, '0', nzero); + p4 += nzero; + + memcpy4 (p4, q, digits); + return; + } + + if (nblank < 0) + { + star_fill (p, w); + goto done; + } + + memset (p, ' ', nblank); + p += nblank; + + switch (sign) + { + case S_PLUS: + *p++ = '+'; + break; + case S_MINUS: + *p++ = '-'; + break; + case S_NONE: + break; + } + + memset (p, '0', nzero); + p += nzero; + + memcpy (p, q, digits); + + done: + return; +} + + +/* Convert unsigned octal to ascii. */ + +static const char * +otoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) +{ + char *p; + + assert (len >= GFC_OTOA_BUF_SIZE); + + if (n == 0) + return "0"; + + p = buffer + GFC_OTOA_BUF_SIZE - 1; + *p = '\0'; + + while (n != 0) + { + *--p = '0' + (n & 7); + n >>= 3; + } + + return p; +} + + +/* Convert unsigned binary to ascii. */ + +static const char * +btoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) +{ + char *p; + + assert (len >= GFC_BTOA_BUF_SIZE); + + if (n == 0) + return "0"; + + p = buffer + GFC_BTOA_BUF_SIZE - 1; + *p = '\0'; + + while (n != 0) + { + *--p = '0' + (n & 1); + n >>= 1; + } + + return p; +} + +/* The following three functions, btoa_big, otoa_big, and ztoa_big, are needed + to convert large reals with kind sizes that exceed the largest integer type + available on certain platforms. In these cases, byte by byte conversion is + performed. Endianess is taken into account. */ + +/* Conversion to binary. */ + +static const char * +btoa_big (const char *s, char *buffer, int len, GFC_UINTEGER_LARGEST *n) +{ + char *q; + int i, j; + + q = buffer; + if (big_endian) + { + const char *p = s; + for (i = 0; i < len; i++) + { + char c = *p; + + /* Test for zero. Needed by write_boz later. */ + if (*p != 0) + *n = 1; + + for (j = 0; j < 8; j++) + { + *q++ = (c & 128) ? '1' : '0'; + c <<= 1; + } + p++; + } + } + else + { + const char *p = s + len - 1; + for (i = 0; i < len; i++) + { + char c = *p; + + /* Test for zero. Needed by write_boz later. */ + if (*p != 0) + *n = 1; + + for (j = 0; j < 8; j++) + { + *q++ = (c & 128) ? '1' : '0'; + c <<= 1; + } + p--; + } + } + + *q = '\0'; + + if (*n == 0) + return "0"; + + /* Move past any leading zeros. */ + while (*buffer == '0') + buffer++; + + return buffer; + +} + +/* Conversion to octal. */ + +static const char * +otoa_big (const char *s, char *buffer, int len, GFC_UINTEGER_LARGEST *n) +{ + char *q; + int i, j, k; + uint8_t octet; + + q = buffer + GFC_OTOA_BUF_SIZE - 1; + *q = '\0'; + i = k = octet = 0; + + if (big_endian) + { + const char *p = s + len - 1; + char c = *p; + while (i < len) + { + /* Test for zero. Needed by write_boz later. */ + if (*p != 0) + *n = 1; + + for (j = 0; j < 3 && i < len; j++) + { + octet |= (c & 1) << j; + c >>= 1; + if (++k > 7) + { + i++; + k = 0; + c = *--p; + } + } + *--q = '0' + octet; + octet = 0; + } + } + else + { + const char *p = s; + char c = *p; + while (i < len) + { + /* Test for zero. Needed by write_boz later. */ + if (*p != 0) + *n = 1; + + for (j = 0; j < 3 && i < len; j++) + { + octet |= (c & 1) << j; + c >>= 1; + if (++k > 7) + { + i++; + k = 0; + c = *++p; + } + } + *--q = '0' + octet; + octet = 0; + } + } + + if (*n == 0) + return "0"; + + /* Move past any leading zeros. */ + while (*q == '0') + q++; + + return q; +} + +/* Conversion to hexidecimal. */ + +static const char * +ztoa_big (const char *s, char *buffer, int len, GFC_UINTEGER_LARGEST *n) +{ + static char a[16] = {'0', '1', '2', '3', '4', '5', '6', '7', + '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'}; + + char *q; + uint8_t h, l; + int i; + + q = buffer; + + if (big_endian) + { + const char *p = s; + for (i = 0; i < len; i++) + { + /* Test for zero. Needed by write_boz later. */ + if (*p != 0) + *n = 1; + + h = (*p >> 4) & 0x0F; + l = *p++ & 0x0F; + *q++ = a[h]; + *q++ = a[l]; + } + } + else + { + const char *p = s + len - 1; + for (i = 0; i < len; i++) + { + /* Test for zero. Needed by write_boz later. */ + if (*p != 0) + *n = 1; + + h = (*p >> 4) & 0x0F; + l = *p-- & 0x0F; + *q++ = a[h]; + *q++ = a[l]; + } + } + + *q = '\0'; + + if (*n == 0) + return "0"; + + /* Move past any leading zeros. */ + while (*buffer == '0') + buffer++; + + return buffer; +} + +/* gfc_itoa()-- Integer to decimal conversion. + The itoa function is a widespread non-standard extension to standard + C, often declared in . Even though the itoa defined here + is a static function we take care not to conflict with any prior + non-static declaration. Hence the 'gfc_' prefix, which is normally + reserved for functions with external linkage. */ + +static const char * +gfc_itoa (GFC_INTEGER_LARGEST n, char *buffer, size_t len) +{ + int negative; + char *p; + GFC_UINTEGER_LARGEST t; + + assert (len >= GFC_ITOA_BUF_SIZE); + + if (n == 0) + return "0"; + + negative = 0; + t = n; + if (n < 0) + { + negative = 1; + t = -n; /*must use unsigned to protect from overflow*/ + } + + p = buffer + GFC_ITOA_BUF_SIZE - 1; + *p = '\0'; + + while (t != 0) + { + *--p = '0' + (t % 10); + t /= 10; + } + + if (negative) + *--p = '-'; + return p; +} + + +void +write_i (st_parameter_dt *dtp, const fnode *f, const char *p, int len) +{ + write_decimal (dtp, f, p, len, (void *) gfc_itoa); +} + + +void +write_b (st_parameter_dt *dtp, const fnode *f, const char *source, int len) +{ + const char *p; + char itoa_buf[GFC_BTOA_BUF_SIZE]; + GFC_UINTEGER_LARGEST n = 0; + + if (len > (int) sizeof (GFC_UINTEGER_LARGEST)) + { + p = btoa_big (source, itoa_buf, len, &n); + write_boz (dtp, f, p, n); + } + else + { + n = extract_uint (source, len); + p = btoa (n, itoa_buf, sizeof (itoa_buf)); + write_boz (dtp, f, p, n); + } +} + + +void +write_o (st_parameter_dt *dtp, const fnode *f, const char *source, int len) +{ + const char *p; + char itoa_buf[GFC_OTOA_BUF_SIZE]; + GFC_UINTEGER_LARGEST n = 0; + + if (len > (int) sizeof (GFC_UINTEGER_LARGEST)) + { + p = otoa_big (source, itoa_buf, len, &n); + write_boz (dtp, f, p, n); + } + else + { + n = extract_uint (source, len); + p = otoa (n, itoa_buf, sizeof (itoa_buf)); + write_boz (dtp, f, p, n); + } +} + +void +write_z (st_parameter_dt *dtp, const fnode *f, const char *source, int len) +{ + const char *p; + char itoa_buf[GFC_XTOA_BUF_SIZE]; + GFC_UINTEGER_LARGEST n = 0; + + if (len > (int) sizeof (GFC_UINTEGER_LARGEST)) + { + p = ztoa_big (source, itoa_buf, len, &n); + write_boz (dtp, f, p, n); + } + else + { + n = extract_uint (source, len); + p = gfc_xtoa (n, itoa_buf, sizeof (itoa_buf)); + write_boz (dtp, f, p, n); + } +} + + +void +write_d (st_parameter_dt *dtp, const fnode *f, const char *p, int len) +{ + write_float (dtp, f, p, len); +} + + +void +write_e (st_parameter_dt *dtp, const fnode *f, const char *p, int len) +{ + write_float (dtp, f, p, len); +} + + +void +write_f (st_parameter_dt *dtp, const fnode *f, const char *p, int len) +{ + write_float (dtp, f, p, len); +} + + +void +write_en (st_parameter_dt *dtp, const fnode *f, const char *p, int len) +{ + write_float (dtp, f, p, len); +} + + +void +write_es (st_parameter_dt *dtp, const fnode *f, const char *p, int len) +{ + write_float (dtp, f, p, len); +} + + +/* Take care of the X/TR descriptor. */ + +void +write_x (st_parameter_dt *dtp, int len, int nspaces) +{ + char *p; + + p = write_block (dtp, len); + if (p == NULL) + return; + if (nspaces > 0 && len - nspaces >= 0) + { + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (&p4[len - nspaces], ' ', nspaces); + } + else + memset (&p[len - nspaces], ' ', nspaces); + } +} + + +/* List-directed writing. */ + + +/* Write a single character to the output. Returns nonzero if + something goes wrong. */ + +static int +write_char (st_parameter_dt *dtp, int c) +{ + char *p; + + p = write_block (dtp, 1); + if (p == NULL) + return 1; + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + *p4 = c; + return 0; + } + + *p = (uchar) c; + + return 0; +} + + +/* Write a list-directed logical value. */ + +static void +write_logical (st_parameter_dt *dtp, const char *source, int length) +{ + write_char (dtp, extract_int (source, length) ? 'T' : 'F'); +} + + +/* Write a list-directed integer value. */ + +static void +write_integer (st_parameter_dt *dtp, const char *source, int length) +{ + char *p; + const char *q; + int digits; + int width; + char itoa_buf[GFC_ITOA_BUF_SIZE]; + + q = gfc_itoa (extract_int (source, length), itoa_buf, sizeof (itoa_buf)); + + switch (length) + { + case 1: + width = 4; + break; + + case 2: + width = 6; + break; + + case 4: + width = 11; + break; + + case 8: + width = 20; + break; + + default: + width = 0; + break; + } + + digits = strlen (q); + + if (width < digits) + width = digits; + p = write_block (dtp, width); + if (p == NULL) + return; + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + if (dtp->u.p.no_leading_blank) + { + memcpy4 (p4, q, digits); + memset4 (p4 + digits, ' ', width - digits); + } + else + { + memset4 (p4, ' ', width - digits); + memcpy4 (p4 + width - digits, q, digits); + } + return; + } + + if (dtp->u.p.no_leading_blank) + { + memcpy (p, q, digits); + memset (p + digits, ' ', width - digits); + } + else + { + memset (p, ' ', width - digits); + memcpy (p + width - digits, q, digits); + } +} + + +/* Write a list-directed string. We have to worry about delimiting + the strings if the file has been opened in that mode. */ + +static void +write_character (st_parameter_dt *dtp, const char *source, int kind, int length) +{ + int i, extra; + char *p, d; + + switch (dtp->u.p.current_unit->delim_status) + { + case DELIM_APOSTROPHE: + d = '\''; + break; + case DELIM_QUOTE: + d = '"'; + break; + default: + d = ' '; + break; + } + + if (kind == 1) + { + if (d == ' ') + extra = 0; + else + { + extra = 2; + + for (i = 0; i < length; i++) + if (source[i] == d) + extra++; + } + + p = write_block (dtp, length + extra); + if (p == NULL) + return; + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t d4 = (gfc_char4_t) d; + gfc_char4_t *p4 = (gfc_char4_t *) p; + + if (d4 == ' ') + memcpy4 (p4, source, length); + else + { + *p4++ = d4; + + for (i = 0; i < length; i++) + { + *p4++ = (gfc_char4_t) source[i]; + if (source[i] == d) + *p4++ = d4; + } + + *p4 = d4; + } + return; + } + + if (d == ' ') + memcpy (p, source, length); + else + { + *p++ = d; + + for (i = 0; i < length; i++) + { + *p++ = source[i]; + if (source[i] == d) + *p++ = d; + } + + *p = d; + } + } + else + { + if (d == ' ') + { + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + write_utf8_char4 (dtp, (gfc_char4_t *) source, length, 0); + else + write_default_char4 (dtp, (gfc_char4_t *) source, length, 0); + } + else + { + p = write_block (dtp, 1); + *p = d; + + if (dtp->u.p.current_unit->flags.encoding == ENCODING_UTF8) + write_utf8_char4 (dtp, (gfc_char4_t *) source, length, 0); + else + write_default_char4 (dtp, (gfc_char4_t *) source, length, 0); + + p = write_block (dtp, 1); + *p = d; + } + } +} + + +/* Set an fnode to default format. */ + +static void +set_fnode_default (st_parameter_dt *dtp, fnode *f, int length) +{ + f->format = FMT_G; + switch (length) + { + case 4: + f->u.real.w = 15; + f->u.real.d = 8; + f->u.real.e = 2; + break; + case 8: + f->u.real.w = 25; + f->u.real.d = 17; + f->u.real.e = 3; + break; + case 10: + f->u.real.w = 29; + f->u.real.d = 20; + f->u.real.e = 4; + break; + case 16: + f->u.real.w = 44; + f->u.real.d = 35; + f->u.real.e = 4; + break; + default: + internal_error (&dtp->common, "bad real kind"); + break; + } +} +/* Output a real number with default format. + This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8), + 1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16). */ +// FX -- FIXME: should we change the default format for __float128-real(16)? + +void +write_real (st_parameter_dt *dtp, const char *source, int length) +{ + fnode f ; + int org_scale = dtp->u.p.scale_factor; + dtp->u.p.scale_factor = 1; + set_fnode_default (dtp, &f, length); + write_float (dtp, &f, source , length); + dtp->u.p.scale_factor = org_scale; +} + + +void +write_real_g0 (st_parameter_dt *dtp, const char *source, int length, int d) +{ + fnode f ; + set_fnode_default (dtp, &f, length); + if (d > 0) + f.u.real.d = d; + dtp->u.p.g0_no_blanks = 1; + write_float (dtp, &f, source , length); + dtp->u.p.g0_no_blanks = 0; +} + + +static void +write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size) +{ + char semi_comma = + dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';'; + + if (write_char (dtp, '(')) + return; + write_real (dtp, source, kind); + + if (write_char (dtp, semi_comma)) + return; + write_real (dtp, source + size / 2, kind); + + write_char (dtp, ')'); +} + + +/* Write the separator between items. */ + +static void +write_separator (st_parameter_dt *dtp) +{ + char *p; + + p = write_block (dtp, options.separator_len); + if (p == NULL) + return; + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memcpy4 (p4, options.separator, options.separator_len); + } + else + memcpy (p, options.separator, options.separator_len); +} + + +/* Write an item with list formatting. + TODO: handle skipping to the next record correctly, particularly + with strings. */ + +static void +list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, + size_t size) +{ + if (dtp->u.p.current_unit == NULL) + return; + + if (dtp->u.p.first_item) + { + dtp->u.p.first_item = 0; + write_char (dtp, ' '); + } + else + { + if (type != BT_CHARACTER || !dtp->u.p.char_flag || + dtp->u.p.current_unit->delim_status != DELIM_NONE) + write_separator (dtp); + } + + switch (type) + { + case BT_INTEGER: + write_integer (dtp, p, kind); + break; + case BT_LOGICAL: + write_logical (dtp, p, kind); + break; + case BT_CHARACTER: + write_character (dtp, p, kind, size); + break; + case BT_REAL: + write_real (dtp, p, kind); + break; + case BT_COMPLEX: + write_complex (dtp, p, kind, size); + break; + default: + internal_error (&dtp->common, "list_formatted_write(): Bad type"); + } + + dtp->u.p.char_flag = (type == BT_CHARACTER); +} + + +void +list_formatted_write (st_parameter_dt *dtp, bt type, void *p, int kind, + size_t size, size_t nelems) +{ + size_t elem; + char *tmp; + size_t stride = type == BT_CHARACTER ? + size * GFC_SIZE_OF_CHAR_KIND(kind) : size; + + tmp = (char *) p; + + /* Big loop over all the elements. */ + for (elem = 0; elem < nelems; elem++) + { + dtp->u.p.item_count++; + list_formatted_write_scalar (dtp, type, tmp + elem * stride, kind, size); + } +} + +/* NAMELIST OUTPUT + + nml_write_obj writes a namelist object to the output stream. It is called + recursively for derived type components: + obj = is the namelist_info for the current object. + offset = the offset relative to the address held by the object for + derived type arrays. + base = is the namelist_info of the derived type, when obj is a + component. + base_name = the full name for a derived type, including qualifiers + if any. + The returned value is a pointer to the object beyond the last one + accessed, including nested derived types. Notice that the namelist is + a linear linked list of objects, including derived types and their + components. A tree, of sorts, is implied by the compound names of + the derived type components and this is how this function recurses through + the list. */ + +/* A generous estimate of the number of characters needed to print + repeat counts and indices, including commas, asterices and brackets. */ + +#define NML_DIGITS 20 + +static void +namelist_write_newline (st_parameter_dt *dtp) +{ + if (!is_internal_unit (dtp)) + { +#ifdef HAVE_CRLF + write_character (dtp, "\r\n", 1, 2); +#else + write_character (dtp, "\n", 1, 1); +#endif + return; + } + + if (is_array_io (dtp)) + { + gfc_offset record; + int finished; + char *p; + int length = dtp->u.p.current_unit->bytes_left; + + p = write_block (dtp, length); + if (p == NULL) + return; + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, ' ', length); + } + else + memset (p, ' ', length); + + /* Now that the current record has been padded out, + determine where the next record in the array is. */ + record = next_array_record (dtp, dtp->u.p.current_unit->ls, + &finished); + if (finished) + dtp->u.p.current_unit->endfile = AT_ENDFILE; + else + { + /* Now seek to this record */ + record = record * dtp->u.p.current_unit->recl; + + if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0) + { + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); + return; + } + + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + } + } + else + write_character (dtp, " ", 1, 1); +} + + +static namelist_info * +nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, + namelist_info * base, char * base_name) +{ + int rep_ctr; + int num; + int nml_carry; + int len; + index_type obj_size; + index_type nelem; + size_t dim_i; + size_t clen; + index_type elem_ctr; + size_t obj_name_len; + void * p ; + char cup; + char * obj_name; + char * ext_name; + char rep_buff[NML_DIGITS]; + namelist_info * cmp; + namelist_info * retval = obj->next; + size_t base_name_len; + size_t base_var_name_len; + size_t tot_len; + unit_delim tmp_delim; + + /* Set the character to be used to separate values + to a comma or semi-colon. */ + + char semi_comma = + dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';'; + + /* Write namelist variable names in upper case. If a derived type, + nothing is output. If a component, base and base_name are set. */ + + if (obj->type != BT_DERIVED) + { + namelist_write_newline (dtp); + write_character (dtp, " ", 1, 1); + + len = 0; + if (base) + { + len = strlen (base->var_name); + base_name_len = strlen (base_name); + for (dim_i = 0; dim_i < base_name_len; dim_i++) + { + cup = toupper ((int) base_name[dim_i]); + write_character (dtp, &cup, 1, 1); + } + } + clen = strlen (obj->var_name); + for (dim_i = len; dim_i < clen; dim_i++) + { + cup = toupper ((int) obj->var_name[dim_i]); + write_character (dtp, &cup, 1, 1); + } + write_character (dtp, "=", 1, 1); + } + + /* Counts the number of data output on a line, including names. */ + + num = 1; + + len = obj->len; + + switch (obj->type) + { + + case BT_REAL: + obj_size = size_from_real_kind (len); + break; + + case BT_COMPLEX: + obj_size = size_from_complex_kind (len); + break; + + case BT_CHARACTER: + obj_size = obj->string_length; + break; + + default: + obj_size = len; + } + + if (obj->var_rank) + obj_size = obj->size; + + /* Set the index vector and count the number of elements. */ + + nelem = 1; + for (dim_i = 0; dim_i < (size_t) obj->var_rank; dim_i++) + { + obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj, dim_i); + nelem = nelem * GFC_DESCRIPTOR_EXTENT (obj, dim_i); + } + + /* Main loop to output the data held in the object. */ + + rep_ctr = 1; + for (elem_ctr = 0; elem_ctr < nelem; elem_ctr++) + { + + /* Build the pointer to the data value. The offset is passed by + recursive calls to this function for arrays of derived types. + Is NULL otherwise. */ + + p = (void *)(obj->mem_pos + elem_ctr * obj_size); + p += offset; + + /* Check for repeat counts of intrinsic types. */ + + if ((elem_ctr < (nelem - 1)) && + (obj->type != BT_DERIVED) && + !memcmp (p, (void*)(p + obj_size ), obj_size )) + { + rep_ctr++; + } + + /* Execute a repeated output. Note the flag no_leading_blank that + is used in the functions used to output the intrinsic types. */ + + else + { + if (rep_ctr > 1) + { + sprintf(rep_buff, " %d*", rep_ctr); + write_character (dtp, rep_buff, 1, strlen (rep_buff)); + dtp->u.p.no_leading_blank = 1; + } + num++; + + /* Output the data, if an intrinsic type, or recurse into this + routine to treat derived types. */ + + switch (obj->type) + { + + case BT_INTEGER: + write_integer (dtp, p, len); + break; + + case BT_LOGICAL: + write_logical (dtp, p, len); + break; + + case BT_CHARACTER: + tmp_delim = dtp->u.p.current_unit->delim_status; + if (dtp->u.p.nml_delim == '"') + dtp->u.p.current_unit->delim_status = DELIM_QUOTE; + if (dtp->u.p.nml_delim == '\'') + dtp->u.p.current_unit->delim_status = DELIM_APOSTROPHE; + write_character (dtp, p, 1, obj->string_length); + dtp->u.p.current_unit->delim_status = tmp_delim; + break; + + case BT_REAL: + write_real (dtp, p, len); + break; + + case BT_COMPLEX: + dtp->u.p.no_leading_blank = 0; + num++; + write_complex (dtp, p, len, obj_size); + break; + + case BT_DERIVED: + + /* To treat a derived type, we need to build two strings: + ext_name = the name, including qualifiers that prepends + component names in the output - passed to + nml_write_obj. + obj_name = the derived type name with no qualifiers but % + appended. This is used to identify the + components. */ + + /* First ext_name => get length of all possible components */ + + base_name_len = base_name ? strlen (base_name) : 0; + base_var_name_len = base ? strlen (base->var_name) : 0; + ext_name = (char*)get_mem ( base_name_len + + base_var_name_len + + strlen (obj->var_name) + + obj->var_rank * NML_DIGITS + + 1); + + memcpy (ext_name, base_name, base_name_len); + clen = strlen (obj->var_name + base_var_name_len); + memcpy (ext_name + base_name_len, + obj->var_name + base_var_name_len, clen); + + /* Append the qualifier. */ + + tot_len = base_name_len + clen; + for (dim_i = 0; dim_i < (size_t) obj->var_rank; dim_i++) + { + if (!dim_i) + { + ext_name[tot_len] = '('; + tot_len++; + } + sprintf (ext_name + tot_len, "%d", (int) obj->ls[dim_i].idx); + tot_len += strlen (ext_name + tot_len); + ext_name[tot_len] = ((int) dim_i == obj->var_rank - 1) ? ')' : ','; + tot_len++; + } + + ext_name[tot_len] = '\0'; + + /* Now obj_name. */ + + obj_name_len = strlen (obj->var_name) + 1; + obj_name = get_mem (obj_name_len+1); + memcpy (obj_name, obj->var_name, obj_name_len-1); + memcpy (obj_name + obj_name_len-1, "%", 2); + + /* Now loop over the components. Update the component pointer + with the return value from nml_write_obj => this loop jumps + past nested derived types. */ + + for (cmp = obj->next; + cmp && !strncmp (cmp->var_name, obj_name, obj_name_len); + cmp = retval) + { + retval = nml_write_obj (dtp, cmp, + (index_type)(p - obj->mem_pos), + obj, ext_name); + } + + free (obj_name); + free (ext_name); + goto obj_loop; + + default: + internal_error (&dtp->common, "Bad type for namelist write"); + } + + /* Reset the leading blank suppression, write a comma (or semi-colon) + and, if 5 values have been output, write a newline and advance + to column 2. Reset the repeat counter. */ + + dtp->u.p.no_leading_blank = 0; + write_character (dtp, &semi_comma, 1, 1); + if (num > 5) + { + num = 0; + namelist_write_newline (dtp); + write_character (dtp, " ", 1, 1); + } + rep_ctr = 1; + } + + /* Cycle through and increment the index vector. */ + +obj_loop: + + nml_carry = 1; + for (dim_i = 0; nml_carry && (dim_i < (size_t) obj->var_rank); dim_i++) + { + obj->ls[dim_i].idx += nml_carry ; + nml_carry = 0; + if (obj->ls[dim_i].idx > (ssize_t) GFC_DESCRIPTOR_UBOUND(obj,dim_i)) + { + obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i); + nml_carry = 1; + } + } + } + + /* Return a pointer beyond the furthest object accessed. */ + + return retval; +} + + +/* This is the entry function for namelist writes. It outputs the name + of the namelist and iterates through the namelist by calls to + nml_write_obj. The call below has dummys in the arguments used in + the treatment of derived types. */ + +void +namelist_write (st_parameter_dt *dtp) +{ + namelist_info * t1, *t2, *dummy = NULL; + index_type i; + index_type dummy_offset = 0; + char c; + char * dummy_name = NULL; + unit_delim tmp_delim = DELIM_UNSPECIFIED; + + /* Set the delimiter for namelist output. */ + tmp_delim = dtp->u.p.current_unit->delim_status; + + dtp->u.p.nml_delim = tmp_delim == DELIM_APOSTROPHE ? '\'' : '"'; + + /* Temporarily disable namelist delimters. */ + dtp->u.p.current_unit->delim_status = DELIM_NONE; + + write_character (dtp, "&", 1, 1); + + /* Write namelist name in upper case - f95 std. */ + for (i = 0 ;i < dtp->namelist_name_len ;i++ ) + { + c = toupper ((int) dtp->namelist_name[i]); + write_character (dtp, &c, 1 ,1); + } + + if (dtp->u.p.ionml != NULL) + { + t1 = dtp->u.p.ionml; + while (t1 != NULL) + { + t2 = t1; + t1 = nml_write_obj (dtp, t2, dummy_offset, dummy, dummy_name); + } + } + + namelist_write_newline (dtp); + write_character (dtp, " /", 1, 2); + /* Restore the original delimiter. */ + dtp->u.p.current_unit->delim_status = tmp_delim; +} + +#undef NML_DIGITS diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def new file mode 100644 index 000000000..b72cf9f56 --- /dev/null +++ b/libgfortran/io/write_float.def @@ -0,0 +1,1087 @@ +/* Copyright (C) 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. + Contributed by Andy Vaught + Write float code factoring to this file by Jerry DeLisle + F2003 I/O support contributed by Jerry DeLisle + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "config.h" + +typedef enum +{ S_NONE, S_MINUS, S_PLUS } +sign_t; + +/* Given a flag that indicates if a value is negative or not, return a + sign_t that gives the sign that we need to produce. */ + +static sign_t +calculate_sign (st_parameter_dt *dtp, int negative_flag) +{ + sign_t s = S_NONE; + + if (negative_flag) + s = S_MINUS; + else + switch (dtp->u.p.sign_status) + { + case SIGN_SP: /* Show sign. */ + s = S_PLUS; + break; + case SIGN_SS: /* Suppress sign. */ + s = S_NONE; + break; + case SIGN_S: /* Processor defined. */ + case SIGN_UNSPECIFIED: + s = options.optional_plus ? S_PLUS : S_NONE; + break; + } + + return s; +} + + +/* Output a real number according to its format which is FMT_G free. */ + +static try +output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, + int sign_bit, bool zero_flag, int ndigits, int edigits) +{ + char *out; + char *digits; + int e; + char expchar, rchar; + format_token ft; + int w; + int d; + /* Number of digits before the decimal point. */ + int nbefore; + /* Number of zeros after the decimal point. */ + int nzero; + /* Number of digits after the decimal point. */ + int nafter; + /* Number of zeros after the decimal point, whatever the precision. */ + int nzero_real; + int leadzero; + int nblanks; + int i; + sign_t sign; + + ft = f->format; + w = f->u.real.w; + d = f->u.real.d; + + rchar = '5'; + nzero_real = -1; + + /* We should always know the field width and precision. */ + if (d < 0) + internal_error (&dtp->common, "Unspecified precision"); + + sign = calculate_sign (dtp, sign_bit); + + /* The following code checks the given string has punctuation in the correct + places. Uncomment if needed for debugging. + if (d != 0 && ((buffer[2] != '.' && buffer[2] != ',') + || buffer[ndigits + 2] != 'e')) + internal_error (&dtp->common, "printf is broken"); */ + + /* Read the exponent back in. */ + e = atoi (&buffer[ndigits + 3]) + 1; + + /* Make sure zero comes out as 0.0e0. */ + if (zero_flag) + e = 0; + + /* Normalize the fractional component. */ + buffer[2] = buffer[1]; + digits = &buffer[2]; + + /* Figure out where to place the decimal point. */ + switch (ft) + { + case FMT_F: + if (d == 0 && e <= 0 && dtp->u.p.scale_factor == 0) + { + memmove (digits + 1, digits, ndigits - 1); + digits[0] = '0'; + e++; + } + + nbefore = e + dtp->u.p.scale_factor; + if (nbefore < 0) + { + nzero = -nbefore; + nzero_real = nzero; + if (nzero > d) + nzero = d; + nafter = d - nzero; + nbefore = 0; + } + else + { + nzero = 0; + nafter = d; + } + expchar = 0; + break; + + case FMT_E: + case FMT_D: + i = dtp->u.p.scale_factor; + if (d <= 0 && i == 0) + { + generate_error (&dtp->common, LIBERROR_FORMAT, "Precision not " + "greater than zero in format specifier 'E' or 'D'"); + return FAILURE; + } + if (i <= -d || i >= d + 2) + { + generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor " + "out of range in format specifier 'E' or 'D'"); + return FAILURE; + } + + if (!zero_flag) + e -= i; + if (i < 0) + { + nbefore = 0; + nzero = -i; + nafter = d + i; + } + else if (i > 0) + { + nbefore = i; + nzero = 0; + nafter = (d - i) + 1; + } + else /* i == 0 */ + { + nbefore = 0; + nzero = 0; + nafter = d; + } + + if (ft == FMT_E) + expchar = 'E'; + else + expchar = 'D'; + break; + + case FMT_EN: + /* The exponent must be a multiple of three, with 1-3 digits before + the decimal point. */ + if (!zero_flag) + e--; + if (e >= 0) + nbefore = e % 3; + else + { + nbefore = (-e) % 3; + if (nbefore != 0) + nbefore = 3 - nbefore; + } + e -= nbefore; + nbefore++; + nzero = 0; + nafter = d; + expchar = 'E'; + break; + + case FMT_ES: + if (!zero_flag) + e--; + nbefore = 1; + nzero = 0; + nafter = d; + expchar = 'E'; + break; + + default: + /* Should never happen. */ + internal_error (&dtp->common, "Unexpected format token"); + } + + /* Round the value. The value being rounded is an unsigned magnitude. + The ROUND_COMPATIBLE is rounding away from zero when there is a tie. */ + switch (dtp->u.p.current_unit->round_status) + { + case ROUND_ZERO: /* Do nothing and truncation occurs. */ + goto skip; + case ROUND_UP: + if (sign_bit) + goto skip; + rchar = '0'; + break; + case ROUND_DOWN: + if (!sign_bit) + goto skip; + rchar = '0'; + break; + case ROUND_NEAREST: + /* Round compatible unless there is a tie. A tie is a 5 with + all trailing zero's. */ + i = nafter + nbefore; + if (digits[i] == '5') + { + for(i++ ; i < ndigits; i++) + { + if (digits[i] != '0') + goto do_rnd; + } + /* It is a tie so round to even. */ + switch (digits[nafter + nbefore - 1]) + { + case '1': + case '3': + case '5': + case '7': + case '9': + /* If odd, round away from zero to even. */ + break; + default: + /* If even, skip rounding, truncate to even. */ + goto skip; + } + } + /* Fall through. */ + case ROUND_PROCDEFINED: + case ROUND_UNSPECIFIED: + case ROUND_COMPATIBLE: + rchar = '5'; + /* Just fall through and do the actual rounding. */ + } + + do_rnd: + + if (nbefore + nafter == 0) + { + ndigits = 0; + if (nzero_real == d && digits[0] >= rchar) + { + /* We rounded to zero but shouldn't have */ + nzero--; + nafter = 1; + digits[0] = '1'; + ndigits = 1; + } + } + else if (nbefore + nafter < ndigits) + { + ndigits = nbefore + nafter; + i = ndigits; + if (digits[i] >= rchar) + { + /* Propagate the carry. */ + for (i--; i >= 0; i--) + { + if (digits[i] != '9') + { + digits[i]++; + break; + } + digits[i] = '0'; + } + + if (i < 0) + { + /* The carry overflowed. Fortunately we have some spare + space at the start of the buffer. We may discard some + digits, but this is ok because we already know they are + zero. */ + digits--; + digits[0] = '1'; + if (ft == FMT_F) + { + if (nzero > 0) + { + nzero--; + nafter++; + } + else + nbefore++; + } + else if (ft == FMT_EN) + { + nbefore++; + if (nbefore == 4) + { + nbefore = 1; + e += 3; + } + } + else + e++; + } + } + } + + skip: + + /* Calculate the format of the exponent field. */ + if (expchar) + { + edigits = 1; + for (i = abs (e); i >= 10; i /= 10) + edigits++; + + if (f->u.real.e < 0) + { + /* Width not specified. Must be no more than 3 digits. */ + if (e > 999 || e < -999) + edigits = -1; + else + { + edigits = 4; + if (e > 99 || e < -99) + expchar = ' '; + } + } + else + { + /* Exponent width specified, check it is wide enough. */ + if (edigits > f->u.real.e) + edigits = -1; + else + edigits = f->u.real.e + 2; + } + } + else + edigits = 0; + + /* Scan the digits string and count the number of zeros. If we make it + all the way through the loop, we know the value is zero after the + rounding completed above. */ + for (i = 0; i < ndigits; i++) + { + if (digits[i] != '0') + break; + } + + /* To format properly, we need to know if the rounded result is zero and if + so, we set the zero_flag which may have been already set for + actual zero. */ + if (i == ndigits) + { + zero_flag = true; + /* The output is zero, so set the sign according to the sign bit unless + -fno-sign-zero was specified. */ + if (compile_options.sign_zero == 1) + sign = calculate_sign (dtp, sign_bit); + else + sign = calculate_sign (dtp, 0); + } + + /* Pick a field size if none was specified, taking into account small + values that may have been rounded to zero. */ + if (w <= 0) + { + if (zero_flag) + w = d + (sign != S_NONE ? 2 : 1) + (d == 0 ? 1 : 0); + else + { + w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1); + w = w == 1 ? 2 : w; + } + } + + /* Work out how much padding is needed. */ + nblanks = w - (nbefore + nzero + nafter + edigits + 1); + if (sign != S_NONE) + nblanks--; + + if (dtp->u.p.g0_no_blanks) + { + w -= nblanks; + nblanks = 0; + } + + /* Create the ouput buffer. */ + out = write_block (dtp, w); + if (out == NULL) + return FAILURE; + + /* Check the value fits in the specified field width. */ + if (nblanks < 0 || edigits == -1 || w == 1 || (w == 2 && sign != S_NONE)) + { + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *out4 = (gfc_char4_t *) out; + memset4 (out4, '*', w); + return FAILURE; + } + star_fill (out, w); + return FAILURE; + } + + /* See if we have space for a zero before the decimal point. */ + if (nbefore == 0 && nblanks > 0) + { + leadzero = 1; + nblanks--; + } + else + leadzero = 0; + + /* For internal character(kind=4) units, we duplicate the code used for + regular output slightly modified. This needs to be maintained + consistent with the regular code that follows this block. */ + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *out4 = (gfc_char4_t *) out; + /* Pad to full field width. */ + + if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank) + { + memset4 (out4, ' ', nblanks); + out4 += nblanks; + } + + /* Output the initial sign (if any). */ + if (sign == S_PLUS) + *(out4++) = '+'; + else if (sign == S_MINUS) + *(out4++) = '-'; + + /* Output an optional leading zero. */ + if (leadzero) + *(out4++) = '0'; + + /* Output the part before the decimal point, padding with zeros. */ + if (nbefore > 0) + { + if (nbefore > ndigits) + { + i = ndigits; + memcpy4 (out4, digits, i); + ndigits = 0; + while (i < nbefore) + out4[i++] = '0'; + } + else + { + i = nbefore; + memcpy4 (out4, digits, i); + ndigits -= i; + } + + digits += i; + out4 += nbefore; + } + + /* Output the decimal point. */ + *(out4++) = dtp->u.p.current_unit->decimal_status + == DECIMAL_POINT ? '.' : ','; + + /* Output leading zeros after the decimal point. */ + if (nzero > 0) + { + for (i = 0; i < nzero; i++) + *(out4++) = '0'; + } + + /* Output digits after the decimal point, padding with zeros. */ + if (nafter > 0) + { + if (nafter > ndigits) + i = ndigits; + else + i = nafter; + + memcpy4 (out4, digits, i); + while (i < nafter) + out4[i++] = '0'; + + digits += i; + ndigits -= i; + out4 += nafter; + } + + /* Output the exponent. */ + if (expchar) + { + if (expchar != ' ') + { + *(out4++) = expchar; + edigits--; + } +#if HAVE_SNPRINTF + snprintf (buffer, size, "%+0*d", edigits, e); +#else + sprintf (buffer, "%+0*d", edigits, e); +#endif + memcpy4 (out4, buffer, edigits); + } + + if (dtp->u.p.no_leading_blank) + { + out4 += edigits; + memset4 (out4, ' ' , nblanks); + dtp->u.p.no_leading_blank = 0; + } + return SUCCESS; + } /* End of character(kind=4) internal unit code. */ + + /* Pad to full field width. */ + + if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank) + { + memset (out, ' ', nblanks); + out += nblanks; + } + + /* Output the initial sign (if any). */ + if (sign == S_PLUS) + *(out++) = '+'; + else if (sign == S_MINUS) + *(out++) = '-'; + + /* Output an optional leading zero. */ + if (leadzero) + *(out++) = '0'; + + /* Output the part before the decimal point, padding with zeros. */ + if (nbefore > 0) + { + if (nbefore > ndigits) + { + i = ndigits; + memcpy (out, digits, i); + ndigits = 0; + while (i < nbefore) + out[i++] = '0'; + } + else + { + i = nbefore; + memcpy (out, digits, i); + ndigits -= i; + } + + digits += i; + out += nbefore; + } + + /* Output the decimal point. */ + *(out++) = dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? '.' : ','; + + /* Output leading zeros after the decimal point. */ + if (nzero > 0) + { + for (i = 0; i < nzero; i++) + *(out++) = '0'; + } + + /* Output digits after the decimal point, padding with zeros. */ + if (nafter > 0) + { + if (nafter > ndigits) + i = ndigits; + else + i = nafter; + + memcpy (out, digits, i); + while (i < nafter) + out[i++] = '0'; + + digits += i; + ndigits -= i; + out += nafter; + } + + /* Output the exponent. */ + if (expchar) + { + if (expchar != ' ') + { + *(out++) = expchar; + edigits--; + } +#if HAVE_SNPRINTF + snprintf (buffer, size, "%+0*d", edigits, e); +#else + sprintf (buffer, "%+0*d", edigits, e); +#endif + memcpy (out, buffer, edigits); + } + + if (dtp->u.p.no_leading_blank) + { + out += edigits; + memset( out , ' ' , nblanks ); + dtp->u.p.no_leading_blank = 0; + } + +#undef STR +#undef STR1 +#undef MIN_FIELD_WIDTH + return SUCCESS; +} + + +/* Write "Infinite" or "Nan" as appropriate for the given format. */ + +static void +write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit) +{ + char * p, fin; + int nb = 0; + sign_t sign; + int mark; + + if (f->format != FMT_B && f->format != FMT_O && f->format != FMT_Z) + { + sign = calculate_sign (dtp, sign_bit); + mark = (sign == S_PLUS || sign == S_MINUS) ? 8 : 7; + + nb = f->u.real.w; + + /* If the field width is zero, the processor must select a width + not zero. 4 is chosen to allow output of '-Inf' or '+Inf' */ + + if (nb == 0) + { + if (isnan_flag) + nb = 3; + else + nb = (sign == S_PLUS || sign == S_MINUS) ? 4 : 3; + } + p = write_block (dtp, nb); + if (p == NULL) + return; + if (nb < 3) + { + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, '*', nb); + } + else + memset (p, '*', nb); + return; + } + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, ' ', nb); + } + else + memset(p, ' ', nb); + + if (!isnan_flag) + { + if (sign_bit) + { + /* If the sign is negative and the width is 3, there is + insufficient room to output '-Inf', so output asterisks */ + if (nb == 3) + { + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memset4 (p4, '*', nb); + } + else + memset (p, '*', nb); + return; + } + /* The negative sign is mandatory */ + fin = '-'; + } + else + /* The positive sign is optional, but we output it for + consistency */ + fin = '+'; + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + + if (nb > mark) + /* We have room, so output 'Infinity' */ + memcpy4 (p4 + nb - 8, "Infinity", 8); + else + /* For the case of width equals mark, there is not enough room + for the sign and 'Infinity' so we go with 'Inf' */ + memcpy4 (p4 + nb - 3, "Inf", 3); + + if (sign == S_PLUS || sign == S_MINUS) + { + if (nb < 9 && nb > 3) + /* Put the sign in front of Inf */ + p4[nb - 4] = (gfc_char4_t) fin; + else if (nb > 8) + /* Put the sign in front of Infinity */ + p4[nb - 9] = (gfc_char4_t) fin; + } + return; + } + + if (nb > mark) + /* We have room, so output 'Infinity' */ + memcpy(p + nb - 8, "Infinity", 8); + else + /* For the case of width equals 8, there is not enough room + for the sign and 'Infinity' so we go with 'Inf' */ + memcpy(p + nb - 3, "Inf", 3); + + if (sign == S_PLUS || sign == S_MINUS) + { + if (nb < 9 && nb > 3) + p[nb - 4] = fin; /* Put the sign in front of Inf */ + else if (nb > 8) + p[nb - 9] = fin; /* Put the sign in front of Infinity */ + } + } + else + { + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + memcpy4 (p4 + nb - 3, "NaN", 3); + } + else + memcpy(p + nb - 3, "NaN", 3); + } + return; + } +} + + +/* Returns the value of 10**d. */ + +#define CALCULATE_EXP(x) \ +inline static GFC_REAL_ ## x \ +calculate_exp_ ## x (int d)\ +{\ + int i;\ + GFC_REAL_ ## x r = 1.0;\ + for (i = 0; i< (d >= 0 ? d : -d); i++)\ + r *= 10;\ + r = (d >= 0) ? r : 1.0 / r;\ + return r;\ +} + +CALCULATE_EXP(4) + +CALCULATE_EXP(8) + +#ifdef HAVE_GFC_REAL_10 +CALCULATE_EXP(10) +#endif + +#ifdef HAVE_GFC_REAL_16 +CALCULATE_EXP(16) +#endif +#undef CALCULATE_EXP + +/* Generate corresponding I/O format for FMT_G and output. + The rules to translate FMT_G to FMT_E or FMT_F from DEC fortran + LRM (table 11-2, Chapter 11, "I/O Formatting", P11-25) is: + + Data Magnitude Equivalent Conversion + 0< m < 0.1-0.5*10**(-d-1) Ew.d[Ee] + m = 0 F(w-n).(d-1), n' ' + 0.1-0.5*10**(-d-1)<= m < 1-0.5*10**(-d) F(w-n).d, n' ' + 1-0.5*10**(-d)<= m < 10-0.5*10**(-d+1) F(w-n).(d-1), n' ' + 10-0.5*10**(-d+1)<= m < 100-0.5*10**(-d+2) F(w-n).(d-2), n' ' + ................ .......... + 10**(d-1)-0.5*10**(-1)<= m <10**d-0.5 F(w-n).0,n(' ') + m >= 10**d-0.5 Ew.d[Ee] + + notes: for Gw.d , n' ' means 4 blanks + for Gw.dEe, n' ' means e+2 blanks */ + +#define OUTPUT_FLOAT_FMT_G(x) \ +static void \ +output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \ + GFC_REAL_ ## x m, char *buffer, size_t size, \ + int sign_bit, bool zero_flag, int ndigits, int edigits) \ +{ \ + int e = f->u.real.e;\ + int d = f->u.real.d;\ + int w = f->u.real.w;\ + fnode *newf;\ + GFC_REAL_ ## x rexp_d;\ + int low, high, mid;\ + int ubound, lbound;\ + char *p, pad = ' ';\ + int save_scale_factor, nb = 0;\ + try result;\ +\ + save_scale_factor = dtp->u.p.scale_factor;\ + newf = (fnode *) get_mem (sizeof (fnode));\ +\ + rexp_d = calculate_exp_ ## x (-d);\ + if ((m > 0.0 && m < 0.1 - 0.05 * rexp_d) || (rexp_d * (m + 0.5) >= 1.0) ||\ + ((m == 0.0) && !(compile_options.allow_std & GFC_STD_F2003)))\ + { \ + newf->format = FMT_E;\ + newf->u.real.w = w;\ + newf->u.real.d = d;\ + newf->u.real.e = e;\ + nb = 0;\ + goto finish;\ + }\ +\ + mid = 0;\ + low = 0;\ + high = d + 1;\ + lbound = 0;\ + ubound = d + 1;\ +\ + while (low <= high)\ + { \ + GFC_REAL_ ## x temp;\ + mid = (low + high) / 2;\ +\ + temp = (calculate_exp_ ## x (mid - 1) * (1 - 0.5 * rexp_d));\ +\ + if (m < temp)\ + { \ + ubound = mid;\ + if (ubound == lbound + 1)\ + break;\ + high = mid - 1;\ + }\ + else if (m > temp)\ + { \ + lbound = mid;\ + if (ubound == lbound + 1)\ + { \ + mid ++;\ + break;\ + }\ + low = mid + 1;\ + }\ + else\ + {\ + mid++;\ + break;\ + }\ + }\ +\ + if (e > 4)\ + e = 4;\ + if (e < 0)\ + nb = 4;\ + else\ + nb = e + 2;\ +\ + nb = nb >= w ? 0 : nb;\ + newf->format = FMT_F;\ + newf->u.real.w = f->u.real.w - nb;\ +\ + if (m == 0.0)\ + newf->u.real.d = d - 1;\ + else\ + newf->u.real.d = - (mid - d - 1);\ +\ + dtp->u.p.scale_factor = 0;\ +\ + finish:\ + result = output_float (dtp, newf, buffer, size, sign_bit, zero_flag, \ + ndigits, edigits);\ + dtp->u.p.scale_factor = save_scale_factor;\ +\ + free (newf);\ +\ + if (nb > 0 && !dtp->u.p.g0_no_blanks)\ + {\ + p = write_block (dtp, nb);\ + if (p == NULL)\ + return;\ + if (result == FAILURE)\ + pad = '*';\ + if (unlikely (is_char4_unit (dtp)))\ + {\ + gfc_char4_t *p4 = (gfc_char4_t *) p;\ + memset4 (p4, pad, nb);\ + }\ + else\ + memset (p, pad, nb);\ + }\ +}\ + +OUTPUT_FLOAT_FMT_G(4) + +OUTPUT_FLOAT_FMT_G(8) + +#ifdef HAVE_GFC_REAL_10 +OUTPUT_FLOAT_FMT_G(10) +#endif + +#ifdef HAVE_GFC_REAL_16 +OUTPUT_FLOAT_FMT_G(16) +#endif + +#undef OUTPUT_FLOAT_FMT_G + + +/* Define a macro to build code for write_float. */ + + /* Note: Before output_float is called, sprintf is used to print to buffer the + number in the format +D.DDDDe+ddd. For an N digit exponent, this gives us + (MIN_FIELD_WIDTH-5)-N digits after the decimal point, plus another one + before the decimal point. + + # The result will always contain a decimal point, even if no + digits follow it + + - The converted value is to be left adjusted on the field boundary + + + A sign (+ or -) always be placed before a number + + MIN_FIELD_WIDTH minimum field width + + * (ndigits-1) is used as the precision + + e format: [-]d.ddde±dd where there is one digit before the + decimal-point character and the number of digits after it is + equal to the precision. The exponent always contains at least two + digits; if the value is zero, the exponent is 00. */ + +#ifdef HAVE_SNPRINTF + +#define DTOA \ +snprintf (buffer, size, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ + "e", ndigits - 1, tmp); + +#define DTOAL \ +snprintf (buffer, size, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ + "Le", ndigits - 1, tmp); + +#else + +#define DTOA \ +sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ + "e", ndigits - 1, tmp); + +#define DTOAL \ +sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ + "Le", ndigits - 1, tmp); + +#endif + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define DTOAQ \ +__qmath_(quadmath_snprintf) (buffer, sizeof buffer, \ + "%+-#" STR(MIN_FIELD_WIDTH) ".*" \ + "Qe", ndigits - 1, tmp); +#endif + +#define WRITE_FLOAT(x,y)\ +{\ + GFC_REAL_ ## x tmp;\ + tmp = * (GFC_REAL_ ## x *)source;\ + sign_bit = signbit (tmp);\ + if (!isfinite (tmp))\ + { \ + write_infnan (dtp, f, isnan (tmp), sign_bit);\ + return;\ + }\ + tmp = sign_bit ? -tmp : tmp;\ + zero_flag = (tmp == 0.0);\ +\ + DTOA ## y\ +\ + if (f->format != FMT_G)\ + output_float (dtp, f, buffer, size, sign_bit, zero_flag, ndigits, \ + edigits);\ + else \ + output_float_FMT_G_ ## x (dtp, f, tmp, buffer, size, sign_bit, \ + zero_flag, ndigits, edigits);\ +}\ + +/* Output a real number according to its format. */ + +static void +write_float (st_parameter_dt *dtp, const fnode *f, const char *source, int len) +{ + +#if defined(HAVE_GFC_REAL_16) || __LDBL_DIG__ > 18 +# define MIN_FIELD_WIDTH 48 +#else +# define MIN_FIELD_WIDTH 31 +#endif +#define STR(x) STR1(x) +#define STR1(x) #x + + /* This must be large enough to accurately hold any value. */ + char buffer[MIN_FIELD_WIDTH+1]; + int sign_bit, ndigits, edigits; + bool zero_flag; + size_t size; + + size = MIN_FIELD_WIDTH+1; + + /* printf pads blanks for us on the exponent so we just need it big enough + to handle the largest number of exponent digits expected. */ + edigits=4; + + if (f->format == FMT_F || f->format == FMT_EN || f->format == FMT_G + || ((f->format == FMT_D || f->format == FMT_E) + && dtp->u.p.scale_factor != 0)) + { + /* Always convert at full precision to avoid double rounding. */ + ndigits = MIN_FIELD_WIDTH - 4 - edigits; + } + else + { + /* The number of digits is known, so let printf do the rounding. */ + if (f->format == FMT_ES) + ndigits = f->u.real.d + 1; + else + ndigits = f->u.real.d; + if (ndigits > MIN_FIELD_WIDTH - 4 - edigits) + ndigits = MIN_FIELD_WIDTH - 4 - edigits; + } + + switch (len) + { + case 4: + WRITE_FLOAT(4,) + break; + + case 8: + WRITE_FLOAT(8,) + break; + +#ifdef HAVE_GFC_REAL_10 + case 10: + WRITE_FLOAT(10,L) + break; +#endif +#ifdef HAVE_GFC_REAL_16 + case 16: +# ifdef GFC_REAL_16_IS_FLOAT128 + WRITE_FLOAT(16,Q) +# else + WRITE_FLOAT(16,L) +# endif + break; +#endif + default: + internal_error (NULL, "bad real kind"); + } +} diff --git a/libgfortran/kinds-override.h b/libgfortran/kinds-override.h new file mode 100644 index 000000000..952413b97 --- /dev/null +++ b/libgfortran/kinds-override.h @@ -0,0 +1,46 @@ +/* Header used to override things detected by the mk-kinds-h.sh script. + Copyright (C) 2010 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +/* What are the C types corresponding to the real(kind=10) and + real(kind=16) types? We currently rely on the following assumptions: + -- if real(kind=10) exists, i.e. if HAVE_GFC_REAL_10 is defined, + then it is necessarily the "long double" type + -- if real(kind=16) exists, then: + * if HAVE_GFC_REAL_10, real(kind=16) is "__float128" + * otherwise, real(kind=16) is "long double" + To allow to change this in the future, we create the + GFC_REAL_16_IS_FLOAT128 macro that is used throughout libgfortran. */ + +#if defined(HAVE_GFC_REAL_16) +# if defined(HAVE_GFC_REAL_10) +# define GFC_REAL_16_IS_FLOAT128 +# if !defined(HAVE_FLOAT128) +# error "Where has __float128 gone?" +# endif +# else +# define GFC_REAL_16_IS_LONG_DOUBLE +# endif +#endif + diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h new file mode 100644 index 000000000..87d595038 --- /dev/null +++ b/libgfortran/libgfortran.h @@ -0,0 +1,1379 @@ +/* Common declarations for all of libgfortran. + Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, + 2011 + Free Software Foundation, Inc. + Contributed by Paul Brook , and + Andy Vaught + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#ifndef LIBGFOR_H +#define LIBGFOR_H + +/* Ensure that ANSI conform stdio is used. This needs to be set before + any system header file is included. */ +#if defined __MINGW32__ +# define _POSIX 1 +# define gfc_printf gnu_printf +#else +# define gfc_printf __printf__ +#endif + +/* config.h MUST be first because it can affect system headers. */ +#include "config.h" + +#include +#include +#include +#include +#include + +/* If we're support quad-precision floating-point type, include the + header to our support library. */ +#ifdef HAVE_FLOAT128 +# include "quadmath_weak.h" +#endif + +#ifdef __MINGW32__ +extern float __strtof (const char *, char **); +#define gfc_strtof __strtof +extern double __strtod (const char *, char **); +#define gfc_strtod __strtod +extern long double __strtold (const char *, char **); +#define gfc_strtold __strtold +#else +#define gfc_strtof strtof +#define gfc_strtod strtod +#define gfc_strtold strtold +#endif + +#if HAVE_COMPLEX_H +# include +#else +#define complex __complex__ +#endif + +#include "../gcc/fortran/libgfortran.h" + +#include "c99_protos.h" + +#if HAVE_IEEEFP_H +#include +#endif + +#include "gstdint.h" + +#if HAVE_SYS_TYPES_H +#include +#endif + +#ifdef __MINGW32__ +typedef off64_t gfc_offset; +#else +typedef off_t gfc_offset; +#endif + +#ifndef NULL +#define NULL (void *) 0 +#endif + +#ifndef __GNUC__ +#define __attribute__(x) +#define likely(x) (x) +#define unlikely(x) (x) +#else +#define likely(x) __builtin_expect(!!(x), 1) +#define unlikely(x) __builtin_expect(!!(x), 0) +#endif + + +/* We use intptr_t and uintptr_t, which may not be always defined in + system headers. */ + +#ifndef HAVE_INTPTR_T +#if __SIZEOF_POINTER__ == __SIZEOF_LONG__ +#define intptr_t long +#elif __SIZEOF_POINTER__ == __SIZEOF_LONG_LONG__ +#define intptr_t long long +#elif __SIZEOF_POINTER__ == __SIZEOF_INT__ +#define intptr_t int +#elif __SIZEOF_POINTER__ == __SIZEOF_SHORT__ +#define intptr_t short +#else +#error "Pointer type with unexpected size" +#endif +#endif + +#ifndef HAVE_UINTPTR_T +#if __SIZEOF_POINTER__ == __SIZEOF_LONG__ +#define uintptr_t unsigned long +#elif __SIZEOF_POINTER__ == __SIZEOF_LONG_LONG__ +#define uintptr_t unsigned long long +#elif __SIZEOF_POINTER__ == __SIZEOF_INT__ +#define uintptr_t unsigned int +#elif __SIZEOF_POINTER__ == __SIZEOF_SHORT__ +#define uintptr_t unsigned short +#else +#error "Pointer type with unexpected size" +#endif +#endif + + +/* On mingw, work around the buggy Windows snprintf() by using the one + mingw provides, __mingw_snprintf(). We also provide a prototype for + __mingw_snprintf(), because the mingw headers currently don't have one. */ +#if HAVE_MINGW_SNPRINTF +extern int __mingw_snprintf (char *, size_t, const char *, ...) + __attribute__ ((format (gnu_printf, 3, 4))); +#undef snprintf +#define snprintf __mingw_snprintf +#endif + + +/* For a library, a standard prefix is a requirement in order to partition + the namespace. IPREFIX is for symbols intended to be internal to the + library. */ +#define PREFIX(x) _gfortran_ ## x +#define IPREFIX(x) _gfortrani_ ## x + +/* Magic to rename a symbol at the compiler level. You continue to refer + to the symbol as OLD in the source, but it'll be named NEW in the asm. */ +#define sym_rename(old, new) sym_rename1(old, __USER_LABEL_PREFIX__, new) +#define sym_rename1(old, ulp, new) sym_rename2(old, ulp, new) +#define sym_rename2(old, ulp, new) extern __typeof(old) old __asm__(#ulp #new) + +/* There are several classifications of routines: + + (1) Symbols used only within the library, + (2) Symbols to be exported from the library, + (3) Symbols to be exported from the library, but + also used inside the library. + + By telling the compiler about these different classifications we can + tightly control the interface seen by the user, and get better code + from the compiler at the same time. + + One of the following should be used immediately after the declaration + of each symbol: + + internal_proto Marks a symbol used only within the library, + and adds IPREFIX to the assembly-level symbol + name. The later is important for maintaining + the namespace partition for the static library. + + export_proto Marks a symbol to be exported, and adds PREFIX + to the assembly-level symbol name. + + export_proto_np Marks a symbol to be exported without adding PREFIX. + + iexport_proto Marks a function to be exported, but with the + understanding that it can be used inside as well. + + iexport_data_proto Similarly, marks a data symbol to be exported. + Unfortunately, some systems can't play the hidden + symbol renaming trick on data symbols, thanks to + the horribleness of COPY relocations. + + If iexport_proto or iexport_data_proto is used, you must also use + iexport or iexport_data after the *definition* of the symbol. */ + +#if defined(HAVE_ATTRIBUTE_VISIBILITY) +# define internal_proto(x) \ + sym_rename(x, IPREFIX (x)) __attribute__((__visibility__("hidden"))) +#else +# define internal_proto(x) sym_rename(x, IPREFIX(x)) +#endif + +#if defined(HAVE_ATTRIBUTE_VISIBILITY) && defined(HAVE_ATTRIBUTE_ALIAS) +# define export_proto(x) sym_rename(x, PREFIX(x)) +# define export_proto_np(x) extern char swallow_semicolon +# define iexport_proto(x) internal_proto(x) +# define iexport(x) iexport1(x, IPREFIX(x)) +# define iexport1(x,y) iexport2(x,y) +# define iexport2(x,y) \ + extern __typeof(x) PREFIX(x) __attribute__((__alias__(#y))) +#else +# define export_proto(x) sym_rename(x, PREFIX(x)) +# define export_proto_np(x) extern char swallow_semicolon +# define iexport_proto(x) export_proto(x) +# define iexport(x) extern char swallow_semicolon +#endif + +/* TODO: detect the case when we *can* hide the symbol. */ +#define iexport_data_proto(x) export_proto(x) +#define iexport_data(x) extern char swallow_semicolon + +/* The only reliable way to get the offset of a field in a struct + in a system independent way is via this macro. */ +#ifndef offsetof +#define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *) 0)->MEMBER) +#endif + +/* The C99 classification macros isfinite, isinf, isnan, isnormal + and signbit are broken or inconsistent on quite a few targets. + So, we use GCC's builtins instead. + + Another advantage for GCC's builtins for these type-generic macros + is that it handles floating-point types that the system headers + may not support (like __float128). */ + +#undef isnan +#define isnan(x) __builtin_isnan(x) +#undef isfinite +#define isfinite(x) __builtin_isfinite(x) +#undef isinf +#define isinf(x) __builtin_isinf(x) +#undef isnormal +#define isnormal(x) __builtin_isnormal(x) +#undef signbit +#define signbit(x) __builtin_signbit(x) + +/* TODO: find the C99 version of these an move into above ifdef. */ +#define REALPART(z) (__real__(z)) +#define IMAGPART(z) (__imag__(z)) +#define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);} + +#include "kinds.h" + +/* Define the type used for the current record number for large file I/O. + The size must be consistent with the size defined on the compiler side. */ +#ifdef HAVE_GFC_INTEGER_8 +typedef GFC_INTEGER_8 GFC_IO_INT; +#else +#ifdef HAVE_GFC_INTEGER_4 +typedef GFC_INTEGER_4 GFC_IO_INT; +#else +#error "GFC_INTEGER_4 should be available for the library to compile". +#endif +#endif + +/* The following two definitions must be consistent with the types used + by the compiler. */ +/* The type used of array indices, amongst other things. */ +typedef ssize_t index_type; + +/* The type used for the lengths of character variables. */ +typedef GFC_INTEGER_4 gfc_charlen_type; + +/* Definitions of CHARACTER data types: + - CHARACTER(KIND=1) corresponds to the C char type, + - CHARACTER(KIND=4) corresponds to an unsigned 32-bit integer. */ +typedef GFC_UINTEGER_4 gfc_char4_t; + +/* Byte size of character kinds. For the kinds currently supported, it's + simply equal to the kind parameter itself. */ +#define GFC_SIZE_OF_CHAR_KIND(kind) (kind) + +/* This will be 0 on little-endian machines and one on big-endian machines. */ +extern int big_endian; +internal_proto(big_endian); + +#define GFOR_POINTER_TO_L1(p, kind) \ + (big_endian * (kind - 1) + (GFC_LOGICAL_1 *)(p)) + +#define GFC_INTEGER_1_HUGE \ + (GFC_INTEGER_1)((((GFC_UINTEGER_1)1) << 7) - 1) +#define GFC_INTEGER_2_HUGE \ + (GFC_INTEGER_2)((((GFC_UINTEGER_2)1) << 15) - 1) +#define GFC_INTEGER_4_HUGE \ + (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 + +/* M{IN,AX}{LOC,VAL} need also infinities and NaNs if supported. */ + +#ifdef __FLT_HAS_INFINITY__ +# define GFC_REAL_4_INFINITY __builtin_inff () +#endif +#ifdef __DBL_HAS_INFINITY__ +# define GFC_REAL_8_INFINITY __builtin_inf () +#endif +#ifdef __LDBL_HAS_INFINITY__ +# ifdef HAVE_GFC_REAL_10 +# define GFC_REAL_10_INFINITY __builtin_infl () +# endif +# ifdef HAVE_GFC_REAL_16 +# ifdef GFC_REAL_16_IS_LONG_DOUBLE +# define GFC_REAL_16_INFINITY __builtin_infl () +# else +# define GFC_REAL_16_INFINITY __builtin_infq () +# endif +# endif +#endif +#ifdef __FLT_HAS_QUIET_NAN__ +# define GFC_REAL_4_QUIET_NAN __builtin_nanf ("") +#endif +#ifdef __DBL_HAS_QUIET_NAN__ +# define GFC_REAL_8_QUIET_NAN __builtin_nan ("") +#endif +#ifdef __LDBL_HAS_QUIET_NAN__ +# ifdef HAVE_GFC_REAL_10 +# define GFC_REAL_10_QUIET_NAN __builtin_nanl ("") +# endif +# ifdef HAVE_GFC_REAL_16 +# ifdef GFC_REAL_16_IS_LONG_DOUBLE +# define GFC_REAL_16_QUIET_NAN __builtin_nanl ("") +# else +# define GFC_REAL_16_QUIET_NAN nanq ("") +# endif +# endif +#endif + +typedef struct descriptor_dimension +{ + index_type _stride; + index_type _lbound; + index_type _ubound; +} + +descriptor_dimension; + +#define GFC_ARRAY_DESCRIPTOR(r, type) \ +struct {\ + type *data;\ + size_t offset;\ + index_type dtype;\ + descriptor_dimension dim[r];\ +} + +/* Commonly used array descriptor types. */ +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_1) gfc_array_i1; +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_2) gfc_array_i2; +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_1) gfc_array_l1; +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_2) gfc_array_l2; +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_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK) +#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \ + >> GFC_DTYPE_TYPE_SHIFT) +#define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT) +#define GFC_DESCRIPTOR_DATA(desc) ((desc)->data) +#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype) + +#define GFC_DIMENSION_LBOUND(dim) ((dim)._lbound) +#define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound) +#define GFC_DIMENSION_STRIDE(dim) ((dim)._stride) +#define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim)._lbound) +#define GFC_DIMENSION_SET(dim,lb,ub,str) \ + do \ + { \ + (dim)._lbound = lb; \ + (dim)._ubound = ub; \ + (dim)._stride = str; \ + } while (0) + + +#define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i]._lbound) +#define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound) +#define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \ + - (desc)->dim[i]._lbound) +#define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \ + (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) + +#define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride) +#define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \ + (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) + +/* Macros to get both the size and the type with a single masking operation */ + +#define GFC_DTYPE_SIZE_MASK \ + ((~((index_type) 0) >> GFC_DTYPE_SIZE_SHIFT) << GFC_DTYPE_SIZE_SHIFT) +#define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK) + +#define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK) + +#define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_INTEGER_2 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_INTEGER_4 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_INTEGER_8 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT)) +#ifdef HAVE_GFC_INTEGER_16 +#define GFC_DTYPE_INTEGER_16 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT)) +#endif + +#define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_LOGICAL_2 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_LOGICAL_4 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_LOGICAL_8 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT)) +#ifdef HAVE_GFC_LOGICAL_16 +#define GFC_DTYPE_LOGICAL_16 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT)) +#endif + +#define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_REAL_8 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT)) +#ifdef HAVE_GFC_REAL_10 +#define GFC_DTYPE_REAL_10 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT)) +#endif +#ifdef HAVE_GFC_REAL_16 +#define GFC_DTYPE_REAL_16 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT)) +#endif + +#define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_COMPLEX_8 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT)) +#ifdef HAVE_GFC_COMPLEX_10 +#define GFC_DTYPE_COMPLEX_10 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT)) +#endif +#ifdef HAVE_GFC_COMPLEX_16 +#define GFC_DTYPE_COMPLEX_16 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT)) +#endif + +#define GFC_DTYPE_DERIVED_1 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_DERIVED_2 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_DERIVED_4 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT)) +#define GFC_DTYPE_DERIVED_8 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT)) +#ifdef HAVE_GFC_INTEGER_16 +#define GFC_DTYPE_DERIVED_16 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ + | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT)) +#endif + +/* Macros to determine the alignment of pointers. */ + +#define GFC_UNALIGNED_2(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_INTEGER_2) - 1)) +#define GFC_UNALIGNED_4(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_INTEGER_4) - 1)) +#define GFC_UNALIGNED_8(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_INTEGER_8) - 1)) +#ifdef HAVE_GFC_INTEGER_16 +#define GFC_UNALIGNED_16(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_INTEGER_16) - 1)) +#endif + +#define GFC_UNALIGNED_C4(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_COMPLEX_4) - 1)) + +#define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \ + (__alignof__(GFC_COMPLEX_8) - 1)) + +/* Runtime library include. */ +#define stringize(x) expand_macro(x) +#define expand_macro(x) # x + +/* Runtime options structure. */ + +typedef struct +{ + int stdin_unit, stdout_unit, stderr_unit, optional_plus; + int locus; + + int separator_len; + const char *separator; + + int use_stderr, all_unbuffered, unbuffered_preconnected, default_recl; + int fpe, dump_core, backtrace; +} +options_t; + +extern options_t options; +internal_proto(options); + +extern void handler (int); +internal_proto(handler); + + +/* Compile-time options that will influence the library. */ + +typedef struct +{ + int warn_std; + int allow_std; + int pedantic; + int convert; + int dump_core; + int backtrace; + int sign_zero; + size_t record_marker; + int max_subrecord_length; + int bounds_check; + int range_check; +} +compile_options_t; + +extern compile_options_t compile_options; +internal_proto(compile_options); + +extern void init_compile_options (void); +internal_proto(init_compile_options); + +#define GFC_MAX_SUBRECORD_LENGTH 2147483639 /* 2**31 - 9 */ + +/* Structure for statement options. */ + +typedef struct +{ + const char *name; + int value; +} +st_option; + + +/* This is returned by notification_std to know if, given the flags + that were given (-std=, -pedantic) we should issue an error, a warning + or nothing. */ +typedef enum +{ NOTIFICATION_SILENT, NOTIFICATION_WARNING, NOTIFICATION_ERROR } +notification; + +/* This is returned by notify_std and several io functions. */ +typedef enum +{ SUCCESS = 1, FAILURE } +try; + +/* The filename and line number don't go inside the globals structure. + They are set by the rest of the program and must be linked to. */ + +/* Location of the current library call (optional). */ +extern unsigned line; +iexport_data_proto(line); + +extern char *filename; +iexport_data_proto(filename); + +/* Avoid conflicting prototypes of alloca() in system headers by using + GCC's builtin alloca(). */ +#define gfc_alloca(x) __builtin_alloca(x) + + +/* Directory for creating temporary files. Only used when none of the + following environment variables exist: GFORTRAN_TMPDIR, TMP and TEMP. */ +#define DEFAULT_TEMPDIR "/tmp" + +/* The default value of record length for preconnected units is defined + here. This value can be overriden by an environment variable. + Default value is 1 Gb. */ +#define DEFAULT_RECL 1073741824 + + +#define CHARACTER2(name) \ + gfc_charlen_type name ## _len; \ + char * name + +typedef struct st_parameter_common +{ + GFC_INTEGER_4 flags; + GFC_INTEGER_4 unit; + const char *filename; + GFC_INTEGER_4 line; + CHARACTER2 (iomsg); + GFC_INTEGER_4 *iostat; +} +st_parameter_common; + +#undef CHARACTER2 + +#define IOPARM_LIBRETURN_MASK (3 << 0) +#define IOPARM_LIBRETURN_OK (0 << 0) +#define IOPARM_LIBRETURN_ERROR (1 << 0) +#define IOPARM_LIBRETURN_END (2 << 0) +#define IOPARM_LIBRETURN_EOR (3 << 0) +#define IOPARM_ERR (1 << 2) +#define IOPARM_END (1 << 3) +#define IOPARM_EOR (1 << 4) +#define IOPARM_HAS_IOSTAT (1 << 5) +#define IOPARM_HAS_IOMSG (1 << 6) + +#define IOPARM_COMMON_MASK ((1 << 7) - 1) + +#define IOPARM_OPEN_HAS_RECL_IN (1 << 7) +#define IOPARM_OPEN_HAS_FILE (1 << 8) +#define IOPARM_OPEN_HAS_STATUS (1 << 9) +#define IOPARM_OPEN_HAS_ACCESS (1 << 10) +#define IOPARM_OPEN_HAS_FORM (1 << 11) +#define IOPARM_OPEN_HAS_BLANK (1 << 12) +#define IOPARM_OPEN_HAS_POSITION (1 << 13) +#define IOPARM_OPEN_HAS_ACTION (1 << 14) +#define IOPARM_OPEN_HAS_DELIM (1 << 15) +#define IOPARM_OPEN_HAS_PAD (1 << 16) +#define IOPARM_OPEN_HAS_CONVERT (1 << 17) +#define IOPARM_OPEN_HAS_DECIMAL (1 << 18) +#define IOPARM_OPEN_HAS_ENCODING (1 << 19) +#define IOPARM_OPEN_HAS_ROUND (1 << 20) +#define IOPARM_OPEN_HAS_SIGN (1 << 21) +#define IOPARM_OPEN_HAS_ASYNCHRONOUS (1 << 22) +#define IOPARM_OPEN_HAS_NEWUNIT (1 << 23) + +/* library start function and end macro. These can be expanded if needed + in the future. cmp is st_parameter_common *cmp */ + +extern void library_start (st_parameter_common *); +internal_proto(library_start); + +#define library_end() + +/* main.c */ + +extern void stupid_function_name_for_static_linking (void); +internal_proto(stupid_function_name_for_static_linking); + +extern void set_args (int, char **); +iexport_proto(set_args); + +extern void get_args (int *, char ***); +internal_proto(get_args); + +extern void store_exe_path (const char *); +export_proto(store_exe_path); + +extern char * full_exe_path (void); +internal_proto(full_exe_path); + +/* backtrace.c */ + +extern void show_backtrace (void); +internal_proto(show_backtrace); + +/* error.c */ + +#if defined(HAVE_GFC_REAL_16) +#define GFC_LARGEST_BUF (sizeof (GFC_REAL_16)) +#elif defined(HAVE_GFC_INTEGER_16) +#define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST)) +#elif defined(HAVE_GFC_REAL_10) +#define GFC_LARGEST_BUF (sizeof (GFC_REAL_10)) +#else +#define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST)) +#endif + +#define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2) +#define GFC_XTOA_BUF_SIZE (GFC_LARGEST_BUF * 2 + 1) +#define GFC_OTOA_BUF_SIZE (GFC_LARGEST_BUF * 3 + 1) +#define GFC_BTOA_BUF_SIZE (GFC_LARGEST_BUF * 8 + 1) + +extern void sys_exit (int) __attribute__ ((noreturn)); +internal_proto(sys_exit); + +extern const char *gfc_xtoa (GFC_UINTEGER_LARGEST, char *, size_t); +internal_proto(gfc_xtoa); + +extern void os_error (const char *) __attribute__ ((noreturn)); +iexport_proto(os_error); + +extern void show_locus (st_parameter_common *); +internal_proto(show_locus); + +extern void runtime_error (const char *, ...) + __attribute__ ((noreturn, format (gfc_printf, 1, 2))); +iexport_proto(runtime_error); + +extern void runtime_error_at (const char *, const char *, ...) + __attribute__ ((noreturn, format (gfc_printf, 2, 3))); +iexport_proto(runtime_error_at); + +extern void runtime_warning_at (const char *, const char *, ...) + __attribute__ ((format (gfc_printf, 2, 3))); +iexport_proto(runtime_warning_at); + +extern void internal_error (st_parameter_common *, const char *) + __attribute__ ((noreturn)); +internal_proto(internal_error); + +extern const char *translate_error (int); +internal_proto(translate_error); + +extern void generate_error (st_parameter_common *, int, const char *); +iexport_proto(generate_error); + +extern void generate_warning (st_parameter_common *, const char *); +internal_proto(generate_warning); + +extern try notify_std (st_parameter_common *, int, const char *); +internal_proto(notify_std); + +extern notification notification_std(int); +internal_proto(notification_std); + +extern char *gf_strerror (int, char *, size_t); +internal_proto(gf_strerror); + +/* fpu.c */ + +extern void set_fpu (void); +internal_proto(set_fpu); + +/* memory.c */ + +extern void *get_mem (size_t) __attribute__ ((malloc)); +internal_proto(get_mem); + +extern void *internal_malloc_size (size_t) __attribute__ ((malloc)); +internal_proto(internal_malloc_size); + +/* environ.c */ + +extern int check_buffered (int); +internal_proto(check_buffered); + +extern void init_variables (void); +internal_proto(init_variables); + +extern void show_variables (void); +internal_proto(show_variables); + +unit_convert get_unformatted_convert (int); +internal_proto(get_unformatted_convert); + +/* string.c */ + +extern int find_option (st_parameter_common *, const char *, gfc_charlen_type, + const st_option *, const char *); +internal_proto(find_option); + +extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type); +internal_proto(fstrlen); + +extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type); +internal_proto(fstrcpy); + +extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *); +internal_proto(cf_strcpy); + +/* io/intrinsics.c */ + +extern void flush_all_units (void); +internal_proto(flush_all_units); + +/* io.c */ + +extern void init_units (void); +internal_proto(init_units); + +extern void close_units (void); +internal_proto(close_units); + +extern int unit_to_fd (int); +internal_proto(unit_to_fd); + +extern int st_printf (const char *, ...) + __attribute__ ((format (gfc_printf, 1, 2))); +internal_proto(st_printf); + +extern int st_vprintf (const char *, va_list); +internal_proto(st_vprintf); + +extern char * filename_from_unit (int); +internal_proto(filename_from_unit); + +/* stop.c */ + +extern void stop_string (const char *, GFC_INTEGER_4) + __attribute__ ((noreturn)); +export_proto(stop_string); + +/* reshape_packed.c */ + +extern void reshape_packed (char *, index_type, const char *, index_type, + const char *, index_type); +internal_proto(reshape_packed); + +/* Repacking functions. These are called internally by internal_pack + and internal_unpack. */ + +GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *); +internal_proto(internal_pack_1); + +GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *); +internal_proto(internal_pack_2); + +GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *); +internal_proto(internal_pack_4); + +GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *); +internal_proto(internal_pack_8); + +#if defined HAVE_GFC_INTEGER_16 +GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *); +internal_proto(internal_pack_16); +#endif + +GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *); +internal_proto(internal_pack_r4); + +GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *); +internal_proto(internal_pack_r8); + +#if defined HAVE_GFC_REAL_10 +GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *); +internal_proto(internal_pack_r10); +#endif + +#if defined HAVE_GFC_REAL_16 +GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *); +internal_proto(internal_pack_r16); +#endif + +GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *); +internal_proto(internal_pack_c4); + +GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *); +internal_proto(internal_pack_c8); + +#if defined HAVE_GFC_COMPLEX_10 +GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *); +internal_proto(internal_pack_c10); +#endif + +#if defined HAVE_GFC_COMPLEX_16 +GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *); +internal_proto(internal_pack_c16); +#endif + +extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *); +internal_proto(internal_unpack_1); + +extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *); +internal_proto(internal_unpack_2); + +extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *); +internal_proto(internal_unpack_4); + +extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *); +internal_proto(internal_unpack_8); + +#if defined HAVE_GFC_INTEGER_16 +extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *); +internal_proto(internal_unpack_16); +#endif + +extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *); +internal_proto(internal_unpack_r4); + +extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *); +internal_proto(internal_unpack_r8); + +#if defined HAVE_GFC_REAL_10 +extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *); +internal_proto(internal_unpack_r10); +#endif + +#if defined HAVE_GFC_REAL_16 +extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *); +internal_proto(internal_unpack_r16); +#endif + +extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *); +internal_proto(internal_unpack_c4); + +extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *); +internal_proto(internal_unpack_c8); + +#if defined HAVE_GFC_COMPLEX_10 +extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *); +internal_proto(internal_unpack_c10); +#endif + +#if defined HAVE_GFC_COMPLEX_16 +extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *); +internal_proto(internal_unpack_c16); +#endif + +/* Internal auxiliary functions for the pack intrinsic. */ + +extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *, + const gfc_array_l1 *, const gfc_array_i1 *); +internal_proto(pack_i1); + +extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *, + const gfc_array_l1 *, const gfc_array_i2 *); +internal_proto(pack_i2); + +extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *, + const gfc_array_l1 *, const gfc_array_i4 *); +internal_proto(pack_i4); + +extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *, + const gfc_array_l1 *, const gfc_array_i8 *); +internal_proto(pack_i8); + +#ifdef HAVE_GFC_INTEGER_16 +extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *, + const gfc_array_l1 *, const gfc_array_i16 *); +internal_proto(pack_i16); +#endif + +extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *, + const gfc_array_l1 *, const gfc_array_r4 *); +internal_proto(pack_r4); + +extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *, + const gfc_array_l1 *, const gfc_array_r8 *); +internal_proto(pack_r8); + +#ifdef HAVE_GFC_REAL_10 +extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *, + const gfc_array_l1 *, const gfc_array_r10 *); +internal_proto(pack_r10); +#endif + +#ifdef HAVE_GFC_REAL_16 +extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *, + const gfc_array_l1 *, const gfc_array_r16 *); +internal_proto(pack_r16); +#endif + +extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *, + const gfc_array_l1 *, const gfc_array_c4 *); +internal_proto(pack_c4); + +extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *, + const gfc_array_l1 *, const gfc_array_c8 *); +internal_proto(pack_c8); + +#ifdef HAVE_GFC_REAL_10 +extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *, + const gfc_array_l1 *, const gfc_array_c10 *); +internal_proto(pack_c10); +#endif + +#ifdef HAVE_GFC_REAL_16 +extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *, + const gfc_array_l1 *, const gfc_array_c16 *); +internal_proto(pack_c16); +#endif + +/* Internal auxiliary functions for the unpack intrinsic. */ + +extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *, + const gfc_array_l1 *, const GFC_INTEGER_1 *); +internal_proto(unpack0_i1); + +extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *, + const gfc_array_l1 *, const GFC_INTEGER_2 *); +internal_proto(unpack0_i2); + +extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *, + const gfc_array_l1 *, const GFC_INTEGER_4 *); +internal_proto(unpack0_i4); + +extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *, + const gfc_array_l1 *, const GFC_INTEGER_8 *); +internal_proto(unpack0_i8); + +#ifdef HAVE_GFC_INTEGER_16 + +extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *, + const gfc_array_l1 *, const GFC_INTEGER_16 *); +internal_proto(unpack0_i16); + +#endif + +extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *, + const gfc_array_l1 *, const GFC_REAL_4 *); +internal_proto(unpack0_r4); + +extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *, + const gfc_array_l1 *, const GFC_REAL_8 *); +internal_proto(unpack0_r8); + +#ifdef HAVE_GFC_REAL_10 + +extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *, + const gfc_array_l1 *, const GFC_REAL_10 *); +internal_proto(unpack0_r10); + +#endif + +#ifdef HAVE_GFC_REAL_16 + +extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *, + const gfc_array_l1 *, const GFC_REAL_16 *); +internal_proto(unpack0_r16); + +#endif + +extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *, + const gfc_array_l1 *, const GFC_COMPLEX_4 *); +internal_proto(unpack0_c4); + +extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *, + const gfc_array_l1 *, const GFC_COMPLEX_8 *); +internal_proto(unpack0_c8); + +#ifdef HAVE_GFC_COMPLEX_10 + +extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *, + const gfc_array_l1 *mask, const GFC_COMPLEX_10 *); +internal_proto(unpack0_c10); + +#endif + +#ifdef HAVE_GFC_COMPLEX_16 + +extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *, + const gfc_array_l1 *, const GFC_COMPLEX_16 *); +internal_proto(unpack0_c16); + +#endif + +extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *, + const gfc_array_l1 *, const gfc_array_i1 *); +internal_proto(unpack1_i1); + +extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *, + const gfc_array_l1 *, const gfc_array_i2 *); +internal_proto(unpack1_i2); + +extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *, + const gfc_array_l1 *, const gfc_array_i4 *); +internal_proto(unpack1_i4); + +extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *, + const gfc_array_l1 *, const gfc_array_i8 *); +internal_proto(unpack1_i8); + +#ifdef HAVE_GFC_INTEGER_16 +extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *, + const gfc_array_l1 *, const gfc_array_i16 *); +internal_proto(unpack1_i16); +#endif + +extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *, + const gfc_array_l1 *, const gfc_array_r4 *); +internal_proto(unpack1_r4); + +extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *, + const gfc_array_l1 *, const gfc_array_r8 *); +internal_proto(unpack1_r8); + +#ifdef HAVE_GFC_REAL_10 +extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *, + const gfc_array_l1 *, const gfc_array_r10 *); +internal_proto(unpack1_r10); +#endif + +#ifdef HAVE_GFC_REAL_16 +extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *, + const gfc_array_l1 *, const gfc_array_r16 *); +internal_proto(unpack1_r16); +#endif + +extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *, + const gfc_array_l1 *, const gfc_array_c4 *); +internal_proto(unpack1_c4); + +extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *, + const gfc_array_l1 *, const gfc_array_c8 *); +internal_proto(unpack1_c8); + +#ifdef HAVE_GFC_COMPLEX_10 +extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *, + const gfc_array_l1 *, const gfc_array_c10 *); +internal_proto(unpack1_c10); +#endif + +#ifdef HAVE_GFC_COMPLEX_16 +extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *, + const gfc_array_l1 *, const gfc_array_c16 *); +internal_proto(unpack1_c16); +#endif + +/* Helper functions for spread. */ + +extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *, + const index_type, const index_type); +internal_proto(spread_i1); + +extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *, + const index_type, const index_type); +internal_proto(spread_i2); + +extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *, + const index_type, const index_type); +internal_proto(spread_i4); + +extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *, + const index_type, const index_type); +internal_proto(spread_i8); + +#ifdef HAVE_GFC_INTEGER_16 +extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *, + const index_type, const index_type); +internal_proto(spread_i16); + +#endif + +extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *, + const index_type, const index_type); +internal_proto(spread_r4); + +extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *, + const index_type, const index_type); +internal_proto(spread_r8); + +#ifdef HAVE_GFC_REAL_10 +extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *, + const index_type, const index_type); +internal_proto(spread_r10); + +#endif + +#ifdef HAVE_GFC_REAL_16 +extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *, + const index_type, const index_type); +internal_proto(spread_r16); + +#endif + +extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *, + const index_type, const index_type); +internal_proto(spread_c4); + +extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *, + const index_type, const index_type); +internal_proto(spread_c8); + +#ifdef HAVE_GFC_COMPLEX_10 +extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *, + const index_type, const index_type); +internal_proto(spread_c10); + +#endif + +#ifdef HAVE_GFC_COMPLEX_16 +extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *, + const index_type, const index_type); +internal_proto(spread_c16); + +#endif + +extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *, + const index_type, const index_type); +internal_proto(spread_scalar_i1); + +extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *, + const index_type, const index_type); +internal_proto(spread_scalar_i2); + +extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *, + const index_type, const index_type); +internal_proto(spread_scalar_i4); + +extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *, + const index_type, const index_type); +internal_proto(spread_scalar_i8); + +#ifdef HAVE_GFC_INTEGER_16 +extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *, + const index_type, const index_type); +internal_proto(spread_scalar_i16); + +#endif + +extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *, + const index_type, const index_type); +internal_proto(spread_scalar_r4); + +extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *, + const index_type, const index_type); +internal_proto(spread_scalar_r8); + +#ifdef HAVE_GFC_REAL_10 +extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *, + const index_type, const index_type); +internal_proto(spread_scalar_r10); + +#endif + +#ifdef HAVE_GFC_REAL_16 +extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *, + const index_type, const index_type); +internal_proto(spread_scalar_r16); + +#endif + +extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *, + const index_type, const index_type); +internal_proto(spread_scalar_c4); + +extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *, + const index_type, const index_type); +internal_proto(spread_scalar_c8); + +#ifdef HAVE_GFC_COMPLEX_10 +extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *, + const index_type, const index_type); +internal_proto(spread_scalar_c10); + +#endif + +#ifdef HAVE_GFC_COMPLEX_16 +extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *, + const index_type, const index_type); +internal_proto(spread_scalar_c16); + +#endif + +/* string_intrinsics.c */ + +extern int compare_string (gfc_charlen_type, const char *, + gfc_charlen_type, const char *); +iexport_proto(compare_string); + +extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *, + gfc_charlen_type, const gfc_char4_t *); +iexport_proto(compare_string_char4); + +extern int memcmp_char4 (const void *, const void *, size_t); +internal_proto(memcmp_char4); + + +/* random.c */ + +extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put, + gfc_array_i4 * get); +iexport_proto(random_seed_i4); +extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put, + gfc_array_i8 * get); +iexport_proto(random_seed_i8); + +/* size.c */ + +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t; + +extern index_type size0 (const array_t * array); +iexport_proto(size0); + +/* bounds.c */ + +extern void bounds_equal_extents (array_t *, array_t *, const char *, + const char *); +internal_proto(bounds_equal_extents); + +extern void bounds_reduced_extents (array_t *, array_t *, int, const char *, + const char *intrinsic); +internal_proto(bounds_reduced_extents); + +extern void bounds_iforeach_return (array_t *, array_t *, const char *); +internal_proto(bounds_iforeach_return); + +extern void bounds_ifunction_return (array_t *, const index_type *, + const char *, const char *); +internal_proto(bounds_ifunction_return); + +extern index_type count_0 (const gfc_array_l1 *); + +internal_proto(count_0); + +/* Internal auxiliary functions for cshift */ + +void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int); +internal_proto(cshift0_i1); + +void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ssize_t, int); +internal_proto(cshift0_i2); + +void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ssize_t, int); +internal_proto(cshift0_i4); + +void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ssize_t, int); +internal_proto(cshift0_i8); + +#ifdef HAVE_GFC_INTEGER_16 +void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ssize_t, int); +internal_proto(cshift0_i16); +#endif + +void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ssize_t, int); +internal_proto(cshift0_r4); + +void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ssize_t, int); +internal_proto(cshift0_r8); + +#ifdef HAVE_GFC_REAL_10 +void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ssize_t, int); +internal_proto(cshift0_r10); +#endif + +#ifdef HAVE_GFC_REAL_16 +void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ssize_t, int); +internal_proto(cshift0_r16); +#endif + +void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ssize_t, int); +internal_proto(cshift0_c4); + +void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ssize_t, int); +internal_proto(cshift0_c8); + +#ifdef HAVE_GFC_COMPLEX_10 +void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ssize_t, int); +internal_proto(cshift0_c10); +#endif + +#ifdef HAVE_GFC_COMPLEX_16 +void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ssize_t, int); +internal_proto(cshift0_c16); +#endif + +#endif /* LIBGFOR_H */ diff --git a/libgfortran/libgfortran.spec.in b/libgfortran/libgfortran.spec.in new file mode 100644 index 000000000..95aa3f842 --- /dev/null +++ b/libgfortran/libgfortran.spec.in @@ -0,0 +1,8 @@ +# +# This spec file is read by gfortran when linking. +# It is used to specify the libraries we need to link in, in the right +# order. +# + +%rename lib liborig +*lib: @LIBQUADSPEC@ -lm %(libgcc) %(liborig) diff --git a/libgfortran/libtool-version b/libgfortran/libtool-version new file mode 100644 index 000000000..f787e378b --- /dev/null +++ b/libgfortran/libtool-version @@ -0,0 +1,6 @@ +# This file is used to maintain libtool version info for libgfortran. +# See the libtool manual to understand the meaning of the fields. +# This is a separate file so that version updates don't involve re-running +# automake. +# CURRENT:REVISION:AGE +3:0:0 diff --git a/libgfortran/m4/all.m4 b/libgfortran/m4/all.m4 new file mode 100644 index 000000000..cc1742078 --- /dev/null +++ b/libgfortran/m4/all.m4 @@ -0,0 +1,44 @@ +`/* Implementation of the ALL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(ifunction_logical.m4)dnl + +`#if defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(1, +` /* Return true only if all the elements are set. */ + result = 1;', +` if (! *src) + { + result = 0; + break; + }', `')` + +#endif' diff --git a/libgfortran/m4/any.m4 b/libgfortran/m4/any.m4 new file mode 100644 index 000000000..81ec31046 --- /dev/null +++ b/libgfortran/m4/any.m4 @@ -0,0 +1,44 @@ +`/* Implementation of the ANY intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(ifunction_logical.m4)dnl + +`#if defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(0, +` result = 0;', +` /* Return true if any of the elements are set. */ + if (*src) + { + result = 1; + break; + }', `')` + +#endif' diff --git a/libgfortran/m4/bessel.m4 b/libgfortran/m4/bessel.m4 new file mode 100644 index 000000000..acef7eaa7 --- /dev/null +++ b/libgfortran/m4/bessel.m4 @@ -0,0 +1,187 @@ +`/* Implementation of the BESSEL_JN and BESSEL_YN transformational + function using a recurrence algorithm. + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(`mtype.m4')dnl + +mathfunc_macro + +`#if defined (HAVE_'rtype_name`) + + + +#if 'hasmathfunc(jn)` +extern void bessel_jn_r'rtype_kind` ('rtype` * const restrict ret, int n1, + int n2, 'rtype_name` x); +export_proto(bessel_jn_r'rtype_kind`); + +void +bessel_jn_r'rtype_kind` ('rtype` * const restrict ret, int n1, int n2, 'rtype_name` x) +{ + int i; + index_type stride; + + 'rtype_name` last1, last2, x2rev; + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (ret->data == NULL) + { + size_t size = n2 < n1 ? 0 : n2-n1+1; + GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + ret->data = internal_malloc_size (sizeof ('rtype_name`) * size); + ret->offset = 0; + } + + if (unlikely (n2 < n1)) + return; + + if (unlikely (compile_options.bounds_check) + && GFC_DESCRIPTOR_EXTENT(ret,0) != (n2-n1+1)) + runtime_error("Incorrect extent in return value of BESSEL_JN " + "(%ld vs. %ld)", (long int) n2-n1, + (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (unlikely (x == 0)) + { + ret->data[0] = 1; + for (i = 1; i <= n2-n1; i++) + ret->data[i*stride] = 0; + return; + } + + ret->data = ret->data; + last1 = MATHFUNC(jn) (n2, x); + ret->data[(n2-n1)*stride] = last1; + + if (n1 == n2) + return; + + last2 = MATHFUNC(jn) (n2 - 1, x); + ret->data[(n2-n1-1)*stride] = last2; + + if (n1 + 1 == n2) + return; + + x2rev = GFC_REAL_'rtype_kind`_LITERAL(2.)/x; + + for (i = n2-n1-2; i >= 0; i--) + { + ret->data[i*stride] = x2rev * (i+1+n1) * last2 - last1; + last1 = last2; + last2 = ret->data[i*stride]; + } +} + +#endif + +#if 'hasmathfunc(yn)` +extern void bessel_yn_r'rtype_kind` ('rtype` * const restrict ret, + int n1, int n2, 'rtype_name` x); +export_proto(bessel_yn_r'rtype_kind`); + +void +bessel_yn_r'rtype_kind` ('rtype` * const restrict ret, int n1, int n2, + 'rtype_name` x) +{ + int i; + index_type stride; + + 'rtype_name` last1, last2, x2rev; + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (ret->data == NULL) + { + size_t size = n2 < n1 ? 0 : n2-n1+1; + GFC_DIMENSION_SET(ret->dim[0], 0, size-1, 1); + ret->data = internal_malloc_size (sizeof ('rtype_name`) * size); + ret->offset = 0; + } + + if (unlikely (n2 < n1)) + return; + + if (unlikely (compile_options.bounds_check) + && GFC_DESCRIPTOR_EXTENT(ret,0) != (n2-n1+1)) + runtime_error("Incorrect extent in return value of BESSEL_JN " + "(%ld vs. %ld)", (long int) n2-n1, + (long int) GFC_DESCRIPTOR_EXTENT(ret,0)); + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (unlikely (x == 0)) + { + for (i = 0; i <= n2-n1; i++) +#if defined('rtype_name`_INFINITY) + ret->data[i*stride] = -'rtype_name`_INFINITY; +#else + ret->data[i*stride] = -'rtype_name`_HUGE; +#endif + return; + } + + ret->data = ret->data; + last1 = MATHFUNC(yn) (n1, x); + ret->data[0] = last1; + + if (n1 == n2) + return; + + last2 = MATHFUNC(yn) (n1 + 1, x); + ret->data[1*stride] = last2; + + if (n1 + 1 == n2) + return; + + x2rev = GFC_REAL_'rtype_kind`_LITERAL(2.)/x; + + for (i = 2; i <= n1+n2; i++) + { +#if defined('rtype_name`_INFINITY) + if (unlikely (last2 == -'rtype_name`_INFINITY)) + { + ret->data[i*stride] = -'rtype_name`_INFINITY; + } + else +#endif + { + ret->data[i*stride] = x2rev * (i-1+n1) * last2 - last1; + last1 = last2; + last2 = ret->data[i*stride]; + } + } +} +#endif + +#endif' + diff --git a/libgfortran/m4/count.m4 b/libgfortran/m4/count.m4 new file mode 100644 index 000000000..5998c20e6 --- /dev/null +++ b/libgfortran/m4/count.m4 @@ -0,0 +1,40 @@ +`/* Implementation of the COUNT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(ifunction_logical.m4)dnl + +`#if defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(0, +` result = 0;', +` if (*src) + result++;', `')` + +#endif' diff --git a/libgfortran/m4/cshift0.m4 b/libgfortran/m4/cshift0.m4 new file mode 100644 index 000000000..0c5e0158e --- /dev/null +++ b/libgfortran/m4/cshift0.m4 @@ -0,0 +1,172 @@ +`/* Helper function for cshift functions. + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'rtype_name`) + +void +cshift0_'rtype_code` ('rtype` *ret, const 'rtype` *array, ssize_t shift, + int which) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + 'rtype_name` *rptr; + + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type soffset; + const 'rtype_name` *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + + which = which - 1; + sstride[0] = 0; + rstride[0] = 0; + + extent[0] = 1; + count[0] = 0; + n = 0; + /* Initialized for avoiding compiler warnings. */ + roffset = 1; + soffset = 1; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE(ret,dim); + if (roffset == 0) + roffset = 1; + soffset = GFC_DESCRIPTOR_STRIDE(array,dim); + if (soffset == 0) + soffset = 1; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,dim); + n++; + } + } + if (sstride[0] == 0) + sstride[0] = 1; + if (rstride[0] == 0) + rstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + rptr = ret->data; + sptr = array->data; + + shift = len == 0 ? 0 : shift % (ssize_t)len; + if (shift < 0) + shift += len; + + while (rptr) + { + /* Do the shift for this dimension. */ + + /* If elements are contiguous, perform the operation + in two block moves. */ + if (soffset == 1 && roffset == 1) + { + size_t len1 = shift * sizeof ('rtype_name`); + size_t len2 = (len - shift) * sizeof ('rtype_name`); + memcpy (rptr, sptr + shift, len2); + memcpy (rptr + (len - shift), sptr, len1); + } + else + { + /* Otherwise, we will have to perform the copy one element at + a time. */ + 'rtype_name` *dest = rptr; + const 'rtype_name` *src = &sptr[shift * soffset]; + + for (n = 0; n < len - shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + for (src = sptr, n = 0; n < shift; n++) + { + *dest = *src; + dest += roffset; + src += soffset; + } + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + } + } + } + + return; +} + +#endif' diff --git a/libgfortran/m4/cshift1.m4 b/libgfortran/m4/cshift1.m4 new file mode 100644 index 000000000..49a4f7340 --- /dev/null +++ b/libgfortran/m4/cshift1.m4 @@ -0,0 +1,274 @@ +`/* Implementation of the CSHIFT intrinsic + Copyright 2003, 2007, 2009 Free Software Foundation, Inc. + Contributed by Feng Wang + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'atype_name`) + +static void +cshift1 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const 'atype_name` * const restrict pwhich) +{ + /* 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 'atype_name` *hptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + int which; + 'atype_name` sh; + index_type arraysize; + index_type size; + + 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''`"); + + size = GFC_DESCRIPTOR_SIZE(array); + + arraysize = size0 ((array_t *)array); + + if (ret->data == NULL) + { + int i; + + ret->data = internal_malloc_size (size * arraysize); + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) * + GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + } + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "CSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "CSHIFT"); + } + + if (arraysize == 0) + return; + + 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 = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + 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; + 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 probably 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_'atype_kind` (gfc_array_char * const restrict, + const gfc_array_char * const restrict, + const 'atype` * const restrict, + const 'atype_name` * const restrict); +export_proto(cshift1_'atype_kind`); + +void +cshift1_'atype_kind` (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const 'atype_name` * const restrict pwhich) +{ + cshift1 (ret, array, h, pwhich); +} + + +void cshift1_'atype_kind`_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_'atype_kind`_char); + +void +cshift1_'atype_kind`_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused))) +{ + cshift1 (ret, array, h, pwhich); +} + + +void cshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_'atype_kind`_char4); + +void +cshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused))) +{ + cshift1 (ret, array, h, pwhich); +} + +#endif' diff --git a/libgfortran/m4/eoshift1.m4 b/libgfortran/m4/eoshift1.m4 new file mode 100644 index 000000000..b99b3d1a0 --- /dev/null +++ b/libgfortran/m4/eoshift1.m4 @@ -0,0 +1,319 @@ +`/* Implementation of the EOSHIFT intrinsic + Copyright 2002, 2005, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'atype_name`) + +static void +eoshift1 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const char * const restrict pbound, + const 'atype_name` * const restrict pwhich, + const char * filler, index_type filler_len) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char * restrict 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 'atype_name` *hptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dim; + index_type len; + index_type n; + index_type size; + index_type arraysize; + int which; + 'atype_name` sh; + 'atype_name` delta; + + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + + size = GFC_DESCRIPTOR_SIZE(array); + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + extent[0] = 1; + count[0] = 0; + + arraysize = size0 ((array_t *) array); + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + + } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + 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--) + { + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + + 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 probably 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_'atype_kind` (gfc_array_char * const restrict, + const gfc_array_char * const restrict, + const 'atype` * const restrict, const char * const restrict, + const 'atype_name` * const restrict); +export_proto(eoshift1_'atype_kind`); + +void +eoshift1_'atype_kind` (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const char * const restrict pbound, + const 'atype_name` * const restrict pwhich) +{ + eoshift1 (ret, array, h, pbound, pwhich, "\0", 1); +} + + +void eoshift1_'atype_kind`_char (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const 'atype` * const restrict, + const char * const restrict, + const 'atype_name` * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_'atype_kind`_char); + +void +eoshift1_'atype_kind`_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const char * const restrict pbound, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + eoshift1 (ret, array, h, pbound, pwhich, " ", 1); +} + + +void eoshift1_'atype_kind`_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const 'atype` * const restrict, + const char * const restrict, + const 'atype_name` * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_'atype_kind`_char4); + +void +eoshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const char * const restrict pbound, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ''` ''`; + eoshift1 (ret, array, h, pbound, pwhich, + (const char *) &space, sizeof (gfc_char4_t)); +} + +#endif' diff --git a/libgfortran/m4/eoshift3.m4 b/libgfortran/m4/eoshift3.m4 new file mode 100644 index 000000000..d1b10b56c --- /dev/null +++ b/libgfortran/m4/eoshift3.m4 @@ -0,0 +1,337 @@ +`/* Implementation of the EOSHIFT intrinsic + Copyright 2002, 2005, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'atype_name`) + +static void +eoshift3 (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const gfc_array_char * const restrict bound, + const 'atype_name` * const restrict pwhich, + const char * filler, index_type filler_len) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type roffset; + char *rptr; + char * restrict 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 'atype_name` *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; + index_type size; + index_type arraysize; + int which; + 'atype_name` sh; + 'atype_name` delta; + + /* The compiler cannot figure out that these are set, initialize + them to avoid warnings. */ + len = 0; + soffset = 0; + roffset = 0; + + arraysize = size0 ((array_t *) array); + size = GFC_DESCRIPTOR_SIZE(array); + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + if (ret->data == NULL) + { + int i; + + ret->offset = 0; + ret->dtype = array->dtype; + for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) + { + index_type ub, str; + + ub = GFC_DESCRIPTOR_EXTENT(array,i) - 1; + + if (i == 0) + str = 1; + else + str = GFC_DESCRIPTOR_EXTENT(ret,i-1) + * GFC_DESCRIPTOR_STRIDE(ret,i-1); + + GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + + } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + + extent[0] = 1; + count[0] = 0; + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + if (roffset == 0) + roffset = size; + soffset = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + if (soffset == 0) + soffset = size; + len = GFC_DESCRIPTOR_EXTENT(array,dim); + } + else + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,dim); + rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret,dim); + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + hstride[n] = GFC_DESCRIPTOR_STRIDE(h,n); + if (bound) + bstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(bound,n); + 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--) + { + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + + 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 probably 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_'atype_kind` (gfc_array_char * const restrict, + const gfc_array_char * const restrict, + const 'atype` * const restrict, + const gfc_array_char * const restrict, + const 'atype_name` *); +export_proto(eoshift3_'atype_kind`); + +void +eoshift3_'atype_kind` (gfc_array_char * const restrict ret, + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const gfc_array_char * const restrict bound, + const 'atype_name` * const restrict pwhich) +{ + eoshift3 (ret, array, h, bound, pwhich, "\0", 1); +} + + +extern void eoshift3_'atype_kind`_char (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const 'atype` * const restrict, + const gfc_array_char * const restrict, + const 'atype_name` * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_'atype_kind`_char); + +void +eoshift3_'atype_kind`_char (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const gfc_array_char * const restrict bound, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + eoshift3 (ret, array, h, bound, pwhich, " ", 1); +} + + +extern void eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const 'atype` * const restrict, + const gfc_array_char * const restrict, + const 'atype_name` * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_'atype_kind`_char4); + +void +eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const gfc_array_char * const restrict bound, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4 array_length __attribute__((unused)), + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ''` ''`; + eoshift3 (ret, array, h, bound, pwhich, + (const char *) &space, sizeof (gfc_char4_t)); +} + +#endif' diff --git a/libgfortran/m4/exponent.m4 b/libgfortran/m4/exponent.m4 new file mode 100644 index 000000000..043f150fc --- /dev/null +++ b/libgfortran/m4/exponent.m4 @@ -0,0 +1,45 @@ +`/* Implementation of the EXPONENT intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h"' + +include(`mtype.m4')dnl + +mathfunc_macro + +`#if defined (HAVE_'real_type`) && 'hasmathfunc(frexp)` + +extern GFC_INTEGER_4 exponent_r'kind` ('real_type` s); +export_proto(exponent_r'kind`); + +GFC_INTEGER_4 +exponent_r'kind` ('real_type` s) +{ + int ret; + MATHFUNC(frexp) (s, &ret); + return ret; +} + +#endif' diff --git a/libgfortran/m4/fraction.m4 b/libgfortran/m4/fraction.m4 new file mode 100644 index 000000000..cca2db980 --- /dev/null +++ b/libgfortran/m4/fraction.m4 @@ -0,0 +1,44 @@ +`/* Implementation of the FRACTION intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h"' + +include(`mtype.m4')dnl + +mathfunc_macro + +`#if defined (HAVE_'real_type`) && 'hasmathfunc(frexp)` + +extern 'real_type` fraction_r'kind` ('real_type` s); +export_proto(fraction_r'kind`); + +'real_type` +fraction_r'kind` ('real_type` s) +{ + int dummy_exp; + return MATHFUNC(frexp) (s, &dummy_exp); +} + +#endif' diff --git a/libgfortran/m4/head.m4 b/libgfortran/m4/head.m4 new file mode 100644 index 000000000..30cdea892 --- /dev/null +++ b/libgfortran/m4/head.m4 @@ -0,0 +1,25 @@ +`! Copyright 2002, 2007, 2009 Free Software Foundation, Inc. +! Contributed by Paul Brook +! +!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 3 of the License, or (at your option) any later version. + +!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. +! +!Under Section 7 of GPL version 3, you are granted additional +!permissions described in the GCC Runtime Library Exception, version +!3.1, as published by the Free Software Foundation. +! +!You should have received a copy of the GNU General Public License and +!a copy of the GCC Runtime Library Exception along with this program; +!see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +!. +! +!This file is machine generated.' diff --git a/libgfortran/m4/iall.m4 b/libgfortran/m4/iall.m4 new file mode 100644 index 000000000..2e6667e26 --- /dev/null +++ b/libgfortran/m4/iall.m4 @@ -0,0 +1,46 @@ +`/* Implementation of the IALL intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(0, +` result = ('rtype_name`) -1;', +` result &= *src;') + +MASKED_ARRAY_FUNCTION(0, +` result = 0;', +` if (*msrc) + result &= *src;') + +SCALAR_ARRAY_FUNCTION(0) + +#endif diff --git a/libgfortran/m4/iany.m4 b/libgfortran/m4/iany.m4 new file mode 100644 index 000000000..a17d951e5 --- /dev/null +++ b/libgfortran/m4/iany.m4 @@ -0,0 +1,46 @@ +`/* Implementation of the IANY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(0, +` result = 0;', +` result |= *src;') + +MASKED_ARRAY_FUNCTION(0, +` result = 0;', +` if (*msrc) + result |= *src;') + +SCALAR_ARRAY_FUNCTION(0) + +#endif diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4 new file mode 100644 index 000000000..14e501c67 --- /dev/null +++ b/libgfortran/m4/iforeach.m4 @@ -0,0 +1,279 @@ +dnl Support macro file for intrinsic functions. +dnl Contains the generic sections of the array functions. +dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran) +dnl Distributed under the GNU GPL with exception. See COPYING for details. +define(START_FOREACH_FUNCTION, +` +extern void name`'rtype_qual`_'atype_code (rtype * const restrict retarray, + atype * const restrict array); +export_proto(name`'rtype_qual`_'atype_code); + +void +name`'rtype_qual`_'atype_code (rtype * const restrict retarray, + atype * const restrict array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + const atype_name *base; + rtype_name * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); + } + else + { + if (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "u_name"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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; + { +')dnl +define(START_FOREACH_BLOCK, +` while (base) + { + do + { + /* Implementation start. */ +')dnl +define(FINISH_FOREACH_FUNCTION, +` /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + while (count[n] == extent[n]); + } + } +}')dnl +define(START_MASKED_FOREACH_FUNCTION, +` +extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict, + atype * const restrict, gfc_array_l1 * const restrict); +export_proto(`m'name`'rtype_qual`_'atype_code); + +void +`m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, + atype * const restrict array, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + rtype_name *dest; + const atype_name *base; + GFC_LOGICAL_1 *mbase; + int rank; + index_type n; + int mask_kind; + + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank - 1, 1); + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); + } + else + { + if (unlikely (compile_options.bounds_check)) + { + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "u_name"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "u_name"); + } + } + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + mbase = mask->data; + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + 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] = 0; + { +')dnl +define(START_MASKED_FOREACH_BLOCK, `START_FOREACH_BLOCK')dnl +define(FINISH_MASKED_FOREACH_FUNCTION, +` /* Implementation end. */ + /* Advance to the next element. */ + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + n = 0; + do + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + 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]; + } + } + while (count[n] == extent[n]); + } + } +}')dnl +define(FOREACH_FUNCTION, +`START_FOREACH_FUNCTION +$1 +START_FOREACH_BLOCK +$2 +FINISH_FOREACH_FUNCTION')dnl +define(MASKED_FOREACH_FUNCTION, +`START_MASKED_FOREACH_FUNCTION +$1 +START_MASKED_FOREACH_BLOCK +$2 +FINISH_MASKED_FOREACH_FUNCTION')dnl +define(SCALAR_FOREACH_FUNCTION, +` +extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict, + atype * const restrict, GFC_LOGICAL_4 *); +export_proto(`s'name`'rtype_qual`_'atype_code); + +void +`s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, + atype * const restrict array, + GFC_LOGICAL_4 * mask) +{ + index_type rank; + index_type dstride; + index_type n; + rtype_name *dest; + + if (*mask) + { + name`'rtype_qual`_'atype_code (retarray, array); + return; + } + + rank = GFC_DESCRIPTOR_RANK (array); + + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, rank-1, 1); + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); + } + else if (unlikely (compile_options.bounds_check)) + { + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "u_name"); + } + + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + dest = retarray->data; + for (n = 0; ndata == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->data = internal_malloc_size (alloc_size); + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + + } + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " u_name intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "u_name"); + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const atype_name * restrict src; + rtype_name result; + src = base; + { +')dnl +define(START_ARRAY_BLOCK, +` if (len <= 0) + *dest = '$1`; + else + { + for (n = 0; n < len; n++, src += delta) + { +')dnl +define(FINISH_ARRAY_FUNCTION, +` } + '$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 probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +}')dnl +define(START_MASKED_ARRAY_FUNCTION, +` +extern void `m'name`'rtype_qual`_'atype_code (rtype * const restrict, + atype * const restrict, const index_type * const restrict, + gfc_array_l1 * const restrict); +export_proto(`m'name`'rtype_qual`_'atype_code); + +void +`m'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, + atype * const restrict array, + const index_type * const restrict pdim, + gfc_array_l1 * const restrict mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + rtype_name * restrict dest; + const atype_name * restrict base; + const GFC_LOGICAL_1 * restrict mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + int mask_kind; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len <= 0) + return; + + mbase = mask->data; + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); + else + runtime_error ("Funny sized logical array"); + + delta = GFC_DESCRIPTOR_STRIDE(array,dim); + mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in u_name intrinsic"); + + if (unlikely (compile_options.bounds_check)) + { + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "u_name"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "u_name"); + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + + while (base) + { + const atype_name * restrict src; + const GFC_LOGICAL_1 * restrict msrc; + rtype_name result; + src = base; + msrc = mbase; + { +')dnl +define(START_MASKED_ARRAY_BLOCK, +` if (len <= 0) + *dest = '$1`; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { +')dnl +define(FINISH_MASKED_ARRAY_FUNCTION, +` } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +}')dnl +define(SCALAR_ARRAY_FUNCTION, +` +extern void `s'name`'rtype_qual`_'atype_code (rtype * const restrict, + atype * const restrict, const index_type * const restrict, + GFC_LOGICAL_4 *); +export_proto(`s'name`'rtype_qual`_'atype_code); + +void +`s'name`'rtype_qual`_'atype_code (rtype * const restrict retarray, + atype * const restrict array, + const index_type * const restrict pdim, + GFC_LOGICAL_4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + rtype_name * restrict dest; + index_type rank; + index_type n; + index_type dim; + + + if (*mask) + { + name`'rtype_qual`_'atype_code (retarray, array, pdim); + return; + } + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + for (n = 0; n < dim; n++) + { + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] <= 0) + extent[n] = 0; + } + + for (n = dim; n < rank; n++) + { + extent[n] = + GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] <= 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " u_name intrinsic: is %ld, should be %ld", + (long int) (GFC_DESCRIPTOR_RANK (retarray)), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " u_name intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + } + + dest = retarray->data; + + while(1) + { + *dest = '$1`; + count[0]++; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + return; + else + { + count[n]++; + dest += dstride[n]; + } + } + } +}')dnl +define(ARRAY_FUNCTION, +`START_ARRAY_FUNCTION +$2 +START_ARRAY_BLOCK($1) +$3 +FINISH_ARRAY_FUNCTION($4)')dnl +define(MASKED_ARRAY_FUNCTION, +`START_MASKED_ARRAY_FUNCTION +$2 +START_MASKED_ARRAY_BLOCK($1) +$3 +FINISH_MASKED_ARRAY_FUNCTION')dnl diff --git a/libgfortran/m4/ifunction_logical.m4 b/libgfortran/m4/ifunction_logical.m4 new file mode 100644 index 000000000..e72f1d8a8 --- /dev/null +++ b/libgfortran/m4/ifunction_logical.m4 @@ -0,0 +1,208 @@ +dnl Support macro file for intrinsic functions. +dnl Contains the generic sections of the array functions. +dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran) +dnl Distributed under the GNU GPL with exception. See COPYING for details. +dnl +dnl Pass the implementation for a single section as the parameter to +dnl {MASK_}ARRAY_FUNCTION. +dnl The variables base, delta, and len describe the input section. +dnl For masked section the mask is described by mbase and mdelta. +dnl These should not be modified. The result should be stored in *dest. +dnl The names count, extent, sstride, dstride, base, dest, rank, dim +dnl retarray, array, pdim and mstride should not be used. +dnl The variable n is declared as index_type and may be used. +dnl Other variable declarations may be placed at the start of the code, +dnl The types of the array parameter and the return value are +dnl atype_name and rtype_name respectively. +dnl Execution should be allowed to continue to the end of the block. +dnl You should not return or break from the inner loop of the implementation. +dnl Care should also be taken to avoid using the names defined in iparm.m4 +define(START_ARRAY_FUNCTION, +` +extern void name`'rtype_qual`_'atype_code (rtype * const restrict, + gfc_array_l1 * const restrict, const index_type * const restrict); +export_proto(name`'rtype_qual`_'atype_code); + +void +name`'rtype_qual`_'atype_code (rtype * const restrict retarray, + gfc_array_l1 * const restrict array, + const index_type * const restrict pdim) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride[GFC_MAX_DIMENSIONS]; + const GFC_LOGICAL_1 * restrict base; + rtype_name * restrict dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + int src_kind; + int continue_loop; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + src_kind = GFC_DESCRIPTOR_SIZE (array); + + len = GFC_DESCRIPTOR_EXTENT(array,dim); + if (len < 0) + len = 0; + + delta = GFC_DESCRIPTOR_STRIDE_BYTES(array,dim); + + for (n = 0; n < dim; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + + if (extent[n] < 0) + extent[n] = 0; + } + for (n = dim; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1); + + if (extent[n] < 0) + extent[n] = 0; + } + + if (retarray->data == NULL) + { + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + + alloc_size = sizeof (rtype_name) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) + * extent[rank-1]; + + if (alloc_size == 0) + { + /* Make sure we have a zero-sized array. */ + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); + return; + } + else + retarray->data = internal_malloc_size (alloc_size); + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect in" + " u_name intrinsic: is %ld, should be %ld", + (long int) GFC_DESCRIPTOR_RANK (retarray), + (long int) rank); + + if (unlikely (compile_options.bounds_check)) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " u_name intrinsic in dimension %d:" + " is %ld, should be %ld", (int) n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); + if (extent[n] <= 0) + return; + } + + base = array->data; + + if (src_kind == 1 || src_kind == 2 || src_kind == 4 || src_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || src_kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, src_kind); + } + else + internal_error (NULL, "Funny sized logical array in u_name intrinsic"); + + dest = retarray->data; + + continue_loop = 1; + while (continue_loop) + { + const GFC_LOGICAL_1 * restrict src; + rtype_name result; + src = base; + { +')dnl +define(START_ARRAY_BLOCK, +` if (len <= 0) + *dest = '$1`; + else + { + for (n = 0; n < len; n++, src += delta) + { +')dnl +define(FINISH_ARRAY_FUNCTION, + ` } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +}')dnl +define(ARRAY_FUNCTION, +`START_ARRAY_FUNCTION +$2 +START_ARRAY_BLOCK($1) +$3 +FINISH_ARRAY_FUNCTION')dnl diff --git a/libgfortran/m4/in_pack.m4 b/libgfortran/m4/in_pack.m4 new file mode 100644 index 000000000..a4337aad8 --- /dev/null +++ b/libgfortran/m4/in_pack.m4 @@ -0,0 +1,122 @@ +`/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'rtype_name`) + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ +' +dnl The kind (ie size) is used to name the function for logicals, integers +dnl and reals. For complex, it's c4 or c8. +rtype_name` * +internal_pack_'rtype_ccode` ('rtype` * 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 'rtype_name` *src; + 'rtype_name` * restrict dest; + 'rtype_name` *destptr; + int n; + int packed; + + /* TODO: Investigate how we can figure out if this is a temporary + since the stride=0 thing has been removed from the frontend. */ + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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 = ('rtype_name` *)internal_malloc_size (ssize * sizeof ('rtype_name`)); + 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 probably 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/m4/in_unpack.m4 b/libgfortran/m4/in_unpack.m4 new file mode 100644 index 000000000..661c54e1d --- /dev/null +++ b/libgfortran/m4/in_unpack.m4 @@ -0,0 +1,110 @@ +`/* Helper function for repacking arrays. + Copyright 2003, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +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 +internal_unpack_'rtype_ccode` ('rtype` * d, const 'rtype_name` * 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; + 'rtype_name` * restrict dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * sizeof ('rtype_name`)); + 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 probably 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/m4/iparity.m4 b/libgfortran/m4/iparity.m4 new file mode 100644 index 000000000..78dbc3dd4 --- /dev/null +++ b/libgfortran/m4/iparity.m4 @@ -0,0 +1,46 @@ +`/* Implementation of the IPARITY intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(0, +` result = 0;', +` result ^= *src;') + +MASKED_ARRAY_FUNCTION(0, +` result = 0;', +` if (*msrc) + result ^= *src;') + +SCALAR_ARRAY_FUNCTION(0) + +#endif diff --git a/libgfortran/m4/iparm.m4 b/libgfortran/m4/iparm.m4 new file mode 100644 index 000000000..4ff624741 --- /dev/null +++ b/libgfortran/m4/iparm.m4 @@ -0,0 +1,37 @@ +dnl Support macro file for intrinsic functions. +dnl Works out all the function types from the filename. +dnl This file is part of the GNU Fortran 95 Runtime Library (libgfortran) +dnl Distributed under the GNU GPL with exception. See COPYING for details. +dnl M4 macro file to get type names from filenames +define(get_typename2, `GFC_$1_$2')dnl +define(get_typename, `get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,unknown)))),`$2')')dnl +define(get_arraytype, `gfc_array_$1$2')dnl +define(define_type, `dnl +ifelse(regexp($2,`^[0-9]'),-1,`dnl +define($1_letter, substr($2, 0, 1))dnl +define($1_kind, substr($2, 1))dnl +',`dnl +define($1_letter,i)dnl +define($1_kind,$2)dnl +')dnl +define($1_code,$1_letter`'$1_kind)dnl +define($1,get_arraytype($1_letter,$1_kind))dnl +define($1_name, get_typename($1_letter, $1_kind))')dnl +dnl +define_type(atype, regexp(file, `_\(.?[0-9]*\)\.c$', `\1'))dnl +define(rtype_tmp, regexp(file, `_\(.?[0-9]*\)_[^_]*\.c$', `\1'))dnl +ifelse(rtype_tmp,,`dnl +define_type(rtype, atype_code)dnl +define(rtype_qual,`')dnl +',`dnl +define_type(rtype, rtype_tmp)dnl +define(rtype_qual,`_'rtype_kind)dnl +')dnl +define(atype_max, atype_name`_HUGE')dnl +define(atype_min,ifelse(regexp(file, `_\(.\)[0-9]*\.c$', `\1'),`i',`(-'atype_max`-1)',`-'atype_max))dnl +define(atype_inf, atype_name`_INFINITY')dnl +define(atype_nan, atype_name`_QUIET_NAN')dnl +define(name, regexp(regexp(file, `[^/]*$', `\&'), `^\([^_]*\)_', `\1'))dnl +define(`upcase', `translit(`$*', `a-z', `A-Z')')dnl +define(`u_name',`regexp(upcase(name),`\([A-Z]*\)',`\1')')dnl +define(rtype_ccode,ifelse(rtype_letter,`i',rtype_kind,rtype_code))dnl diff --git a/libgfortran/m4/matmul.m4 b/libgfortran/m4/matmul.m4 new file mode 100644 index 000000000..bb42f2a6c --- /dev/null +++ b/libgfortran/m4/matmul.m4 @@ -0,0 +1,378 @@ +`/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'rtype_name`) + +/* Prototype for the BLAS ?gemm subroutine, a pointer to which can be + passed to us by the front-end, in which case we''`ll call it for large + matrices. */ + +typedef void (*blas_call)(const char *, const char *, const int *, const int *, + const int *, const 'rtype_name` *, const 'rtype_name` *, + const int *, const 'rtype_name` *, const int *, + const 'rtype_name` *, 'rtype_name` *, const int *, + int, int); + +/* The order of loops is different in the case of plain matrix + multiplication C=MATMUL(A,B), and in the frequent special case where + the argument A is the temporary result of a TRANSPOSE intrinsic: + C=MATMUL(TRANSPOSE(A),B). Transposed temporaries are detected by + looking at their strides. + + The equivalent Fortran pseudo-code is: + + DIMENSION A(M,COUNT), B(COUNT,N), C(M,N) + IF (.NOT.IS_TRANSPOSED(A)) THEN + 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) + ELSE + DO J=1,N + DO I=1,M + S = 0 + DO K=1,COUNT + S = S+A(I,K)*B(K,J) + C(I,J) = S + ENDIF +*/ + +/* If try_blas is set to a nonzero value, then the matmul function will + see if there is a way to perform the matrix multiplication by a call + to the BLAS gemm function. */ + +extern void matmul_'rtype_code` ('rtype` * const restrict retarray, + 'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas, + int blas_limit, blas_call gemm); +export_proto(matmul_'rtype_code`); + +void +matmul_'rtype_code` ('rtype` * const restrict retarray, + 'rtype` * const restrict a, 'rtype` * const restrict b, int try_blas, + int blas_limit, blas_call gemm) +{ + const 'rtype_name` * restrict abase; + const 'rtype_name` * restrict bbase; + 'rtype_name` * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } +' +sinclude(`matmul_asm_'rtype_code`.m4')dnl +` + 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 = GFC_DESCRIPTOR_STRIDE(retarray,0); + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + /* Treat it as a a row matrix A[1,count]. */ + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = 1; + + xcount = 1; + count = GFC_DESCRIPTOR_EXTENT(a,0); + } + else + { + axstride = GFC_DESCRIPTOR_STRIDE(a,0); + aystride = GFC_DESCRIPTOR_STRIDE(a,1); + + count = GFC_DESCRIPTOR_EXTENT(a,1); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + + if (count != GFC_DESCRIPTOR_EXTENT(b,0)) + { + if (count > 0 || GFC_DESCRIPTOR_EXTENT(b,0) > 0) + runtime_error ("dimension of array B incorrect in MATMUL intrinsic"); + } + + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + /* Treat it as a column matrix B[count,1] */ + bxstride = GFC_DESCRIPTOR_STRIDE(b,0); + + /* 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 = GFC_DESCRIPTOR_STRIDE(b,0); + bystride = GFC_DESCRIPTOR_STRIDE(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + abase = a->data; + bbase = b->data; + dest = retarray->data; + + + /* Now that everything is set up, we''`re performing the multiplication + itself. */ + +#define POW3(x) (((float) (x)) * ((float) (x)) * ((float) (x))) + + if (try_blas && rxstride == 1 && (axstride == 1 || aystride == 1) + && (bxstride == 1 || bystride == 1) + && (((float) xcount) * ((float) ycount) * ((float) count) + > POW3(blas_limit))) + { + const int m = xcount, n = ycount, k = count, ldc = rystride; + const 'rtype_name` one = 1, zero = 0; + const int lda = (axstride == 1) ? aystride : axstride, + ldb = (bxstride == 1) ? bystride : bxstride; + + if (lda > 0 && ldb > 0 && ldc > 0 && m > 1 && n > 1 && k > 1) + { + assert (gemm != NULL); + gemm (axstride == 1 ? "N" : "T", bxstride == 1 ? "N" : "T", &m, &n, &k, + &one, abase, &lda, bbase, &ldb, &zero, dest, &ldc, 1, 1); + return; + } + } + + if (rxstride == 1 && axstride == 1 && bxstride == 1) + { + const 'rtype_name` * restrict bbase_y; + 'rtype_name` * restrict dest_y; + const 'rtype_name` * restrict abase_n; + 'rtype_name` bbase_yn; + + if (rystride == xcount) + memset (dest, 0, (sizeof ('rtype_name`) * xcount * ycount)); + else + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x + y*rystride] = ('rtype_name`)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 if (rxstride == 1 && aystride == 1 && bxstride == 1) + { + if (GFC_DESCRIPTOR_RANK (a) != 1) + { + const 'rtype_name` *restrict abase_x; + const 'rtype_name` *restrict bbase_y; + 'rtype_name` *restrict dest_y; + 'rtype_name` s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = ('rtype_name`) 0; + for (n = 0; n < count; n++) + s += abase_x[n] * bbase_y[n]; + dest_y[x] = s; + } + } + } + else + { + const 'rtype_name` *restrict bbase_y; + 'rtype_name` s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = ('rtype_name`) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n]; + dest[y*rystride] = s; + } + } + } + else if (axstride < aystride) + { + for (y = 0; y < ycount; y++) + for (x = 0; x < xcount; x++) + dest[x*rxstride + y*rystride] = ('rtype_name`)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]; + } + else if (GFC_DESCRIPTOR_RANK (a) == 1) + { + const 'rtype_name` *restrict bbase_y; + 'rtype_name` s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + s = ('rtype_name`) 0; + for (n = 0; n < count; n++) + s += abase[n*axstride] * bbase_y[n*bxstride]; + dest[y*rxstride] = s; + } + } + else + { + const 'rtype_name` *restrict abase_x; + const 'rtype_name` *restrict bbase_y; + 'rtype_name` *restrict dest_y; + 'rtype_name` s; + + for (y = 0; y < ycount; y++) + { + bbase_y = &bbase[y*bystride]; + dest_y = &dest[y*rystride]; + for (x = 0; x < xcount; x++) + { + abase_x = &abase[x*axstride]; + s = ('rtype_name`) 0; + for (n = 0; n < count; n++) + s += abase_x[n*aystride] * bbase_y[n*bxstride]; + dest_y[x*rxstride] = s; + } + } + } +} + +#endif' diff --git a/libgfortran/m4/matmull.m4 b/libgfortran/m4/matmull.m4 new file mode 100644 index 000000000..c5bad25f7 --- /dev/null +++ b/libgfortran/m4/matmull.m4 @@ -0,0 +1,241 @@ +`/* Implementation of the MATMUL intrinsic + Copyright 2002, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +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. */ + +extern void matmul_'rtype_code` ('rtype` * const restrict, + gfc_array_l1 * const restrict, gfc_array_l1 * const restrict); +export_proto(matmul_'rtype_code`); + +void +matmul_'rtype_code` ('rtype` * const restrict retarray, + gfc_array_l1 * const restrict a, gfc_array_l1 * const restrict b) +{ + const GFC_LOGICAL_1 * restrict abase; + const GFC_LOGICAL_1 * restrict bbase; + 'rtype_name` * restrict 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; + int a_kind; + int b_kind; + + const GFC_LOGICAL_1 * restrict pa; + const GFC_LOGICAL_1 * restrict 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) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, 1); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + } + else + { + GFC_DIMENSION_SET(retarray->dim[0], 0, + GFC_DESCRIPTOR_EXTENT(a,0) - 1, 1); + + GFC_DIMENSION_SET(retarray->dim[1], 0, + GFC_DESCRIPTOR_EXTENT(b,1) - 1, + GFC_DESCRIPTOR_EXTENT(retarray,0)); + } + + retarray->data + = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray)); + retarray->offset = 0; + } + else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, arg_extent; + + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else if (GFC_DESCRIPTOR_RANK (b) == 1) + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic: is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + else + { + arg_extent = GFC_DESCRIPTOR_EXTENT(a,0); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 1:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + + arg_extent = GFC_DESCRIPTOR_EXTENT(b,1); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,1); + if (arg_extent != ret_extent) + runtime_error ("Incorrect extent in return array in" + " MATMUL intrinsic for dimension 2:" + " is %ld, should be %ld", + (long int) ret_extent, (long int) arg_extent); + } + } + + abase = a->data; + a_kind = GFC_DESCRIPTOR_SIZE (a); + + if (a_kind == 1 || a_kind == 2 || a_kind == 4 || a_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || a_kind == 16 +#endif + ) + abase = GFOR_POINTER_TO_L1 (abase, a_kind); + else + internal_error (NULL, "Funny sized logical array"); + + bbase = b->data; + b_kind = GFC_DESCRIPTOR_SIZE (b); + + if (b_kind == 1 || b_kind == 2 || b_kind == 4 || b_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || b_kind == 16 +#endif + ) + bbase = GFOR_POINTER_TO_L1 (bbase, b_kind); + else + internal_error (NULL, "Funny sized logical array"); + + dest = retarray->data; +' +sinclude(`matmul_asm_'rtype_code`.m4')dnl +` + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = rxstride; + } + else + { + rxstride = GFC_DESCRIPTOR_STRIDE(retarray,0); + rystride = GFC_DESCRIPTOR_STRIDE(retarray,1); + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + count = GFC_DESCRIPTOR_EXTENT(a,0); + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = GFC_DESCRIPTOR_STRIDE_BYTES(a,1); + count = GFC_DESCRIPTOR_EXTENT(a,1); + xstride = GFC_DESCRIPTOR_STRIDE_BYTES(a,0); + xcount = GFC_DESCRIPTOR_EXTENT(a,0); + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = GFC_DESCRIPTOR_STRIDE_BYTES(b,0); + assert(count == GFC_DESCRIPTOR_EXTENT(b,0)); + ystride = GFC_DESCRIPTOR_STRIDE_BYTES(b,1); + ycount = GFC_DESCRIPTOR_EXTENT(b,1); + } + + 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 +' diff --git a/libgfortran/m4/maxloc0.m4 b/libgfortran/m4/maxloc0.m4 new file mode 100644 index 000000000..aef7b9b8d --- /dev/null +++ b/libgfortran/m4/maxloc0.m4 @@ -0,0 +1,126 @@ +`/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl +include(iforeach.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +FOREACH_FUNCTION( +` atype_name maxval; +#if defined('atype_nan`) + int fast = 0; +#endif + +#if defined('atype_inf`) + maxval = -atype_inf; +#else + maxval = atype_min; +#endif', +`#if defined('atype_nan`) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base >= maxval) + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + }') + +MASKED_FOREACH_FUNCTION( +` atype_name maxval; + int fast = 0; + +#if defined('atype_inf`) + maxval = -atype_inf; +#else + maxval = atype_min; +#endif', +` } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined('atype_nan`) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base >= maxval) +#endif + { + fast = 1; + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + }') + +SCALAR_FOREACH_FUNCTION(`0') +#endif diff --git a/libgfortran/m4/maxloc1.m4 b/libgfortran/m4/maxloc1.m4 new file mode 100644 index 000000000..44872ee61 --- /dev/null +++ b/libgfortran/m4/maxloc1.m4 @@ -0,0 +1,101 @@ +`/* Implementation of the MAXLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(0, +` atype_name maxval; +#if defined ('atype_inf`) + maxval = -atype_inf; +#else + maxval = atype_min; +#endif + result = 1;', +`#if defined ('atype_nan`) + if (*src >= maxval) + { + maxval = *src; + result = (rtype_name)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + if (*src > maxval) + { + maxval = *src; + result = (rtype_name)n + 1; + }', `') + +MASKED_ARRAY_FUNCTION(0, +` atype_name maxval; +#if defined ('atype_inf`) + maxval = -atype_inf; +#else + maxval = atype_min; +#endif +#if defined ('atype_nan`) + rtype_name result2 = 0; +#endif + result = 0;', +` if (*msrc) + { +#if defined ('atype_nan`) + if (!result2) + result2 = (rtype_name)n + 1; + if (*src >= maxval) +#endif + { + maxval = *src; + result = (rtype_name)n + 1; + break; + } + } + } +#if defined ('atype_nan`) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; n < len; n++, src += delta, msrc += mdelta) + { + if (*msrc && *src > maxval) + { + maxval = *src; + result = (rtype_name)n + 1; + }') + +SCALAR_ARRAY_FUNCTION(0) + +#endif diff --git a/libgfortran/m4/maxval.m4 b/libgfortran/m4/maxval.m4 new file mode 100644 index 000000000..153906880 --- /dev/null +++ b/libgfortran/m4/maxval.m4 @@ -0,0 +1,88 @@ +`/* Implementation of the MAXVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(atype_min, +`#if defined ('atype_inf`) + result = -atype_inf; +#else + result = atype_min; +#endif', +`#if defined ('atype_nan`) + if (*src >= result) + break; + } + if (unlikely (n >= len)) + result = atype_nan; + else for (; n < len; n++, src += delta) + { +#endif + if (*src > result) + result = *src;', `') + +MASKED_ARRAY_FUNCTION(atype_min, +`#if defined ('atype_inf`) + result = -atype_inf; +#else + result = atype_min; +#endif +#if defined ('atype_nan`) + int non_empty_p = 0; +#endif', +`#if defined ('atype_inf`) || defined ('atype_nan`) + if (*msrc) + { +#if defined ('atype_nan`) + non_empty_p = 1; + if (*src >= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined ('atype_nan`) + result = non_empty_p ? atype_nan : atype_min; +#else + result = atype_min; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + if (*msrc && *src > result) + result = *src;') + +SCALAR_ARRAY_FUNCTION(atype_min) + +#endif diff --git a/libgfortran/m4/minloc0.m4 b/libgfortran/m4/minloc0.m4 new file mode 100644 index 000000000..1345f2df4 --- /dev/null +++ b/libgfortran/m4/minloc0.m4 @@ -0,0 +1,126 @@ +`/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl +include(iforeach.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +FOREACH_FUNCTION( +` atype_name minval; +#if defined('atype_nan`) + int fast = 0; +#endif + +#if defined('atype_inf`) + minval = atype_inf; +#else + minval = atype_max; +#endif', +`#if defined('atype_nan`) + } + while (0); + if (unlikely (!fast)) + { + do + { + if (*base <= minval) + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + base += sstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { +#endif + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + }') + +MASKED_FOREACH_FUNCTION( +` atype_name minval; + int fast = 0; + +#if defined('atype_inf`) + minval = atype_inf; +#else + minval = atype_max; +#endif', +` } + while (0); + if (unlikely (!fast)) + { + do + { + if (*mbase) + { +#if defined('atype_nan`) + if (unlikely (dest[0] == 0)) + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + if (*base <= minval) +#endif + { + fast = 1; + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + break; + } + } + base += sstride[0]; + mbase += mstride[0]; + } + while (++count[0] != extent[0]); + if (likely (fast)) + continue; + } + else do + { + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + }') + +SCALAR_FOREACH_FUNCTION(`0') +#endif diff --git a/libgfortran/m4/minloc1.m4 b/libgfortran/m4/minloc1.m4 new file mode 100644 index 000000000..e0bd3cd88 --- /dev/null +++ b/libgfortran/m4/minloc1.m4 @@ -0,0 +1,101 @@ +`/* Implementation of the MINLOC intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(0, +` atype_name minval; +#if defined ('atype_inf`) + minval = atype_inf; +#else + minval = atype_max; +#endif + result = 1;', +`#if defined ('atype_nan`) + if (*src <= minval) + { + minval = *src; + result = (rtype_name)n + 1; + break; + } + } + for (; n < len; n++, src += delta) + { +#endif + if (*src < minval) + { + minval = *src; + result = (rtype_name)n + 1; + }') + +MASKED_ARRAY_FUNCTION(0, +` atype_name minval; +#if defined ('atype_inf`) + minval = atype_inf; +#else + minval = atype_max; +#endif +#if defined ('atype_nan`) + rtype_name result2 = 0; +#endif + result = 0;', +` if (*msrc) + { +#if defined ('atype_nan`) + if (!result2) + result2 = (rtype_name)n + 1; + if (*src <= minval) +#endif + { + minval = *src; + result = (rtype_name)n + 1; + break; + } + } + } +#if defined ('atype_nan`) + if (unlikely (n >= len)) + result = result2; + else +#endif + for (; n < len; n++, src += delta, msrc += mdelta) + { + if (*msrc && *src < minval) + { + minval = *src; + result = (rtype_name)n + 1; + }', `') + +SCALAR_ARRAY_FUNCTION(0) + +#endif diff --git a/libgfortran/m4/minval.m4 b/libgfortran/m4/minval.m4 new file mode 100644 index 000000000..037dd6725 --- /dev/null +++ b/libgfortran/m4/minval.m4 @@ -0,0 +1,88 @@ +`/* Implementation of the MINVAL intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(atype_max, +`#if defined ('atype_inf`) + result = atype_inf; +#else + result = atype_max; +#endif', +`#if defined ('atype_nan`) + if (*src <= result) + break; + } + if (unlikely (n >= len)) + result = atype_nan; + else for (; n < len; n++, src += delta) + { +#endif + if (*src < result) + result = *src;') + +MASKED_ARRAY_FUNCTION(atype_max, +`#if defined ('atype_inf`) + result = atype_inf; +#else + result = atype_max; +#endif +#if defined ('atype_nan`) + int non_empty_p = 0; +#endif', +`#if defined ('atype_inf`) || defined ('atype_nan`) + if (*msrc) + { +#if defined ('atype_nan`) + non_empty_p = 1; + if (*src <= result) +#endif + break; + } + } + if (unlikely (n >= len)) + { +#if defined ('atype_nan`) + result = non_empty_p ? atype_nan : atype_max; +#else + result = atype_max; +#endif + } + else for (; n < len; n++, src += delta, msrc += mdelta) + { +#endif + if (*msrc && *src < result) + result = *src;', `') + +SCALAR_ARRAY_FUNCTION(atype_max) + +#endif diff --git a/libgfortran/m4/misc_specifics.m4 b/libgfortran/m4/misc_specifics.m4 new file mode 100644 index 000000000..3e40bf017 --- /dev/null +++ b/libgfortran/m4/misc_specifics.m4 @@ -0,0 +1,64 @@ +include(head.m4)dnl +dnl +dnl This file contains the specific functions that are not handled in the +dnl m4/specific.m4 file. + +#include "config.h" +#include "kinds.inc" + +dnl This is from GNU m4 examples file foreach.m4: +divert(-1) +# foreach(x, (item_1, item_2, ..., item_n), stmt) +define(`foreach', `pushdef(`$1', `')_foreach(`$1', `$2', +`$3')popdef(`$1')') +define(`_arg1', `$1') +define(`_foreach', + `ifelse(`$2', `()', , + `define(`$1', _arg1$2)$3`'_foreach(`$1', (shift$2), +`$3')')') +# traceon(`define', `foreach', `_foreach', `ifelse') +divert + +dnl NINT specifics +foreach(`ikind', `(4, 8, 16)', `foreach(`rkind', `(4, 8, 10, 16)', ` +`#if defined (HAVE_GFC_REAL_'rkind`) && defined (HAVE_GFC_INTEGER_'ikind`)' +elemental function _gfortran_specific__nint_`'ikind`_'rkind (parm) + real (kind=rkind) , intent (in) :: parm + integer (kind=ikind) :: _gfortran_specific__nint_`'ikind`_'rkind + _gfortran_specific__nint_`'ikind`_'rkind = nint (parm) +end function +#endif +')') + +dnl CHAR specifics +foreach(`ckind', `(1)', `foreach(`ikind', `(4, 8, 16)', ` +`#if defined (HAVE_GFC_INTEGER_'ikind`)' +elemental function _gfortran_specific__char_`'ckind`_i'ikind (parm) + integer (kind=ikind) , intent (in) :: parm + character (kind=ckind,len=1) :: _gfortran_specific__char_`'ckind`_i'ikind + _gfortran_specific__char_`'ckind`_i'ikind` = char (parm, kind='ckind`)' +end function +#endif +')') + +dnl LEN specifics +foreach(`ckind', `(1)', `foreach(`ikind', `(4, 8, 16)', ` +`#if defined (HAVE_GFC_INTEGER_'ikind`)' +elemental function _gfortran_specific__len_`'ckind`_i'ikind (parm) + character (kind=ckind,len=*) , intent (in) :: parm + integer (kind=ikind) :: _gfortran_specific__len_`'ckind`_i'ikind + _gfortran_specific__len_`'ckind`_i'ikind` = len (parm)' +end function +#endif +')') + +dnl INDEX specifics +foreach(`ckind', `(1)', `foreach(`ikind', `(4, 8, 16)', ` +`#if defined (HAVE_GFC_INTEGER_'ikind`)' +elemental function _gfortran_specific__index_`'ckind`_i'ikind (parm1, parm2) + character (kind=ckind,len=*) , intent (in) :: parm1, parm2 + integer (kind=ikind) :: _gfortran_specific__index_`'ckind`_i'ikind + _gfortran_specific__index_`'ckind`_i'ikind` = index (parm1, parm2)' +end function +#endif +')') diff --git a/libgfortran/m4/mtype.m4 b/libgfortran/m4/mtype.m4 new file mode 100644 index 000000000..b133e578b --- /dev/null +++ b/libgfortran/m4/mtype.m4 @@ -0,0 +1,13 @@ +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(`upcase', `translit(`$*', `a-z', `A-Z')')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 +define(hasmathfunc,`ifelse(kind,4,`defined (HAVE_'upcase($1)`F)',ifelse(kind,8,`defined (HAVE_'upcase($1)`)',ifelse(kind,10,`defined (HAVE_'upcase($1)`L)',ifelse(kind,16,`(defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_'upcase($1)`L))',`error out'))))') +define(mathfunc_macro,`ifelse(kind,16,`#if defined(GFC_REAL_16_IS_FLOAT128) +#define MATHFUNC(funcname) funcname ## q +#else +#define MATHFUNC(funcname) funcname ## l +#endif',ifelse(kind,8,``#''`define MATHFUNC(funcname) funcname',```#'''`define MATHFUNC(funcname) funcname '```#'''```#'''` 'q))')dnl diff --git a/libgfortran/m4/nearest.m4 b/libgfortran/m4/nearest.m4 new file mode 100644 index 000000000..643443048 --- /dev/null +++ b/libgfortran/m4/nearest.m4 @@ -0,0 +1,51 @@ +`/* Implementation of the NEAREST intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h"' + +include(`mtype.m4')dnl + +mathfunc_macro + +`#if defined (HAVE_'real_type`) && 'hasmathfunc(copysign) && hasmathfunc(nextafter)` + +extern 'real_type` nearest_r'kind` ('real_type` s, 'real_type` dir); +export_proto(nearest_r'kind`); + +'real_type` +nearest_r'kind` ('real_type` s, 'real_type` dir) +{ + dir = MATHFUNC(copysign) (MATHFUNC(__builtin_inf) (), dir); + if (FLT_EVAL_METHOD != 0) + { + /* ??? Work around glibc bug on x86. */ + volatile 'real_type` r = MATHFUNC(nextafter) (s, dir); + return r; + } + else + return MATHFUNC(nextafter) (s, dir); +} + +#endif' diff --git a/libgfortran/m4/norm2.m4 b/libgfortran/m4/norm2.m4 new file mode 100644 index 000000000..b2162ac23 --- /dev/null +++ b/libgfortran/m4/norm2.m4 @@ -0,0 +1,61 @@ +`/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl +include(`mtype.m4')dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`) && 'hasmathfunc(sqrt) && hasmathfunc(fabs) + +mathfunc_macro + +ARRAY_FUNCTION(0, +` 'rtype_name` scale; + result = 0; + scale = 1;', +` if (*src != 0) + { + 'rtype_name` absX, val; + absX = MATHFUNC(fabs) (*src); + if (scale < absX) + { + val = scale / absX; + result = 1 + result * val * val; + scale = absX; + } + else + { + val = absX / scale; + result += val * val; + } + }', +` result = scale * MATHFUNC(sqrt) (result);') + +#endif diff --git a/libgfortran/m4/pack.m4 b/libgfortran/m4/pack.m4 new file mode 100644 index 000000000..c5fd2fd81 --- /dev/null +++ b/libgfortran/m4/pack.m4 @@ -0,0 +1,262 @@ +`/* Specific implementation of the PACK intrinsic + Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'rtype_name`) + +/* PACK is specified as follows: + + 13.14.80 PACK (ARRAY, MASK, [VECTOR]) + + Description: Pack an array into an array of rank one under the + control of a mask. + + Class: Transformational function. + + Arguments: + ARRAY may be of any type. It shall not be scalar. + MASK shall be of type LOGICAL. It shall be conformable with ARRAY. + VECTOR (optional) shall be of the same type and type parameters + as ARRAY. VECTOR shall have at least as many elements as + there are true elements in MASK. If MASK is a scalar + with the value true, VECTOR shall have at least as many + elements as there are in ARRAY. + + Result Characteristics: The result is an array of rank one with the + same type and type parameters as ARRAY. If VECTOR is present, the + result size is that of VECTOR; otherwise, the result size is the + number /t/ of true elements in MASK unless MASK is scalar with the + value true, in which case the result size is the size of ARRAY. + + Result Value: Element /i/ of the result is the element of ARRAY + that corresponds to the /i/th true element of MASK, taking elements + in array element order, for /i/ = 1, 2, ..., /t/. If VECTOR is + present and has size /n/ > /t/, element /i/ of the result has the + value VECTOR(/i/), for /i/ = /t/ + 1, ..., /n/. + + Examples: The nonzero elements of an array M with the value + | 0 0 0 | + | 9 0 0 | may be "gathered" by the function PACK. The result of + | 0 0 7 | + PACK (M, MASK = M.NE.0) is [9,7] and the result of PACK (M, M.NE.0, + VECTOR = (/ 2,4,6,8,10,12 /)) is [9,7,6,8,10,12]. + +There are two variants of the PACK intrinsic: one, where MASK is +array valued, and the other one where MASK is scalar. */ + +void +pack_'rtype_code` ('rtype` *ret, const 'rtype` *array, + const gfc_array_l1 *mask, const 'rtype` *vector) +{ + /* r.* indicates the return array. */ + index_type rstride0; + 'rtype_name` * restrict rptr; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + const 'rtype_name` *sptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + int zero_sized; + index_type n; + index_type dim; + index_type nelem; + index_type total; + int mask_kind; + + dim = GFC_DESCRIPTOR_RANK (array); + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + zero_sized = 0; + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = 1; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (sstride[0] == 0) + sstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = mask_kind; + + if (zero_sized) + sptr = NULL; + else + sptr = array->data; + + if (ret->data == NULL || unlikely (compile_options.bounds_check)) + { + /* Count the elements, either for allocating memory or + for bounds checking. */ + + if (vector != NULL) + { + /* The return array will have as many + elements as there are in VECTOR. */ + total = GFC_DESCRIPTOR_EXTENT(vector,0); + if (total < 0) + { + total = 0; + vector = NULL; + } + } + else + { + /* We have to count the true elements in MASK. */ + total = count_0 (mask); + } + + if (ret->data == NULL) + { + /* Setup the array descriptor. */ + GFC_DIMENSION_SET(ret->dim[0], 0, total-1, 1); + + ret->offset = 0; + if (total == 0) + { + /* In this case, nothing remains to be done. */ + ret->data = internal_malloc_size (1); + return; + } + else + ret->data = internal_malloc_size (sizeof ('rtype_name`) * total); + } + else + { + /* We come here because of range checking. */ + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + if (total != ret_extent) + runtime_error ("Incorrect extent in return value of PACK intrinsic;" + " is %ld, should be %ld", (long int) total, + (long int) ret_extent); + } + } + + rstride0 = GFC_DESCRIPTOR_STRIDE(ret,0); + if (rstride0 == 0) + rstride0 = 1; + sstride0 = sstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + + while (sptr && mptr) + { + /* Test this element. */ + if (*mptr) + { + /* Add it. */ + *rptr = *sptr; + rptr += rstride0; + } + /* Advance to the next element. */ + sptr += sstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + mptr += mstride[n]; + } + } + } + + /* Add any remaining elements from VECTOR. */ + if (vector) + { + n = GFC_DESCRIPTOR_EXTENT(vector,0); + nelem = ((rptr - ret->data) / rstride0); + if (n > nelem) + { + sstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (sstride0 == 0) + sstride0 = 1; + + sptr = vector->data + sstride0 * nelem; + n -= nelem; + while (n--) + { + *rptr = *sptr; + rptr += rstride0; + sptr += sstride0; + } + } + } +} + +#endif +' diff --git a/libgfortran/m4/parity.m4 b/libgfortran/m4/parity.m4 new file mode 100644 index 000000000..037e96db9 --- /dev/null +++ b/libgfortran/m4/parity.m4 @@ -0,0 +1,40 @@ +`/* Implementation of the NORM2 intrinsic + Copyright 2010 Free Software Foundation, Inc. + Contributed by Tobias Burnus + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(0, +` result = 0;', +` result = result != *src;', `') + +#endif diff --git a/libgfortran/m4/pow.m4 b/libgfortran/m4/pow.m4 new file mode 100644 index 000000000..3814f87fe --- /dev/null +++ b/libgfortran/m4/pow.m4 @@ -0,0 +1,83 @@ +`/* Support routines for the intrinsic power (**) operator. + Copyright 2004, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h"' + +include(iparm.m4)dnl + +/* 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_'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`); + +'rtype_name` +pow_'rtype_code`_'atype_code` ('rtype_name` a, 'atype_name` b) +{ + 'rtype_name` pow, x; + 'atype_name` n; + GFC_UINTEGER_'atype_kind` u; + + n = b; + x = a; + pow = 1; + if (n != 0) + { + if (n < 0) + { +'ifelse(rtype_letter,i,`dnl + if (x == 1) + return 1; + if (x == -1) + return (n & 1) ? -1 : 1; + return (x == 0) ? 1 / x : 0; +',` + u = -n; + x = pow / x; +')dnl +` } + else + { + u = n; + } + for (;;) + { + if (u & 1) + pow *= x; + u >>= 1; + if (u) + x *= x; + else + break; + } + } + return pow; +} + +#endif' diff --git a/libgfortran/m4/product.m4 b/libgfortran/m4/product.m4 new file mode 100644 index 000000000..6f6f2c011 --- /dev/null +++ b/libgfortran/m4/product.m4 @@ -0,0 +1,46 @@ +`/* Implementation of the PRODUCT intrinsic + Copyright 2002, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(1, +` result = 1;', +` result *= *src;', `') + +MASKED_ARRAY_FUNCTION(1, +` result = 1;', +` if (*msrc) + result *= *src;') + +SCALAR_ARRAY_FUNCTION(1) + +`#endif' diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4 new file mode 100644 index 000000000..4052a5ecc --- /dev/null +++ b/libgfortran/m4/reshape.m4 @@ -0,0 +1,356 @@ +`/* Implementation of the RESHAPE intrinsic + Copyright 2002, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'rtype_name`) + +typedef GFC_ARRAY_DESCRIPTOR(1, 'index_type`) 'shape_type`;' + +dnl For integer routines, only the kind (ie size) is used to name the +dnl function. The same function will be used for integer and logical +dnl arrays of the same kind. + +`extern void reshape_'rtype_ccode` ('rtype` * const restrict, + 'rtype` * const restrict, + 'shape_type` * const restrict, + 'rtype` * const restrict, + 'shape_type` * const restrict); +export_proto(reshape_'rtype_ccode`); + +void +reshape_'rtype_ccode` ('rtype` * const restrict ret, + 'rtype` * const restrict source, + 'shape_type` * const restrict shape, + 'rtype` * const restrict pad, + 'shape_type` * const restrict 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; + 'rtype_name` *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 'rtype_name` *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 'rtype_name` *pptr; + + const 'rtype_name` *src; + int n; + int dim; + int sempty, pempty, shape_empty; + index_type shape_data[GFC_MAX_DIMENSIONS]; + + rdim = GFC_DESCRIPTOR_EXTENT(shape,0); + if (rdim != GFC_DESCRIPTOR_RANK(ret)) + runtime_error("rank of return array incorrect in RESHAPE intrinsic"); + + shape_empty = 0; + + for (n = 0; n < rdim; n++) + { + shape_data[n] = shape->data[n * GFC_DESCRIPTOR_STRIDE(shape,0)]; + if (shape_data[n] <= 0) + { + shape_data[n] = 0; + shape_empty = 1; + } + } + + if (ret->data == NULL) + { + rs = 1; + for (n = 0; n < rdim; n++) + { + rex = shape_data[n]; + + GFC_DIMENSION_SET(ret->dim[n], 0, rex - 1, rs); + + rs *= rex; + } + ret->offset = 0; + ret->data = internal_malloc_size ( rs * sizeof ('rtype_name`)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + + if (shape_empty) + return; + + if (pad) + { + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + pempty = 0; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = GFC_DESCRIPTOR_STRIDE(pad,n); + pextent[n] = GFC_DESCRIPTOR_EXTENT(pad,n); + if (pextent[n] <= 0) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + + if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, source_extent; + + rs = 1; + for (n = 0; n < rdim; n++) + { + rs *= shape_data[n]; + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (ret_extent != shape_data[n]) + runtime_error("Incorrect extent in return value of RESHAPE" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) shape_data[n]); + } + + source_extent = 1; + sdim = GFC_DESCRIPTOR_RANK (source); + for (n = 0; n < sdim; n++) + { + index_type se; + se = GFC_DESCRIPTOR_EXTENT(source,n); + source_extent *= se > 0 ? se : 0; + } + + if (rs > source_extent && (!pad || pempty)) + runtime_error("Incorrect size in SOURCE argument to RESHAPE" + " intrinsic: is %ld, should be %ld", + (long int) source_extent, (long int) rs); + + if (order) + { + int seen[GFC_MAX_DIMENSIONS]; + index_type v; + + for (n = 0; n < rdim; n++) + seen[n] = 0; + + for (n = 0; n < rdim; n++) + { + v = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + + if (v < 0 || v >= rdim) + runtime_error("Value %ld out of range in ORDER argument" + " to RESHAPE intrinsic", (long int) v + 1); + + if (seen[v] != 0) + runtime_error("Duplicate value %ld in ORDER argument to" + " RESHAPE intrinsic", (long int) v + 1); + + seen[v] = 1; + } + } + } + + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * GFC_DESCRIPTOR_STRIDE(order,0)] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,dim); + rextent[n] = GFC_DESCRIPTOR_EXTENT(ret,dim); + if (rextent[n] < 0) + rextent[n] = 0; + + if (rextent[n] != shape_data[dim]) + 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; + sempty = 0; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + sextent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + if (sextent[n] <= 0) + { + sempty = 1; + sextent[n] = 0; + } + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= sizeof ('rtype_name`); + ssize *= sizeof ('rtype_name`); + psize *= sizeof ('rtype_name`); + 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]; + + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Pretend we are using the pad array the first time around, too. */ + src = pptr; + sptr = pptr; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = pstride[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 probably 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 probably 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/m4/rrspacing.m4 b/libgfortran/m4/rrspacing.m4 new file mode 100644 index 000000000..5f11d5b6b --- /dev/null +++ b/libgfortran/m4/rrspacing.m4 @@ -0,0 +1,54 @@ +`/* Implementation of the RRSPACING intrinsic + Copyright 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Steven G. Kargl + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h"' + +include(`mtype.m4')dnl + +mathfunc_macro + +`#if defined (HAVE_'real_type`) && 'hasmathfunc(fabs) && hasmathfunc(frexp)` + +extern 'real_type` rrspacing_r'kind` ('real_type` s, int p); +export_proto(rrspacing_r'kind`); + +'real_type` +rrspacing_r'kind` ('real_type` s, int p) +{ + int e; + 'real_type` x; + x = MATHFUNC(fabs) (s); + if (x == 0.) + return 0.; + MATHFUNC(frexp) (s, &e); +#if 'hasmathfunc(ldexp)` + return MATHFUNC(ldexp) (x, p - e); +#else + return MATHFUNC(scalbn) (x, p - e); +#endif + +} + +#endif' diff --git a/libgfortran/m4/set_exponent.m4 b/libgfortran/m4/set_exponent.m4 new file mode 100644 index 000000000..5f31ab681 --- /dev/null +++ b/libgfortran/m4/set_exponent.m4 @@ -0,0 +1,44 @@ +`/* Implementation of the SET_EXPONENT intrinsic + Copyright 2003, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Richard Henderson . + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h"' + +include(`mtype.m4')dnl + +mathfunc_macro + +`#if defined (HAVE_'real_type`) && 'hasmathfunc(scalbn) && hasmathfunc(frexp)` + +extern 'real_type` set_exponent_r'kind` ('real_type` s, GFC_INTEGER_4 i); +export_proto(set_exponent_r'kind`); + +'real_type` +set_exponent_r'kind` ('real_type` s, GFC_INTEGER_4 i) +{ + int dummy_exp; + return MATHFUNC(scalbn) (MATHFUNC(frexp) (s, &dummy_exp), i); +} + +#endif' diff --git a/libgfortran/m4/shape.m4 b/libgfortran/m4/shape.m4 new file mode 100644 index 000000000..c079cca99 --- /dev/null +++ b/libgfortran/m4/shape.m4 @@ -0,0 +1,68 @@ +`/* Implementation of the SHAPE intrinsic + Copyright 2002, 2006, 2007, 2009, 2010 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'rtype_name`) + +extern void shape_'rtype_kind` ('rtype` * const restrict ret, + const 'rtype` * const restrict array); +export_proto(shape_'rtype_kind`); + +void +shape_'rtype_kind` ('rtype` * const restrict ret, + const 'rtype` * const restrict array) +{ + int n; + index_type stride; + index_type extent; + int rank; + + rank = GFC_DESCRIPTOR_RANK (array); + + if (ret->data == NULL) + { + GFC_DIMENSION_SET(ret->dim[0], 0, rank - 1, 1); + ret->offset = 0; + ret->data = internal_malloc_size (sizeof ('rtype_name`) * rank); + } + + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + if (GFC_DESCRIPTOR_EXTENT(ret,0) < 1) + return; + + for (n = 0; n < rank; n++) + { + extent = GFC_DESCRIPTOR_EXTENT(array,n); + ret->data[n * stride] = extent > 0 ? extent : 0 ; + } +} + +#endif' diff --git a/libgfortran/m4/spacing.m4 b/libgfortran/m4/spacing.m4 new file mode 100644 index 000000000..faae6d124 --- /dev/null +++ b/libgfortran/m4/spacing.m4 @@ -0,0 +1,53 @@ +`/* Implementation of the SPACING intrinsic + Copyright 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Steven G. Kargl + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h"' + +include(`mtype.m4')dnl + +mathfunc_macro + +`#if defined (HAVE_'real_type`) && 'hasmathfunc(frexp)` + +extern 'real_type` spacing_r'kind` ('real_type` s, int p, int emin, 'real_type` tiny); +export_proto(spacing_r'kind`); + +'real_type` +spacing_r'kind` ('real_type` s, int p, int emin, 'real_type` tiny) +{ + int e; + if (s == 0.) + return tiny; + MATHFUNC(frexp) (s, &e); + e = e - p; + e = e > emin ? e : emin; +#if 'hasmathfunc(ldexp)` + return MATHFUNC(ldexp) (1., e); +#else + return MATHFUNC(scalbn) (1., e); +#endif +} + +#endif' diff --git a/libgfortran/m4/specific.m4 b/libgfortran/m4/specific.m4 new file mode 100644 index 000000000..ebc89839a --- /dev/null +++ b/libgfortran/m4/specific.m4 @@ -0,0 +1,43 @@ +include(head.m4) +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 +define(get_typename, `get_typename2(ifelse($1,i,integer,ifelse($1,r,real,ifelse($1,l,logical,ifelse($1,c,complex,unknown)))),`$2')')dnl +define(atype_name, get_typename(atype_letter,atype_kind))dnl +define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl +define(rtype_name,get_typename(ifelse(name,abs,ifelse(atype_letter,c,r,atype_letter),ifelse(name,aimag,ifelse(atype_letter,c,r,atype_letter),atype_letter)),atype_kind))dnl +define(function_name,ifelse(name,conjg,`_gfortran_specific__conjg_'atype_kind,`_gfortran_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 - AIMAG, 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,aimag,none,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 + rtype_name :: function_name + + function_name = name (parm) +end function + +ifelse(NEEDED,NONE,`',`#endif') +#endif diff --git a/libgfortran/m4/specific2.m4 b/libgfortran/m4/specific2.m4 new file mode 100644 index 000000000..d05e8db14 --- /dev/null +++ b/libgfortran/m4/specific2.m4 @@ -0,0 +1,30 @@ +include(head.m4) +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 +define(get_typename, `get_typename2(ifelse($1,i,integer,ifelse($1,r,real,ifelse($1,l,logical,ifelse($1,c,complex,unknown)))),`$2')')dnl +define(atype_name, get_typename(atype_letter,atype_kind))dnl +define(name, regexp(regexp(file, `[^/]*$', `\&'), `^_\([^_]*\)_', `\1'))dnl +define(function_name,`_gfortran_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 diff --git a/libgfortran/m4/spread.m4 b/libgfortran/m4/spread.m4 new file mode 100644 index 000000000..5e73d9742 --- /dev/null +++ b/libgfortran/m4/spread.m4 @@ -0,0 +1,272 @@ +`/* Special implementation of the SPREAD intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + spread_generic.c written 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'rtype_name`) + +void +spread_'rtype_code` ('rtype` *ret, const 'rtype` *source, + const index_type along, const index_type pncopies) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rdelta = 0; + index_type rrank; + index_type rs; + 'rtype_name` *rptr; + 'rtype_name` * restrict dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type sstride0; + index_type srank; + const 'rtype_name` *sptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + index_type ncopies; + + srank = GFC_DESCRIPTOR_RANK(source); + + rrank = srank + 1; + if (rrank > GFC_MAX_DIMENSIONS) + runtime_error ("return rank too large in spread()"); + + if (along > rrank) + runtime_error ("dim outside of rank in spread()"); + + ncopies = pncopies; + + if (ret->data == NULL) + { + + size_t ub, stride; + + /* The front end has signalled that we need to populate the + return array descriptor. */ + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rrank; + dim = 0; + rs = 1; + for (n = 0; n < rrank; n++) + { + stride = rs; + if (n == along - 1) + { + ub = ncopies - 1; + rdelta = rs; + rs *= ncopies; + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = rs; + + ub = extent[dim] - 1; + rs *= extent[dim]; + dim++; + } + GFC_DIMENSION_SET(ret->dim[n], 0, ub, stride); + } + ret->offset = 0; + if (rs > 0) + ret->data = internal_malloc_size (rs * sizeof('rtype_name`)); + else + { + ret->data = internal_malloc_size (1); + return; + } + } + else + { + int zero_sized; + + zero_sized = 0; + + dim = 0; + if (GFC_DESCRIPTOR_RANK(ret) != rrank) + runtime_error ("rank mismatch in spread()"); + + if (unlikely (compile_options.bounds_check)) + { + for (n = 0; n < rrank; n++) + { + index_type ret_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,n); + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %ld: is %ld," + " should be %ld", (long int) n+1, + (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + else + { + for (n = 0; n < rrank; n++) + { + if (n == along - 1) + { + rdelta = GFC_DESCRIPTOR_STRIDE(ret,n); + } + else + { + count[dim] = 0; + extent[dim] = GFC_DESCRIPTOR_EXTENT(source,dim); + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = GFC_DESCRIPTOR_STRIDE(source,dim); + rstride[dim] = GFC_DESCRIPTOR_STRIDE(ret,n); + dim++; + } + } + } + + if (zero_sized) + return; + + if (sstride[0] == 0) + sstride[0] = 1; + } + sstride0 = sstride[0]; + rstride0 = rstride[0]; + rptr = ret->data; + sptr = source->data; + + while (sptr) + { + /* Spread this element. */ + dest = rptr; + for (n = 0; n < ncopies; n++) + { + *dest = *sptr; + dest += rdelta; + } + /* Advance to the next element. */ + sptr += sstride0; + rptr += rstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + sptr -= sstride[n] * extent[n]; + rptr -= rstride[n] * extent[n]; + n++; + if (n >= srank) + { + /* Break out of the loop. */ + sptr = NULL; + break; + } + else + { + count[n]++; + sptr += sstride[n]; + rptr += rstride[n]; + } + } + } +} + +/* This version of spread_internal treats the special case of a scalar + source. This is much simpler than the more general case above. */ + +void +spread_scalar_'rtype_code` ('rtype` *ret, const 'rtype_name` *source, + const index_type along, const index_type pncopies) +{ + int n; + int ncopies = pncopies; + 'rtype_name` * restrict dest; + index_type stride; + + if (GFC_DESCRIPTOR_RANK (ret) != 1) + runtime_error ("incorrect destination rank in spread()"); + + if (along > 1) + runtime_error ("dim outside of rank in spread()"); + + if (ret->data == NULL) + { + ret->data = internal_malloc_size (ncopies * sizeof ('rtype_name`)); + ret->offset = 0; + GFC_DIMENSION_SET(ret->dim[0], 0, ncopies - 1, 1); + } + else + { + if (ncopies - 1 > (GFC_DESCRIPTOR_EXTENT(ret,0) - 1) + / GFC_DESCRIPTOR_STRIDE(ret,0)) + runtime_error ("dim too large in spread()"); + } + + dest = ret->data; + stride = GFC_DESCRIPTOR_STRIDE(ret,0); + + for (n = 0; n < ncopies; n++) + { + *dest = *source; + dest += stride; + } +} + +#endif +' diff --git a/libgfortran/m4/sum.m4 b/libgfortran/m4/sum.m4 new file mode 100644 index 000000000..b502c6e7d --- /dev/null +++ b/libgfortran/m4/sum.m4 @@ -0,0 +1,46 @@ +`/* Implementation of the SUM intrinsic + Copyright 2002, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include ' + +include(iparm.m4)dnl +include(ifunction.m4)dnl + +`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' + +ARRAY_FUNCTION(0, +` result = 0;', +` result += *src;') + +MASKED_ARRAY_FUNCTION(0, +` result = 0;', +` if (*msrc) + result += *src;') + +SCALAR_ARRAY_FUNCTION(0) + +#endif diff --git a/libgfortran/m4/transpose.m4 b/libgfortran/m4/transpose.m4 new file mode 100644 index 000000000..34c2d6c06 --- /dev/null +++ b/libgfortran/m4/transpose.m4 @@ -0,0 +1,115 @@ +`/* Implementation of the TRANSPOSE intrinsic + Copyright 2003, 2005, 2006, 2007, 2009 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'rtype_name`) + +extern void transpose_'rtype_code` ('rtype` * const restrict ret, + 'rtype` * const restrict source); +export_proto(transpose_'rtype_code`); + +void +transpose_'rtype_code` ('rtype` * const restrict ret, + 'rtype` * const restrict source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + 'rtype_name` * restrict rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const 'rtype_name` *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); + + GFC_DIMENSION_SET(ret->dim[0], 0, GFC_DESCRIPTOR_EXTENT(source,1) - 1, + 1); + + GFC_DIMENSION_SET(ret->dim[1], 0, GFC_DESCRIPTOR_EXTENT(source,0) - 1, + GFC_DESCRIPTOR_EXTENT(source, 1)); + + ret->data = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) ret)); + ret->offset = 0; + } else if (unlikely (compile_options.bounds_check)) + { + index_type ret_extent, src_extent; + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,0); + src_extent = GFC_DESCRIPTOR_EXTENT(source,1); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 1: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + ret_extent = GFC_DESCRIPTOR_EXTENT(ret,1); + src_extent = GFC_DESCRIPTOR_EXTENT(source,0); + + if (src_extent != ret_extent) + runtime_error ("Incorrect extent in return value of TRANSPOSE" + " intrinsic in dimension 2: is %ld," + " should be %ld", (long int) src_extent, + (long int) ret_extent); + + } + + sxstride = GFC_DESCRIPTOR_STRIDE(source,0); + systride = GFC_DESCRIPTOR_STRIDE(source,1); + xcount = GFC_DESCRIPTOR_EXTENT(source,0); + ycount = GFC_DESCRIPTOR_EXTENT(source,1); + + rxstride = GFC_DESCRIPTOR_STRIDE(ret,0); + rystride = GFC_DESCRIPTOR_STRIDE(ret,1); + + 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/m4/types.m4 b/libgfortran/m4/types.m4 new file mode 100644 index 000000000..cb808290c --- /dev/null +++ b/libgfortran/m4/types.m4 @@ -0,0 +1,4 @@ +define(get_typename2, `GFC_$1_$2')dnl +define(get_typename, `get_typename2(ifelse($1,i,INTEGER,ifelse($1,r,REAL,ifelse($1,l,LOGICAL,ifelse($1,c,COMPLEX,unknown)))),`$2')')dnl +define(get_arraytype, `gfc_array_$1$2')dnl +define(name, regexp(regexp(file, `[^/]*$', `\&'), `^\([^_]*\)_', `\1'))dnl diff --git a/libgfortran/m4/unpack.m4 b/libgfortran/m4/unpack.m4 new file mode 100644 index 000000000..bf348aebe --- /dev/null +++ b/libgfortran/m4/unpack.m4 @@ -0,0 +1,332 @@ +`/* Specific implementation of the UNPACK intrinsic + Copyright 2008, 2009 Free Software Foundation, Inc. + Contributed by Thomas Koenig , based on + unpack_generic.c 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 3 of the License, or (at your option) any later version. + +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. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include ' + +include(iparm.m4)dnl + +`#if defined (HAVE_'rtype_name`) + +void +unpack0_'rtype_code` ('rtype` *ret, const 'rtype` *vector, + const gfc_array_l1 *mask, const 'rtype_name` *fptr) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + 'rtype_name` * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + 'rtype_name` *vptr; + /* Value for field, this is constant. */ + const 'rtype_name` fval = *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof ('rtype_name`)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = fval; + } + /* Advance to the next element. */ + rptr += rstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + mptr += mstride[n]; + } + } + } +} + +void +unpack1_'rtype_code` ('rtype` *ret, const 'rtype` *vector, + const gfc_array_l1 *mask, const 'rtype` *field) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS]; + index_type rstride0; + index_type rs; + 'rtype_name` * restrict rptr; + /* v.* indicates the vector array. */ + index_type vstride0; + 'rtype_name` *vptr; + /* f.* indicates the field array. */ + index_type fstride[GFC_MAX_DIMENSIONS]; + index_type fstride0; + const 'rtype_name` *fptr; + /* m.* indicates the mask array. */ + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type mstride0; + const GFC_LOGICAL_1 *mptr; + + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type n; + index_type dim; + + int empty; + int mask_kind; + + empty = 0; + + mptr = mask->data; + + /* Use the same loop for all logical types, by using GFC_LOGICAL_1 + and using shifting to address size and endian issues. */ + + mask_kind = GFC_DESCRIPTOR_SIZE (mask); + + if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || mask_kind == 16 +#endif + ) + { + /* Do not convert a NULL pointer as we use test for NULL below. */ + if (mptr) + mptr = GFOR_POINTER_TO_L1 (mptr, mask_kind); + } + else + runtime_error ("Funny sized logical array"); + + if (ret->data == NULL) + { + /* The front end has signalled that we need to populate the + return array descriptor. */ + dim = GFC_DESCRIPTOR_RANK (mask); + rs = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + GFC_DIMENSION_SET(ret->dim[n], 0, + GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + rs *= extent[n]; + } + ret->offset = 0; + ret->data = internal_malloc_size (rs * sizeof ('rtype_name`)); + } + else + { + dim = GFC_DESCRIPTOR_RANK (ret); + for (n = 0; n < dim; n++) + { + count[n] = 0; + extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); + empty = empty || extent[n] <= 0; + rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); + fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); + mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); + } + if (rstride[0] == 0) + rstride[0] = 1; + } + + if (empty) + return; + + if (fstride[0] == 0) + fstride[0] = 1; + if (mstride[0] == 0) + mstride[0] = 1; + + vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); + if (vstride0 == 0) + vstride0 = 1; + rstride0 = rstride[0]; + fstride0 = fstride[0]; + mstride0 = mstride[0]; + rptr = ret->data; + fptr = field->data; + vptr = vector->data; + + while (rptr) + { + if (*mptr) + { + /* From vector. */ + *rptr = *vptr; + vptr += vstride0; + } + else + { + /* From field. */ + *rptr = *fptr; + } + /* Advance to the next element. */ + rptr += rstride0; + fptr += fstride0; + mptr += mstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so probably not worth it. */ + rptr -= rstride[n] * extent[n]; + fptr -= fstride[n] * extent[n]; + mptr -= mstride[n] * extent[n]; + n++; + if (n >= dim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + fptr += fstride[n]; + mptr += mstride[n]; + } + } + } +} + +#endif +' diff --git a/libgfortran/mk-kinds-h.sh b/libgfortran/mk-kinds-h.sh new file mode 100755 index 000000000..98a95ab54 --- /dev/null +++ b/libgfortran/mk-kinds-h.sh @@ -0,0 +1,119 @@ +#!/bin/sh +LC_ALL=C +export LC_ALL + +compile="$1" + +# Possible types must be listed in ascending order +possible_integer_kinds="1 2 4 8 16" +possible_real_kinds="4 8 10 16" + + +largest="" +smallest="" +for k in $possible_integer_kinds; do + echo " integer (kind=$k) :: i" > tmp$$.f90 + echo " i = 1_$k" >> tmp$$.f90 + echo " end" >> tmp$$.f90 + if $compile -S tmp$$.f90 > /dev/null 2>&1; then + s=`expr 8 \* $k` + largest="$k" + + if [ $s -eq 128 ]; then + prefix="__" + else + prefix="" + fi + + if [ "$smallest" = "" ]; then + smallest="$k" + fi + + 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}" + echo "" + fi + rm -f tmp$$.* +done + +echo "#define GFC_INTEGER_LARGEST GFC_INTEGER_${largest}" +echo "#define GFC_UINTEGER_LARGEST GFC_UINTEGER_${largest}" +echo "#define GFC_DEFAULT_CHAR ${smallest}" +echo "" + + +# Get the kind value for long double, so we may disambiguate it +# from __float128. +echo "use iso_c_binding; print *, c_long_double ; end" > tmq$$.f90 +long_double_kind=`$compile -S -fdump-parse-tree tmq$$.f90 | grep TRANSFER \ + | sed 's/ *TRANSFER *//'` +rm -f tmq$$.* + + +for k in $possible_real_kinds; do + echo " real (kind=$k) :: x" > tmp$$.f90 + echo " x = 1.0_$k" >> tmp$$.f90 + echo " end" >> tmp$$.f90 + if $compile -S tmp$$.f90 > /dev/null 2>&1; then + case $k in + 4) ctype="float" ; cplxtype="complex float" ; suffix="f" ;; + 8) ctype="double" ; cplxtype="complex double" ; suffix="" ;; + 10) ctype="long double" ; cplxtype="complex long double" ; suffix="l" ;; + 16) if [ $long_double_kind -eq 10 ]; then + ctype="__float128" + cplxtype="_Complex float __attribute__((mode(TC)))" + suffix="q" + else + ctype="long double" + cplxtype="complex long double" + suffix="l" + fi ;; + *) echo "$0: Unknown type" >&2 ; exit 1 ;; + esac + + # Check for the value of HUGE + echo "print *, huge(0._$k) ; end" > tmq$$.f90 + huge=`$compile -S -fdump-parse-tree tmq$$.f90 | grep TRANSFER \ + | sed 's/ *TRANSFER *//' | sed 's/_.*//'` + rm -f tmq$$.* + + # Check for the value of DIGITS + echo "print *, digits(0._$k) ; end" > tmq$$.f90 + digits=`$compile -S -fdump-parse-tree tmq$$.f90 | grep TRANSFER \ + | sed 's/ *TRANSFER *//'` + rm -f tmq$$.* + + # Check for the value of RADIX + echo "print *, radix(0._$k) ; end" > tmq$$.f90 + radix=`$compile -S -fdump-parse-tree tmq$$.f90 | grep TRANSFER \ + | sed 's/ *TRANSFER *//'` + rm -f tmq$$.* + + # Output the information we've gathered + echo "typedef ${ctype} GFC_REAL_${k};" + echo "typedef ${cplxtype} GFC_COMPLEX_${k};" + echo "#define HAVE_GFC_REAL_${k}" + echo "#define HAVE_GFC_COMPLEX_${k}" + echo "#define GFC_REAL_${k}_HUGE ${huge}${suffix}" + echo "#define GFC_REAL_${k}_LITERAL_SUFFIX ${suffix}" + if [ "x$suffix" = "x" ]; then + echo "#define GFC_REAL_${k}_LITERAL(X) (X)" + else + echo "#define GFC_REAL_${k}_LITERAL(X) (X ## ${suffix})" + fi + echo "#define GFC_REAL_${k}_DIGITS ${digits}" + echo "#define GFC_REAL_${k}_RADIX ${radix}" + echo "" + fi + rm -f tmp$$.* +done + + +# After this, we include a header that can override some of the +# autodetected settings. +echo '#include "kinds-override.h"' + +exit 0 diff --git a/libgfortran/mk-sik-inc.sh b/libgfortran/mk-sik-inc.sh new file mode 100755 index 000000000..68c042f68 --- /dev/null +++ b/libgfortran/mk-sik-inc.sh @@ -0,0 +1,34 @@ +#!/bin/sh + +compile="$1" +kinds="" +possible_kinds="1 2 4 8 16" +c=0 + +for k in $possible_kinds; do + echo " integer (kind=$k) :: x" > tmp$$.f90 + echo " x = 1_$k" >> tmp$$.f90 + echo " end" >> tmp$$.f90 + if $compile -S tmp$$.f90 > /dev/null 2>&1; then + kinds="$kinds $k" + c=`expr $c + 1` + fi + rm -f tmp$$.* +done + +echo " integer, parameter :: c = $c" +echo " type (int_info), parameter :: int_infos(c) = (/ &" + +i=0 +for k in $kinds; do + # echo -n is not portable + str=" int_info ($k, range(0_$k))" + i=`expr $i + 1` + if [ $i -lt $c ]; then + echo "$str, &" + else + echo "$str /)" + fi +done + +exit 0 diff --git a/libgfortran/mk-srk-inc.sh b/libgfortran/mk-srk-inc.sh new file mode 100755 index 000000000..402441ce6 --- /dev/null +++ b/libgfortran/mk-srk-inc.sh @@ -0,0 +1,34 @@ +#!/bin/sh + +compile="$1" +kinds="" +possible_kinds="4 8 10 16" +c=0 + +for k in $possible_kinds; do + echo " real (kind=$k) :: x" > tmp$$.f90 + echo " x = 1.0_$k" >> tmp$$.f90 + echo " end" >> tmp$$.f90 + if $compile -S tmp$$.f90 > /dev/null 2>&1; then + kinds="$kinds $k" + c=`expr $c + 1` + fi + rm -f tmp$$.* +done + +echo " integer, parameter :: c = $c" +echo " type (real_info), parameter :: real_infos(c) = (/ &" + +i=0 +for k in $kinds; do + # echo -n is not portable + str=" real_info ($k, precision(0.0_$k), range(0.0_$k), radix(0.0_$k))" + i=`expr $i + 1` + if [ $i -lt $c ]; then + echo "$str, &" + else + echo "$str /)" + fi +done + +exit 0 diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c new file mode 100644 index 000000000..4a831c0d8 --- /dev/null +++ b/libgfortran/runtime/backtrace.c @@ -0,0 +1,326 @@ +/* Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include + +#ifdef HAVE_STDLIB_H +#include +#endif + +#ifdef HAVE_INTTYPES_H +#include +#endif + +#ifdef HAVE_UNISTD_H +#include +#endif + +#ifdef HAVE_EXECINFO_H +#include +#endif + +#ifdef HAVE_SYS_WAIT_H +#include +#endif + +#include + + +/* Macros for common sets of capabilities: can we fork and exec, can + we use glibc-style backtrace functions, and can we use pipes. */ +#define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \ + && defined(HAVE_WAIT)) +#define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \ + && defined(HAVE_BACKTRACE_SYMBOLS)) +#define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \ + && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \ + && defined(HAVE_CLOSE)) + + +#if GLIBC_BACKTRACE && CAN_PIPE +static char * +local_strcasestr (const char *s1, const char *s2) +{ +#ifdef HAVE_STRCASESTR + return strcasestr (s1, s2); +#else + + const char *p = s1; + const size_t len = strlen (s2); + const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2) + : (islower((int) *s2) ? toupper((int) *s2) + : *s2); + + while (1) + { + while (*p != u && *p != v && *p) + p++; + if (*p == 0) + return NULL; + if (strncasecmp (p, s2, len) == 0) + return (char *)p; + } +#endif +} +#endif + + +#if GLIBC_BACKTRACE +static void +dump_glibc_backtrace (int depth, char *str[]) +{ + int i; + + for (i = 0; i < depth; i++) + st_printf (" + %s\n", str[i]); + + free (str); +} +#endif + +/* show_backtrace displays the backtrace, currently obtained by means of + the glibc backtrace* functions. */ +void +show_backtrace (void) +{ +#if GLIBC_BACKTRACE + +#define DEPTH 50 +#define BUFSIZE 1024 + + void *trace[DEPTH]; + char **str; + int depth; + + depth = backtrace (trace, DEPTH); + if (depth <= 0) + return; + + str = backtrace_symbols (trace, depth); + +#if CAN_PIPE + +#ifndef STDIN_FILENO +#define STDIN_FILENO 0 +#endif + +#ifndef STDOUT_FILENO +#define STDOUT_FILENO 1 +#endif + +#ifndef STDERR_FILENO +#define STDERR_FILENO 2 +#endif + + /* We attempt to extract file and line information from addr2line. */ + do + { + /* Local variables. */ + int f[2], pid, line, i; + FILE *output; + char addr_buf[DEPTH][GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE]; + char *p, *end; + const char *addr[DEPTH]; + + /* Write the list of addresses in hexadecimal format. */ + for (i = 0; i < depth; i++) + addr[i] = gfc_xtoa ((GFC_UINTEGER_LARGEST) (intptr_t) trace[i], addr_buf[i], + sizeof (addr_buf[i])); + + /* Don't output an error message if something goes wrong, we'll simply + fall back to the pstack and glibc backtraces. */ + if (pipe (f) != 0) + break; + if ((pid = fork ()) == -1) + break; + + if (pid == 0) + { + /* Child process. */ +#define NUM_FIXEDARGS 5 + char *arg[DEPTH+NUM_FIXEDARGS+1]; + + close (f[0]); + close (STDIN_FILENO); + close (STDERR_FILENO); + + if (dup2 (f[1], STDOUT_FILENO) == -1) + _exit (0); + close (f[1]); + + arg[0] = (char *) "addr2line"; + arg[1] = (char *) "-e"; + arg[2] = full_exe_path (); + arg[3] = (char *) "-f"; + arg[4] = (char *) "-s"; + for (i = 0; i < depth; i++) + arg[NUM_FIXEDARGS+i] = (char *) addr[i]; + arg[NUM_FIXEDARGS+depth] = NULL; + execvp (arg[0], arg); + _exit (0); +#undef NUM_FIXEDARGS + } + + /* Father process. */ + close (f[1]); + wait (NULL); + output = fdopen (f[0], "r"); + i = -1; + + if (fgets (func, sizeof(func), output)) + { + st_printf ("\nBacktrace for this error:\n"); + + do + { + if (! fgets (file, sizeof(file), output)) + goto fallback; + + i++; + + for (p = func; *p != '\n' && *p != '\r'; p++) + ; + + *p = '\0'; + + /* Try to recognize the internal libgfortran functions. */ + if (strncasecmp (func, "*_gfortran", 10) == 0 + || strncasecmp (func, "_gfortran", 9) == 0 + || strcmp (func, "main") == 0 || strcmp (func, "_start") == 0 + || strcmp (func, "_gfortrani_handler") == 0) + continue; + + if (local_strcasestr (str[i], "libgfortran.so") != NULL + || local_strcasestr (str[i], "libgfortran.dylib") != NULL + || local_strcasestr (str[i], "libgfortran.a") != NULL) + continue; + + /* If we only have the address, use the glibc backtrace. */ + if (func[0] == '?' && func[1] == '?' && file[0] == '?' + && file[1] == '?') + { + st_printf (" + %s\n", str[i]); + continue; + } + + /* Extract the line number. */ + for (end = NULL, p = file; *p; p++) + if (*p == ':') + end = p; + if (end != NULL) + { + *end = '\0'; + line = atoi (++end); + } + else + line = -1; + + if (strcmp (func, "MAIN__") == 0) + st_printf (" + in the main program\n"); + else + st_printf (" + function %s (0x%s)\n", func, addr[i]); + + if (line <= 0 && strcmp (file, "??") == 0) + continue; + + if (line <= 0) + st_printf (" from file %s\n", file); + else + st_printf (" at line %d of file %s\n", line, file); + } + while (fgets (func, sizeof(func), output)); + + free (str); + return; + +fallback: + st_printf ("** Something went wrong while running addr2line. **\n" + "** Falling back to a simpler backtrace scheme. **\n"); + } + } + while (0); + +#undef DEPTH +#undef BUFSIZE + +#endif +#endif + +#if CAN_FORK && defined(HAVE_GETPPID) + /* Try to call pstack. */ + do + { + /* Local variables. */ + int pid; + + /* Don't output an error message if something goes wrong, we'll simply + fall back to the pstack and glibc backtraces. */ + if ((pid = fork ()) == -1) + break; + + if (pid == 0) + { + /* Child process. */ +#define NUM_ARGS 2 + char *arg[NUM_ARGS+1]; + char buf[20]; + + st_printf ("\nBacktrace for this error:\n"); + arg[0] = (char *) "pstack"; +#ifdef HAVE_SNPRINTF + snprintf (buf, sizeof(buf), "%d", (int) getppid ()); +#else + sprintf (buf, "%d", (int) getppid ()); +#endif + arg[1] = buf; + arg[2] = NULL; + execvp (arg[0], arg); +#undef NUM_ARGS + + /* pstack didn't work, so we fall back to dumping the glibc + backtrace if we can. */ +#if GLIBC_BACKTRACE + dump_glibc_backtrace (depth, str); +#else + st_printf (" unable to produce a backtrace, sorry!\n"); +#endif + + _exit (0); + } + + /* Father process. */ + wait (NULL); + return; + } + while(0); +#endif + +#if GLIBC_BACKTRACE + /* Fallback to the glibc backtrace. */ + st_printf ("\nBacktrace for this error:\n"); + dump_glibc_backtrace (depth, str); +#endif +} diff --git a/libgfortran/runtime/bounds.c b/libgfortran/runtime/bounds.c new file mode 100644 index 000000000..35bfa1e2a --- /dev/null +++ b/libgfortran/runtime/bounds.c @@ -0,0 +1,272 @@ +/* Copyright (C) 2009 + Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + +/* Auxiliary functions for bounds checking, mostly to reduce library size. */ + +/* Bounds checking for the return values of the iforeach functions (such + as maxloc and minloc). The extent of ret_array must + must match the rank of array. */ + +void +bounds_iforeach_return (array_t *retarray, array_t *array, const char *name) +{ + index_type rank; + index_type ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + + if (ret_rank != 1) + runtime_error ("Incorrect rank of return array in %s intrinsic:" + "is %ld, should be 1", name, (long int) ret_rank); + + rank = GFC_DESCRIPTOR_RANK (array); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " %s intrinsic: is %ld, should be %ld", + name, (long int) ret_extent, (long int) rank); + +} + +/* Check the return of functions generated from ifunction.m4. + We check the array descriptor "a" against the extents precomputed + from ifunction.m4, and complain about the argument a_name in the + intrinsic function. */ + +void +bounds_ifunction_return (array_t * a, const index_type * extent, + const char * a_name, const char * intrinsic) +{ + int empty; + int n; + int rank; + index_type a_size; + + rank = GFC_DESCRIPTOR_RANK (a); + a_size = size0 (a); + + empty = 0; + for (n = 0; n < rank; n++) + { + if (extent[n] == 0) + empty = 1; + } + if (empty) + { + if (a_size != 0) + runtime_error ("Incorrect size in %s of %s" + " intrinsic: should be zero-sized", + a_name, intrinsic); + } + else + { + if (a_size == 0) + runtime_error ("Incorrect size of %s in %s" + " intrinsic: should not be zero-sized", + a_name, intrinsic); + + for (n = 0; n < rank; n++) + { + index_type a_extent; + a_extent = GFC_DESCRIPTOR_EXTENT(a, n); + if (a_extent != extent[n]) + runtime_error("Incorrect extent in %s of %s" + " intrinsic in dimension %ld: is %ld," + " should be %ld", a_name, intrinsic, (long int) n + 1, + (long int) a_extent, (long int) extent[n]); + + } + } +} + +/* Check that two arrays have equal extents, or are both zero-sized. Abort + with a runtime error if this is not the case. Complain that a has the + wrong size. */ + +void +bounds_equal_extents (array_t *a, array_t *b, const char *a_name, + const char *intrinsic) +{ + index_type a_size, b_size, n; + + assert (GFC_DESCRIPTOR_RANK(a) == GFC_DESCRIPTOR_RANK(b)); + + a_size = size0 (a); + b_size = size0 (b); + + if (b_size == 0) + { + if (a_size != 0) + runtime_error ("Incorrect size of %s in %s" + " intrinsic: should be zero-sized", + a_name, intrinsic); + } + else + { + if (a_size == 0) + runtime_error ("Incorrect size of %s of %s" + " intrinsic: Should not be zero-sized", + a_name, intrinsic); + + for (n = 0; n < GFC_DESCRIPTOR_RANK (b); n++) + { + index_type a_extent, b_extent; + + a_extent = GFC_DESCRIPTOR_EXTENT(a, n); + b_extent = GFC_DESCRIPTOR_EXTENT(b, n); + if (a_extent != b_extent) + runtime_error("Incorrect extent in %s of %s" + " intrinsic in dimension %ld: is %ld," + " should be %ld", a_name, intrinsic, (long int) n + 1, + (long int) a_extent, (long int) b_extent); + } + } +} + +/* Check that the extents of a and b agree, except that a has a missing + dimension in argument which. Complain about a if anything is wrong. */ + +void +bounds_reduced_extents (array_t *a, array_t *b, int which, const char *a_name, + const char *intrinsic) +{ + + index_type i, n, a_size, b_size; + + assert (GFC_DESCRIPTOR_RANK(a) == GFC_DESCRIPTOR_RANK(b) - 1); + + a_size = size0 (a); + b_size = size0 (b); + + if (b_size == 0) + { + if (a_size != 0) + runtime_error ("Incorrect size in %s of %s" + " intrinsic: should not be zero-sized", + a_name, intrinsic); + } + else + { + if (a_size == 0) + runtime_error ("Incorrect size of %s of %s" + " intrinsic: should be zero-sized", + a_name, intrinsic); + + i = 0; + for (n = 0; n < GFC_DESCRIPTOR_RANK (b); n++) + { + index_type a_extent, b_extent; + + if (n != which) + { + a_extent = GFC_DESCRIPTOR_EXTENT(a, i); + b_extent = GFC_DESCRIPTOR_EXTENT(b, n); + if (a_extent != b_extent) + runtime_error("Incorrect extent in %s of %s" + " intrinsic in dimension %ld: is %ld," + " should be %ld", a_name, intrinsic, (long int) i + 1, + (long int) a_extent, (long int) b_extent); + i++; + } + } + } +} + +/* count_0 - count all the true elements in an array. The front + end usually inlines this, we need this for bounds checking + for unpack. */ + +index_type count_0 (const gfc_array_l1 * array) +{ + const GFC_LOGICAL_1 * restrict base; + index_type rank; + int kind; + int continue_loop; + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type result; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + kind = GFC_DESCRIPTOR_SIZE (array); + + base = array->data; + + if (kind == 1 || kind == 2 || kind == 4 || kind == 8 +#ifdef HAVE_GFC_LOGICAL_16 + || kind == 16 +#endif + ) + { + if (base) + base = GFOR_POINTER_TO_L1 (base, kind); + } + else + internal_error (NULL, "Funny sized logical array in count_0"); + + for (n = 0; n < rank; n++) + { + sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + count[n] = 0; + + if (extent[n] <= 0) + return 0; + } + + result = 0; + continue_loop = 1; + while (continue_loop) + { + if (*base) + result ++; + + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + count[n] = 0; + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + continue_loop = 0; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + return result; +} diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c new file mode 100644 index 000000000..62c401be6 --- /dev/null +++ b/libgfortran/runtime/compile_options.c @@ -0,0 +1,197 @@ +/* Handling of compile-time options that influence the library. + Copyright (C) 2005, 2007, 2009, 2010 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#ifdef HAVE_SIGNAL_H +#include +#endif + + +/* Useful compile-time options will be stored in here. */ +compile_options_t compile_options; + + +/* A signal handler to allow us to output a backtrace. */ +void +handler (int signum) +{ + const char * name = NULL, * desc = NULL; + + switch (signum) + { +#if defined(SIGSEGV) + case SIGSEGV: + name = "SIGSEGV"; + desc = "Segmentation fault"; + break; +#endif + +#if defined(SIGBUS) + case SIGBUS: + name = "SIGBUS"; + desc = "Bus error"; + break; +#endif + +#if defined(SIGILL) + case SIGILL: + name = "SIGILL"; + desc = "Illegal instruction"; + break; +#endif + +#if defined(SIGFPE) + case SIGFPE: + name = "SIGFPE"; + desc = "Floating-point exception"; + break; +#endif + } + + if (name) + st_printf ("\nProgram received signal %d (%s): %s.\n", signum, name, desc); + else + st_printf ("\nProgram received signal %d.\n", signum); + + sys_exit (5); +} + + +/* Set the usual compile-time options. */ +extern void set_options (int , int []); +export_proto(set_options); + +void +set_options (int num, int options[]) +{ + if (num >= 1) + compile_options.warn_std = options[0]; + if (num >= 2) + compile_options.allow_std = options[1]; + if (num >= 3) + compile_options.pedantic = options[2]; + if (num >= 4) + compile_options.dump_core = options[3]; + if (num >= 5) + compile_options.backtrace = options[4]; + if (num >= 6) + compile_options.sign_zero = options[5]; + if (num >= 7) + compile_options.bounds_check = options[6]; + if (num >= 8) + compile_options.range_check = options[7]; + + /* If backtrace is required, we set signal handlers on most common + signals. */ +#if defined(HAVE_SIGNAL) && (defined(SIGSEGV) || defined(SIGBUS) \ + || defined(SIGILL) || defined(SIGFPE)) + if (compile_options.backtrace) + { +#if defined(SIGSEGV) + signal (SIGSEGV, handler); +#endif + +#if defined(SIGBUS) + signal (SIGBUS, handler); +#endif + +#if defined(SIGILL) + signal (SIGILL, handler); +#endif + +#if defined(SIGFPE) + signal (SIGFPE, handler); +#endif + } +#endif + +} + + +/* Default values for the compile-time options. Keep in sync with + gcc/fortran/options.c (gfc_init_options). */ +void +init_compile_options (void) +{ + compile_options.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY; + compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL + | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77 + | GFC_STD_F2008_OBS | GFC_STD_GNU | GFC_STD_LEGACY; + compile_options.pedantic = 0; + compile_options.dump_core = 0; + compile_options.backtrace = 0; + compile_options.sign_zero = 1; + compile_options.range_check = 1; +} + +/* Function called by the front-end to tell us the + default for unformatted data conversion. */ + +extern void set_convert (int); +export_proto (set_convert); + +void +set_convert (int conv) +{ + compile_options.convert = conv; +} + +extern void set_record_marker (int); +export_proto (set_record_marker); + + +void +set_record_marker (int val) +{ + + switch(val) + { + case 4: + compile_options.record_marker = sizeof (GFC_INTEGER_4); + break; + + case 8: + compile_options.record_marker = sizeof (GFC_INTEGER_8); + break; + + default: + runtime_error ("Invalid value for record marker"); + break; + } +} + +extern void set_max_subrecord_length (int); +export_proto (set_max_subrecord_length); + +void set_max_subrecord_length(int val) +{ + if (val > GFC_MAX_SUBRECORD_LENGTH || val < 1) + { + runtime_error ("Invalid value for maximum subrecord length"); + return; + } + + compile_options.max_subrecord_length = val; +} diff --git a/libgfortran/runtime/convert_char.c b/libgfortran/runtime/convert_char.c new file mode 100644 index 000000000..540c2bfdb --- /dev/null +++ b/libgfortran/runtime/convert_char.c @@ -0,0 +1,69 @@ +/* Runtime conversion of strings from one character kind to another. + Copyright 2008, 2009 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include + + +extern void convert_char1_to_char4 (gfc_char4_t **, gfc_charlen_type, + const unsigned char *); +export_proto(convert_char1_to_char4); + +extern void convert_char4_to_char1 (unsigned char **, gfc_charlen_type, + const gfc_char4_t *); +export_proto(convert_char4_to_char1); + + +void +convert_char1_to_char4 (gfc_char4_t **dst, gfc_charlen_type len, + const unsigned char *src) +{ + gfc_charlen_type i, l; + + l = len > 0 ? len : 0; + *dst = get_mem ((l + 1) * sizeof (gfc_char4_t)); + + for (i = 0; i < l; i++) + (*dst)[i] = src[i]; + + (*dst)[l] = '\0'; +} + + +void +convert_char4_to_char1 (unsigned char **dst, gfc_charlen_type len, + const gfc_char4_t *src) +{ + gfc_charlen_type i, l; + + l = len > 0 ? len : 0; + *dst = get_mem ((l + 1) * sizeof (unsigned char)); + + for (i = 0; i < l; i++) + (*dst)[i] = src[i]; + + (*dst)[l] = '\0'; +} diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c new file mode 100644 index 000000000..accf2b10c --- /dev/null +++ b/libgfortran/runtime/environ.c @@ -0,0 +1,851 @@ +/* Copyright (C) 2002, 2003, 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Andy Vaught + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +#include +#include +#include + + +/* Environment scanner. Examine the environment for controlling minor + * aspects of the program's execution. Our philosophy here that the + * environment should not prevent the program from running, so an + * environment variable with a messed-up value will be interpreted in + * the default way. + * + * Most of the environment is checked early in the startup sequence, + * but other variables are checked during execution of the user's + * program. */ + +options_t options; + + +typedef struct variable +{ + const char *name; + int value, *var; + void (*init) (struct variable *); + void (*show) (struct variable *); + const char *desc; + int bad; +} +variable; + +static void init_unformatted (variable *); + +/* print_spaces()-- Print a particular number of spaces. */ + +static void +print_spaces (int n) +{ + char buffer[80]; + int i; + + if (n <= 0) + return; + + for (i = 0; i < n; i++) + buffer[i] = ' '; + + buffer[i] = '\0'; + + st_printf (buffer); +} + + +/* var_source()-- Return a string that describes where the value of a + * variable comes from */ + +static const char * +var_source (variable * v) +{ + if (getenv (v->name) == NULL) + return "Default"; + + if (v->bad) + return "Bad "; + + return "Set "; +} + + +/* init_integer()-- Initialize an integer environment variable. */ + +static void +init_integer (variable * v) +{ + char *p, *q; + + p = getenv (v->name); + if (p == NULL) + goto set_default; + + for (q = p; *q; q++) + if (!isdigit (*q) && (p != q || *q != '-')) + { + v->bad = 1; + goto set_default; + } + + *v->var = atoi (p); + return; + + set_default: + *v->var = v->value; + return; +} + + +/* init_unsigned_integer()-- Initialize an integer environment variable + which has to be positive. */ + +static void +init_unsigned_integer (variable * v) +{ + char *p, *q; + + p = getenv (v->name); + if (p == NULL) + goto set_default; + + for (q = p; *q; q++) + if (!isdigit (*q)) + { + v->bad = 1; + goto set_default; + } + + *v->var = atoi (p); + return; + + set_default: + *v->var = v->value; + return; +} + + +/* show_integer()-- Show an integer environment variable */ + +static void +show_integer (variable * v) +{ + st_printf ("%s %d\n", var_source (v), *v->var); +} + + +/* init_boolean()-- Initialize a boolean environment variable. We + * only look at the first letter of the variable. */ + +static void +init_boolean (variable * v) +{ + char *p; + + p = getenv (v->name); + if (p == NULL) + goto set_default; + + if (*p == '1' || *p == 'Y' || *p == 'y') + { + *v->var = 1; + return; + } + + if (*p == '0' || *p == 'N' || *p == 'n') + { + *v->var = 0; + return; + } + + v->bad = 1; + +set_default: + *v->var = v->value; + return; +} + + +/* show_boolean()-- Show a boolean environment variable */ + +static void +show_boolean (variable * v) +{ + st_printf ("%s %s\n", var_source (v), *v->var ? "Yes" : "No"); +} + + +static void +init_sep (variable * v) +{ + int seen_comma; + char *p; + + p = getenv (v->name); + if (p == NULL) + goto set_default; + + v->bad = 1; + options.separator = p; + options.separator_len = strlen (p); + + /* Make sure the separator is valid */ + + if (options.separator_len == 0) + goto set_default; + seen_comma = 0; + + while (*p) + { + if (*p == ',') + { + if (seen_comma) + goto set_default; + seen_comma = 1; + p++; + continue; + } + + if (*p++ != ' ') + goto set_default; + } + + v->bad = 0; + return; + +set_default: + options.separator = " "; + options.separator_len = 1; +} + + +static void +show_sep (variable * v) +{ + st_printf ("%s \"%s\"\n", var_source (v), options.separator); +} + + +static void +init_string (variable * v __attribute__ ((unused))) +{ +} + +static void +show_string (variable * v) +{ + const char *p; + + p = getenv (v->name); + if (p == NULL) + p = ""; + + st_printf ("%s \"%s\"\n", var_source (v), p); +} + + +static variable variable_table[] = { + {"GFORTRAN_STDIN_UNIT", GFC_STDIN_UNIT_NUMBER, &options.stdin_unit, + init_integer, show_integer, + "Unit number that will be preconnected to standard input\n" + "(No preconnection if negative)", 0}, + + {"GFORTRAN_STDOUT_UNIT", GFC_STDOUT_UNIT_NUMBER, &options.stdout_unit, + init_integer, show_integer, + "Unit number that will be preconnected to standard output\n" + "(No preconnection if negative)", 0}, + + {"GFORTRAN_STDERR_UNIT", GFC_STDERR_UNIT_NUMBER, &options.stderr_unit, + init_integer, show_integer, + "Unit number that will be preconnected to standard error\n" + "(No preconnection if negative)", 0}, + + {"GFORTRAN_USE_STDERR", 1, &options.use_stderr, init_boolean, + show_boolean, + "Sends library output to standard error instead of standard output.", 0}, + + {"GFORTRAN_TMPDIR", 0, NULL, init_string, show_string, + "Directory for scratch files. Overrides the TMP environment variable\n" + "If TMP is not set " DEFAULT_TEMPDIR " is used.", 0}, + + {"GFORTRAN_UNBUFFERED_ALL", 0, &options.all_unbuffered, init_boolean, + show_boolean, + "If TRUE, all output is unbuffered. This will slow down large writes " + "but can be\nuseful for forcing data to be displayed immediately.", 0}, + + {"GFORTRAN_UNBUFFERED_PRECONNECTED", 0, &options.unbuffered_preconnected, + init_boolean, show_boolean, + "If TRUE, output to preconnected units is unbuffered.", 0}, + + {"GFORTRAN_SHOW_LOCUS", 1, &options.locus, init_boolean, show_boolean, + "If TRUE, print filename and line number where runtime errors happen.", 0}, + + {"GFORTRAN_OPTIONAL_PLUS", 0, &options.optional_plus, init_boolean, show_boolean, + "Print optional plus signs in numbers where permitted. Default FALSE.", 0}, + + {"GFORTRAN_DEFAULT_RECL", DEFAULT_RECL, &options.default_recl, + init_unsigned_integer, show_integer, + "Default maximum record length for sequential files. Most useful for\n" + "adjusting line length of preconnected units. Default " + stringize (DEFAULT_RECL), 0}, + + {"GFORTRAN_LIST_SEPARATOR", 0, NULL, init_sep, show_sep, + "Separator to use when writing list output. May contain any number of " + "spaces\nand at most one comma. Default is a single space.", 0}, + + /* GFORTRAN_CONVERT_UNIT - Set the default data conversion for + unformatted I/O. */ + {"GFORTRAN_CONVERT_UNIT", 0, 0, init_unformatted, show_string, + "Set format for unformatted files", 0}, + + /* Behaviour when encoutering a runtime error. */ + {"GFORTRAN_ERROR_DUMPCORE", -1, &options.dump_core, + init_boolean, show_boolean, + "Dump a core file (if possible) on runtime error", -1}, + + {"GFORTRAN_ERROR_BACKTRACE", -1, &options.backtrace, + init_boolean, show_boolean, + "Print out a backtrace (if possible) on runtime error", -1}, + + {NULL, 0, NULL, NULL, NULL, NULL, 0} +}; + + +/* init_variables()-- Initialize most runtime variables from + * environment variables. */ + +void +init_variables (void) +{ + variable *v; + + for (v = variable_table; v->name; v++) + v->init (v); +} + + +void +show_variables (void) +{ + variable *v; + int n; + + /* TODO: print version number. */ + st_printf ("GNU Fortran 95 runtime library version " + "UNKNOWN" "\n\n"); + + st_printf ("Environment variables:\n"); + st_printf ("----------------------\n"); + + for (v = variable_table; v->name; v++) + { + n = st_printf ("%s", v->name); + print_spaces (25 - n); + + if (v->show == show_integer) + st_printf ("Integer "); + else if (v->show == show_boolean) + st_printf ("Boolean "); + else + st_printf ("String "); + + v->show (v); + st_printf ("%s\n\n", v->desc); + } + + /* System error codes */ + + st_printf ("\nRuntime error codes:"); + st_printf ("\n--------------------\n"); + + for (n = LIBERROR_FIRST + 1; n < LIBERROR_LAST; n++) + if (n < 0 || n > 9) + st_printf ("%d %s\n", n, translate_error (n)); + else + st_printf (" %d %s\n", n, translate_error (n)); + + st_printf ("\nCommand line arguments:\n"); + st_printf (" --help Print this list\n"); + + /* st_printf(" --resume Resume program execution from dropfile\n"); */ + + sys_exit (0); +} + +/* This is the handling of the GFORTRAN_CONVERT_UNITS environment variable. + It is called from environ.c to parse this variable, and from + open.c to determine if the user specified a default for an + unformatted file. + The syntax of the environment variable is, in bison grammar: + + GFORTRAN_CONVERT_UNITS: mode | mode ';' exception ; + mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ; + exception: mode ':' unit_list | unit_list ; + unit_list: unit_spec | unit_list unit_spec ; + unit_spec: INTEGER | INTEGER '-' INTEGER ; +*/ + +/* Defines for the tokens. Other valid tokens are ',', ':', '-'. */ + + +#define NATIVE 257 +#define SWAP 258 +#define BIG 259 +#define LITTLE 260 +/* Some space for additional tokens later. */ +#define INTEGER 273 +#define END (-1) +#define ILLEGAL (-2) + +typedef struct +{ + int unit; + unit_convert conv; +} exception_t; + + +static char *p; /* Main character pointer for parsing. */ +static char *lastpos; /* Auxiliary pointer, for backing up. */ +static int unit_num; /* The last unit number read. */ +static int unit_count; /* The number of units found. */ +static int do_count; /* Parsing is done twice - first to count the number + of units, then to fill in the table. This + variable controls what to do. */ +static exception_t *elist; /* The list of exceptions to the default. This is + sorted according to unit number. */ +static int n_elist; /* Number of exceptions to the default. */ + +static unit_convert endian; /* Current endianness. */ + +static unit_convert def; /* Default as specified (if any). */ + +/* Search for a unit number, using a binary search. The + first argument is the unit number to search for. The second argument + is a pointer to an index. + If the unit number is found, the function returns 1, and the index + is that of the element. + If the unit number is not found, the function returns 0, and the + index is the one where the element would be inserted. */ + +static int +search_unit (int unit, int *ip) +{ + int low, high, mid; + + if (n_elist == 0) + { + *ip = 0; + return 0; + } + + low = 0; + high = n_elist - 1; + + do + { + mid = (low + high) / 2; + if (unit == elist[mid].unit) + { + *ip = mid; + return 1; + } + else if (unit > elist[mid].unit) + low = mid + 1; + else + high = mid - 1; + } while (low <= high); + + if (unit > elist[mid].unit) + *ip = mid + 1; + else + *ip = mid; + + return 0; +} + +/* This matches a keyword. If it is found, return the token supplied, + otherwise return ILLEGAL. */ + +static int +match_word (const char *word, int tok) +{ + int res; + + if (strncasecmp (p, word, strlen (word)) == 0) + { + p += strlen (word); + res = tok; + } + else + res = ILLEGAL; + return res; + +} + +/* Match an integer and store its value in unit_num. This only works + if p actually points to the start of an integer. The caller has + to ensure this. */ + +static int +match_integer (void) +{ + unit_num = 0; + while (isdigit (*p)) + unit_num = unit_num * 10 + (*p++ - '0'); + return INTEGER; + +} + +/* This reads the next token from the GFORTRAN_CONVERT_UNITS variable. + Returned values are the different tokens. */ + +static int +next_token (void) +{ + int result; + + lastpos = p; + switch (*p) + { + case '\0': + result = END; + break; + + case ':': + case ',': + case '-': + case ';': + result = *p; + p++; + break; + + case 'b': + case 'B': + result = match_word ("big_endian", BIG); + break; + + case 'l': + case 'L': + result = match_word ("little_endian", LITTLE); + break; + + case 'n': + case 'N': + result = match_word ("native", NATIVE); + break; + + case 's': + case 'S': + result = match_word ("swap", SWAP); + break; + + case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + result = match_integer (); + break; + + default: + result = ILLEGAL; + break; + } + return result; +} + +/* Back up the last token by setting back the character pointer. */ + +static void +push_token (void) +{ + p = lastpos; +} + +/* This is called when a unit is identified. If do_count is nonzero, + increment the number of units by one. If do_count is zero, + put the unit into the table. */ + +static void +mark_single (int unit) +{ + int i,j; + + if (do_count) + { + unit_count++; + return; + } + if (search_unit (unit, &i)) + { + elist[i].conv = endian; + } + else + { + for (j=n_elist-1; j>=i; j--) + elist[j+1] = elist[j]; + + n_elist += 1; + elist[i].unit = unit; + elist[i].conv = endian; + } +} + +/* This is called when a unit range is identified. If do_count is + nonzero, increase the number of units. If do_count is zero, + put the unit into the table. */ + +static void +mark_range (int unit1, int unit2) +{ + int i; + if (do_count) + unit_count += abs (unit2 - unit1) + 1; + else + { + if (unit2 < unit1) + for (i=unit2; i<=unit1; i++) + mark_single (i); + else + for (i=unit1; i<=unit2; i++) + mark_single (i); + } +} + +/* Parse the GFORTRAN_CONVERT_UNITS variable. This is called + twice, once to count the units and once to actually mark them in + the table. When counting, we don't check for double occurrences + of units. */ + +static int +do_parse (void) +{ + int tok; + int unit1; + int continue_ulist; + char *start; + + unit_count = 0; + + start = p; + + /* Parse the string. First, let's look for a default. */ + tok = next_token (); + switch (tok) + { + case NATIVE: + endian = GFC_CONVERT_NATIVE; + break; + + case SWAP: + endian = GFC_CONVERT_SWAP; + break; + + case BIG: + endian = GFC_CONVERT_BIG; + break; + + case LITTLE: + endian = GFC_CONVERT_LITTLE; + break; + + case INTEGER: + /* A leading digit means that we are looking at an exception. + Reset the position to the beginning, and continue processing + at the exception list. */ + p = start; + goto exceptions; + break; + + case END: + goto end; + break; + + default: + goto error; + break; + } + + tok = next_token (); + switch (tok) + { + case ';': + def = endian; + break; + + case ':': + /* This isn't a default after all. Reset the position to the + beginning, and continue processing at the exception list. */ + p = start; + goto exceptions; + break; + + case END: + def = endian; + goto end; + break; + + default: + goto error; + break; + } + + exceptions: + + /* Loop over all exceptions. */ + while(1) + { + tok = next_token (); + switch (tok) + { + case NATIVE: + if (next_token () != ':') + goto error; + endian = GFC_CONVERT_NATIVE; + break; + + case SWAP: + if (next_token () != ':') + goto error; + endian = GFC_CONVERT_SWAP; + break; + + case LITTLE: + if (next_token () != ':') + goto error; + endian = GFC_CONVERT_LITTLE; + break; + + case BIG: + if (next_token () != ':') + goto error; + endian = GFC_CONVERT_BIG; + break; + + case INTEGER: + push_token (); + break; + + case END: + goto end; + break; + + default: + goto error; + break; + } + /* We arrive here when we want to parse a list of + numbers. */ + continue_ulist = 1; + do + { + tok = next_token (); + if (tok != INTEGER) + goto error; + + unit1 = unit_num; + tok = next_token (); + /* The number can be followed by a - and another number, + which means that this is a unit range, a comma + or a semicolon. */ + if (tok == '-') + { + if (next_token () != INTEGER) + goto error; + + mark_range (unit1, unit_num); + tok = next_token (); + if (tok == END) + goto end; + else if (tok == ';') + continue_ulist = 0; + else if (tok != ',') + goto error; + } + else + { + mark_single (unit1); + switch (tok) + { + case ';': + continue_ulist = 0; + break; + + case ',': + break; + + case END: + goto end; + break; + + default: + goto error; + } + } + } while (continue_ulist); + } + end: + return 0; + error: + def = GFC_CONVERT_NONE; + return -1; +} + +void init_unformatted (variable * v) +{ + char *val; + val = getenv (v->name); + def = GFC_CONVERT_NONE; + n_elist = 0; + + if (val == NULL) + return; + do_count = 1; + p = val; + do_parse (); + if (do_count <= 0) + { + n_elist = 0; + elist = NULL; + } + else + { + elist = get_mem (unit_count * sizeof (exception_t)); + do_count = 0; + p = val; + do_parse (); + } +} + +/* Get the default conversion for for an unformatted unit. */ + +unit_convert +get_unformatted_convert (int unit) +{ + int i; + + if (elist == NULL) + return def; + else if (search_unit (unit, &i)) + return elist[i].conv; + else + return def; +} diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c new file mode 100644 index 000000000..06c144ae1 --- /dev/null +++ b/libgfortran/runtime/error.c @@ -0,0 +1,544 @@ +/* Copyright (C) 2002, 2003, 2005, 2006, 2007, 2009, 2010, 2011 + Free Software Foundation, Inc. + Contributed by Andy Vaught + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + + +#include "libgfortran.h" +#include +#include +#include + +#ifdef HAVE_SIGNAL_H +#include +#endif + +#ifdef HAVE_UNISTD_H +#include +#endif + +#ifdef HAVE_STDLIB_H +#include +#endif + +#ifdef HAVE_SYS_TIME_H +#include +#endif + +/* has to be included before to work + around PR 30518; otherwise, MacOS 10.3.9 headers are just broken. */ +#ifdef HAVE_SYS_RESOURCE_H +#include +#endif + + +#ifdef __MINGW32__ +#define HAVE_GETPID 1 +#include +#endif + + +/* sys_exit()-- Terminate the program with an exit code. */ + +void +sys_exit (int code) +{ + /* Show error backtrace if possible. */ + if (code != 0 && code != 4 + && (options.backtrace == 1 + || (options.backtrace == -1 && compile_options.backtrace == 1))) + show_backtrace (); + + /* Dump core if requested. */ + if (code != 0 + && (options.dump_core == 1 + || (options.dump_core == -1 && compile_options.dump_core == 1))) + { +#if defined(HAVE_GETRLIMIT) && defined(RLIMIT_CORE) + /* Warn if a core file cannot be produced because + of core size limit. */ + + struct rlimit core_limit; + + if (getrlimit (RLIMIT_CORE, &core_limit) == 0 && core_limit.rlim_cur == 0) + st_printf ("** Warning: a core dump was requested, but the core size" + "limit\n** is currently zero.\n\n"); +#endif + + +#if defined(HAVE_KILL) && defined(HAVE_GETPID) && defined(SIGQUIT) + kill (getpid (), SIGQUIT); +#else + st_printf ("Core dump not possible, sorry."); +#endif + } + + exit (code); +} + + +/* Error conditions. The tricky part here is printing a message when + * it is the I/O subsystem that is severely wounded. Our goal is to + * try and print something making the fewest assumptions possible, + * then try to clean up before actually exiting. + * + * The following exit conditions are defined: + * 0 Normal program exit. + * 1 Terminated because of operating system error. + * 2 Error in the runtime library + * 3 Internal error in runtime library + * 4 Error during error processing (very bad) + * + * Other error returns are reserved for the STOP statement with a numeric code. + */ + +/* gfc_xtoa()-- Integer to hexadecimal conversion. */ + +const char * +gfc_xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) +{ + int digit; + char *p; + + assert (len >= GFC_XTOA_BUF_SIZE); + + if (n == 0) + return "0"; + + p = buffer + GFC_XTOA_BUF_SIZE - 1; + *p = '\0'; + + while (n != 0) + { + digit = n & 0xF; + if (digit > 9) + digit += 'A' - '0' - 10; + + *--p = '0' + digit; + n >>= 4; + } + + return p; +} + + +/* Hopefully thread-safe wrapper for a strerror_r() style function. */ + +char * +gf_strerror (int errnum, + char * buf __attribute__((unused)), + size_t buflen __attribute__((unused))) +{ +#ifdef HAVE_STRERROR_R + /* TODO: How to prevent the compiler warning due to strerror_r of + the untaken branch having the wrong return type? */ + if (__builtin_classify_type (strerror_r (0, buf, 0)) == 5) + { + /* GNU strerror_r() */ + return strerror_r (errnum, buf, buflen); + } + else + { + /* POSIX strerror_r () */ + strerror_r (errnum, buf, buflen); + return buf; + } +#else + /* strerror () is not necessarily thread-safe, but should at least + be available everywhere. */ + return strerror (errnum); +#endif +} + + +/* show_locus()-- Print a line number and filename describing where + * something went wrong */ + +void +show_locus (st_parameter_common *cmp) +{ + static char *filename; + + if (!options.locus || cmp == NULL || cmp->filename == NULL) + return; + + if (cmp->unit > 0) + { + filename = filename_from_unit (cmp->unit); + if (filename != NULL) + { + st_printf ("At line %d of file %s (unit = %d, file = '%s')\n", + (int) cmp->line, cmp->filename, (int) cmp->unit, filename); + free (filename); + } + else + { + st_printf ("At line %d of file %s (unit = %d)\n", + (int) cmp->line, cmp->filename, (int) cmp->unit); + } + return; + } + + st_printf ("At line %d of file %s\n", (int) cmp->line, cmp->filename); +} + + +/* recursion_check()-- It's possible for additional errors to occur + * during fatal error processing. We detect this condition here and + * exit with code 4 immediately. */ + +#define MAGIC 0x20DE8101 + +static void +recursion_check (void) +{ + static int magic = 0; + + /* Don't even try to print something at this point */ + if (magic == MAGIC) + sys_exit (4); + + magic = MAGIC; +} + + +#define STRERR_MAXSZ 256 + +/* os_error()-- Operating system error. We get a message from the + * operating system, show it and leave. Some operating system errors + * are caught and processed by the library. If not, we come here. */ + +void +os_error (const char *message) +{ + char errmsg[STRERR_MAXSZ]; + recursion_check (); + st_printf ("Operating system error: %s\n%s\n", + gf_strerror (errno, errmsg, STRERR_MAXSZ), message); + sys_exit (1); +} +iexport(os_error); + + +/* void runtime_error()-- These are errors associated with an + * invalid fortran program. */ + +void +runtime_error (const char *message, ...) +{ + va_list ap; + + recursion_check (); + st_printf ("Fortran runtime error: "); + va_start (ap, message); + st_vprintf (message, ap); + va_end (ap); + st_printf ("\n"); + sys_exit (2); +} +iexport(runtime_error); + +/* void runtime_error_at()-- These are errors associated with a + * run time error generated by the front end compiler. */ + +void +runtime_error_at (const char *where, const char *message, ...) +{ + va_list ap; + + recursion_check (); + st_printf ("%s\n", where); + st_printf ("Fortran runtime error: "); + va_start (ap, message); + st_vprintf (message, ap); + va_end (ap); + st_printf ("\n"); + sys_exit (2); +} +iexport(runtime_error_at); + + +void +runtime_warning_at (const char *where, const char *message, ...) +{ + va_list ap; + + st_printf ("%s\n", where); + st_printf ("Fortran runtime warning: "); + va_start (ap, message); + st_vprintf (message, ap); + va_end (ap); + st_printf ("\n"); +} +iexport(runtime_warning_at); + + +/* void internal_error()-- These are this-can't-happen errors + * that indicate something deeply wrong. */ + +void +internal_error (st_parameter_common *cmp, const char *message) +{ + recursion_check (); + show_locus (cmp); + st_printf ("Internal Error: %s\n", message); + + /* This function call is here to get the main.o object file included + when linking statically. This works because error.o is supposed to + be always linked in (and the function call is in internal_error + because hopefully it doesn't happen too often). */ + stupid_function_name_for_static_linking(); + + sys_exit (3); +} + + +/* translate_error()-- Given an integer error code, return a string + * describing the error. */ + +const char * +translate_error (int code) +{ + const char *p; + + switch (code) + { + case LIBERROR_EOR: + p = "End of record"; + break; + + case LIBERROR_END: + p = "End of file"; + break; + + case LIBERROR_OK: + p = "Successful return"; + break; + + case LIBERROR_OS: + p = "Operating system error"; + break; + + case LIBERROR_BAD_OPTION: + p = "Bad statement option"; + break; + + case LIBERROR_MISSING_OPTION: + p = "Missing statement option"; + break; + + case LIBERROR_OPTION_CONFLICT: + p = "Conflicting statement options"; + break; + + case LIBERROR_ALREADY_OPEN: + p = "File already opened in another unit"; + break; + + case LIBERROR_BAD_UNIT: + p = "Unattached unit"; + break; + + case LIBERROR_FORMAT: + p = "FORMAT error"; + break; + + case LIBERROR_BAD_ACTION: + p = "Incorrect ACTION specified"; + break; + + case LIBERROR_ENDFILE: + p = "Read past ENDFILE record"; + break; + + case LIBERROR_BAD_US: + p = "Corrupt unformatted sequential file"; + break; + + case LIBERROR_READ_VALUE: + p = "Bad value during read"; + break; + + case LIBERROR_READ_OVERFLOW: + p = "Numeric overflow on read"; + break; + + case LIBERROR_INTERNAL: + p = "Internal error in run-time library"; + break; + + case LIBERROR_INTERNAL_UNIT: + p = "Internal unit I/O error"; + break; + + case LIBERROR_DIRECT_EOR: + p = "Write exceeds length of DIRECT access record"; + break; + + case LIBERROR_SHORT_RECORD: + p = "I/O past end of record on unformatted file"; + break; + + case LIBERROR_CORRUPT_FILE: + p = "Unformatted file structure has been corrupted"; + break; + + default: + p = "Unknown error code"; + break; + } + + return p; +} + + +/* generate_error()-- Come here when an error happens. This + * subroutine is called if it is possible to continue on after the error. + * If an IOSTAT or IOMSG variable exists, we set it. If IOSTAT or + * ERR labels are present, we return, otherwise we terminate the program + * after printing a message. The error code is always required but the + * message parameter can be NULL, in which case a string describing + * the most recent operating system error is used. */ + +void +generate_error (st_parameter_common *cmp, int family, const char *message) +{ + char errmsg[STRERR_MAXSZ]; + + /* If there was a previous error, don't mask it with another + error message, EOF or EOR condition. */ + + if ((cmp->flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_ERROR) + return; + + /* Set the error status. */ + if ((cmp->flags & IOPARM_HAS_IOSTAT)) + *cmp->iostat = (family == LIBERROR_OS) ? errno : family; + + if (message == NULL) + message = + (family == LIBERROR_OS) ? gf_strerror (errno, errmsg, STRERR_MAXSZ) : + translate_error (family); + + if (cmp->flags & IOPARM_HAS_IOMSG) + cf_strcpy (cmp->iomsg, cmp->iomsg_len, message); + + /* Report status back to the compiler. */ + cmp->flags &= ~IOPARM_LIBRETURN_MASK; + switch (family) + { + case LIBERROR_EOR: + cmp->flags |= IOPARM_LIBRETURN_EOR; + if ((cmp->flags & IOPARM_EOR)) + return; + break; + + case LIBERROR_END: + cmp->flags |= IOPARM_LIBRETURN_END; + if ((cmp->flags & IOPARM_END)) + return; + break; + + default: + cmp->flags |= IOPARM_LIBRETURN_ERROR; + if ((cmp->flags & IOPARM_ERR)) + return; + break; + } + + /* Return if the user supplied an iostat variable. */ + if ((cmp->flags & IOPARM_HAS_IOSTAT)) + return; + + /* Terminate the program */ + + recursion_check (); + show_locus (cmp); + st_printf ("Fortran runtime error: %s\n", message); + sys_exit (2); +} +iexport(generate_error); + + +/* generate_warning()-- Similar to generate_error but just give a warning. */ + +void +generate_warning (st_parameter_common *cmp, const char *message) +{ + if (message == NULL) + message = " "; + + show_locus (cmp); + st_printf ("Fortran runtime warning: %s\n", message); +} + + +/* Whether, for a feature included in a given standard set (GFC_STD_*), + we should issue an error or a warning, or be quiet. */ + +notification +notification_std (int std) +{ + int warning; + + if (!compile_options.pedantic) + return NOTIFICATION_SILENT; + + warning = compile_options.warn_std & std; + if ((compile_options.allow_std & std) != 0 && !warning) + return NOTIFICATION_SILENT; + + return warning ? NOTIFICATION_WARNING : NOTIFICATION_ERROR; +} + + +/* Possibly issue a warning/error about use of a nonstandard (or deleted) + feature. An error/warning will be issued if the currently selected + standard does not contain the requested bits. */ + +try +notify_std (st_parameter_common *cmp, int std, const char * message) +{ + int warning; + + if (!compile_options.pedantic) + return SUCCESS; + + warning = compile_options.warn_std & std; + if ((compile_options.allow_std & std) != 0 && !warning) + return SUCCESS; + + if (!warning) + { + recursion_check (); + show_locus (cmp); + st_printf ("Fortran runtime error: %s\n", message); + sys_exit (2); + } + else + { + show_locus (cmp); + st_printf ("Fortran runtime warning: %s\n", message); + } + return FAILURE; +} diff --git a/libgfortran/runtime/fpu.c b/libgfortran/runtime/fpu.c new file mode 100644 index 000000000..ce745dd60 --- /dev/null +++ b/libgfortran/runtime/fpu.c @@ -0,0 +1,41 @@ +/* Set FPU mask. + Copyright 2005 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + +/* We include the platform-dependent code. */ +#include "fpu-target.h" + +/* Function called by the front-end to tell us + when a FPE should be raised. */ +extern void set_fpe (int); +export_proto(set_fpe); + +void +set_fpe (int exceptions) +{ + options.fpe = exceptions; + set_fpu (); +} diff --git a/libgfortran/runtime/in_pack_generic.c b/libgfortran/runtime/in_pack_generic.c new file mode 100644 index 000000000..64ae66204 --- /dev/null +++ b/libgfortran/runtime/in_pack_generic.c @@ -0,0 +1,218 @@ +/* Generic helper function for repacking arrays. + Copyright 2003, 2004, 2005, 2007, 2009, 2010 + 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +extern void *internal_pack (gfc_array_char *); +export_proto(internal_pack); + +void * +internal_pack (gfc_array_char * 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 char *src; + char *dest; + void *destptr; + int n; + int packed; + index_type size; + index_type type_size; + + type_size = GFC_DTYPE_TYPE_SIZE(source); + size = GFC_DESCRIPTOR_SIZE (source); + switch (type_size) + { + case GFC_DTYPE_INTEGER_1: + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_DERIVED_1: + return internal_pack_1 ((gfc_array_i1 *) source); + + case GFC_DTYPE_INTEGER_2: + case GFC_DTYPE_LOGICAL_2: + return internal_pack_2 ((gfc_array_i2 *) source); + + case GFC_DTYPE_INTEGER_4: + case GFC_DTYPE_LOGICAL_4: + return internal_pack_4 ((gfc_array_i4 *) source); + + case GFC_DTYPE_INTEGER_8: + case GFC_DTYPE_LOGICAL_8: + return internal_pack_8 ((gfc_array_i8 *) source); + +#if defined(HAVE_GFC_INTEGER_16) + case GFC_DTYPE_INTEGER_16: + case GFC_DTYPE_LOGICAL_16: + return internal_pack_16 ((gfc_array_i16 *) source); +#endif + case GFC_DTYPE_REAL_4: + return internal_pack_r4 ((gfc_array_r4 *) source); + + case GFC_DTYPE_REAL_8: + return internal_pack_r8 ((gfc_array_r8 *) source); + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# if defined (HAVE_GFC_REAL_10) + case GFC_DTYPE_REAL_10: + return internal_pack_r10 ((gfc_array_r10 *) source); +# endif + +# if defined (HAVE_GFC_REAL_16) + case GFC_DTYPE_REAL_16: + return internal_pack_r16 ((gfc_array_r16 *) source); +# endif +#endif + + case GFC_DTYPE_COMPLEX_4: + return internal_pack_c4 ((gfc_array_c4 *) source); + + case GFC_DTYPE_COMPLEX_8: + return internal_pack_c8 ((gfc_array_c8 *) source); + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# if defined (HAVE_GFC_COMPLEX_10) + case GFC_DTYPE_COMPLEX_10: + return internal_pack_c10 ((gfc_array_c10 *) source); +# endif + +# if defined (HAVE_GFC_COMPLEX_16) + case GFC_DTYPE_COMPLEX_16: + return internal_pack_c16 ((gfc_array_c16 *) source); +# endif +#endif + + case GFC_DTYPE_DERIVED_2: + if (GFC_UNALIGNED_2(source->data)) + break; + else + return internal_pack_2 ((gfc_array_i2 *) source); + + case GFC_DTYPE_DERIVED_4: + if (GFC_UNALIGNED_4(source->data)) + break; + else + return internal_pack_4 ((gfc_array_i4 *) source); + + case GFC_DTYPE_DERIVED_8: + if (GFC_UNALIGNED_8(source->data)) + break; + else + return internal_pack_8 ((gfc_array_i8 *) source); + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_DERIVED_16: + if (GFC_UNALIGNED_16(source->data)) + break; + else + return internal_pack_16 ((gfc_array_i16 *) source); +#endif + + default: + break; + } + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(source,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(source,n); + 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 = internal_malloc_size (ssize * size); + dest = (char *)destptr; + src = source->data; + stride0 = stride[0] * size; + + while (src) + { + /* Copy the data. */ + memcpy(dest, src, size); + /* Advance to the next element. */ + dest += size; + 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 probably not worth it. */ + src -= stride[n] * extent[n] * size; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n] * size; + } + } + } + return destptr; +} diff --git a/libgfortran/runtime/in_unpack_generic.c b/libgfortran/runtime/in_unpack_generic.c new file mode 100644 index 000000000..32cc94b11 --- /dev/null +++ b/libgfortran/runtime/in_unpack_generic.c @@ -0,0 +1,242 @@ +/* Generic helper function for repacking arrays. + Copyright 2003, 2004, 2005, 2007, 2009, 2010 + 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + +extern void internal_unpack (gfc_array_char *, const void *); +export_proto(internal_unpack); + +void +internal_unpack (gfc_array_char * d, const void * s) +{ + 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; + char *dest; + const char *src; + int n; + int size; + int type_size; + + dest = d->data; + /* This check may be redundant, but do it anyway. */ + if (s == dest || !s) + return; + + type_size = GFC_DTYPE_TYPE_SIZE (d); + switch (type_size) + { + case GFC_DTYPE_INTEGER_1: + case GFC_DTYPE_LOGICAL_1: + case GFC_DTYPE_DERIVED_1: + internal_unpack_1 ((gfc_array_i1 *) d, (const GFC_INTEGER_1 *) s); + return; + + case GFC_DTYPE_INTEGER_2: + case GFC_DTYPE_LOGICAL_2: + internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); + return; + + case GFC_DTYPE_INTEGER_4: + case GFC_DTYPE_LOGICAL_4: + internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); + return; + + case GFC_DTYPE_INTEGER_8: + case GFC_DTYPE_LOGICAL_8: + internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); + return; + +#if defined (HAVE_GFC_INTEGER_16) + case GFC_DTYPE_INTEGER_16: + case GFC_DTYPE_LOGICAL_16: + internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s); + return; +#endif + + case GFC_DTYPE_REAL_4: + internal_unpack_r4 ((gfc_array_r4 *) d, (const GFC_REAL_4 *) s); + return; + + case GFC_DTYPE_REAL_8: + internal_unpack_r8 ((gfc_array_r8 *) d, (const GFC_REAL_8 *) s); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# if defined(HAVE_GFC_REAL_10) + case GFC_DTYPE_REAL_10: + internal_unpack_r10 ((gfc_array_r10 *) d, (const GFC_REAL_10 *) s); + return; +# endif + +# if defined(HAVE_GFC_REAL_16) + case GFC_DTYPE_REAL_16: + internal_unpack_r16 ((gfc_array_r16 *) d, (const GFC_REAL_16 *) s); + return; +# endif +#endif + + case GFC_DTYPE_COMPLEX_4: + internal_unpack_c4 ((gfc_array_c4 *)d, (const GFC_COMPLEX_4 *)s); + return; + + case GFC_DTYPE_COMPLEX_8: + internal_unpack_c8 ((gfc_array_c8 *)d, (const GFC_COMPLEX_8 *)s); + return; + +/* FIXME: This here is a hack, which will have to be removed when + the array descriptor is reworked. Currently, we don't store the + kind value for the type, but only the size. Because on targets with + __float128, we have sizeof(logn double) == sizeof(__float128), + we cannot discriminate here and have to fall back to the generic + handling (which is suboptimal). */ +#if !defined(GFC_REAL_16_IS_FLOAT128) +# if defined(HAVE_GFC_COMPLEX_10) + case GFC_DTYPE_COMPLEX_10: + internal_unpack_c10 ((gfc_array_c10 *) d, (const GFC_COMPLEX_10 *) s); + return; +# endif + +# if defined(HAVE_GFC_COMPLEX_16) + case GFC_DTYPE_COMPLEX_16: + internal_unpack_c16 ((gfc_array_c16 *) d, (const GFC_COMPLEX_16 *) s); + return; +# endif +#endif + + case GFC_DTYPE_DERIVED_2: + if (GFC_UNALIGNED_2(d->data) || GFC_UNALIGNED_2(s)) + break; + else + { + internal_unpack_2 ((gfc_array_i2 *) d, (const GFC_INTEGER_2 *) s); + return; + } + case GFC_DTYPE_DERIVED_4: + if (GFC_UNALIGNED_4(d->data) || GFC_UNALIGNED_4(s)) + break; + else + { + internal_unpack_4 ((gfc_array_i4 *) d, (const GFC_INTEGER_4 *) s); + return; + } + + case GFC_DTYPE_DERIVED_8: + if (GFC_UNALIGNED_8(d->data) || GFC_UNALIGNED_8(s)) + break; + else + { + internal_unpack_8 ((gfc_array_i8 *) d, (const GFC_INTEGER_8 *) s); + return; + } + +#ifdef HAVE_GFC_INTEGER_16 + case GFC_DTYPE_DERIVED_16: + if (GFC_UNALIGNED_16(d->data) || GFC_UNALIGNED_16(s)) + break; + else + { + internal_unpack_16 ((gfc_array_i16 *) d, (const GFC_INTEGER_16 *) s); + return; + } +#endif + + default: + break; + } + + size = GFC_DESCRIPTOR_SIZE (d); + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = GFC_DESCRIPTOR_STRIDE(d,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(d,n); + if (extent[n] <= 0) + return; + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + src = s; + + if (dsize != 0) + { + memcpy (dest, src, dsize * size); + return; + } + + stride0 = stride[0] * size; + + while (dest) + { + /* Copy the data. */ + memcpy (dest, src, size); + /* Advance to the next element. */ + src += size; + 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 probably not worth it. */ + dest -= stride[n] * extent[n] * size; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n] * size; + } + } + } +} diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c new file mode 100644 index 000000000..28247ca87 --- /dev/null +++ b/libgfortran/runtime/main.c @@ -0,0 +1,184 @@ +/* Copyright (C) 2002-2003, 2005, 2007, 2009 Free Software Foundation, Inc. + Contributed by Andy Vaught and 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 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include +#include +#include + + +#ifdef HAVE_UNISTD_H +#include +#endif + +/* Stupid function to be sure the constructor is always linked in, even + in the case of static linking. See PR libfortran/22298 for details. */ +void +stupid_function_name_for_static_linking (void) +{ + return; +} + +/* This will be 0 for little-endian + machines and 1 for big-endian machines. */ +int big_endian = 0; + + +/* Figure out endianness for this machine. */ + +static void +determine_endianness (void) +{ + union + { + GFC_LOGICAL_8 l8; + GFC_LOGICAL_4 l4[2]; + } u; + + u.l8 = 1; + if (u.l4[0]) + big_endian = 0; + else if (u.l4[1]) + big_endian = 1; + else + runtime_error ("Unable to determine machine endianness"); +} + + +static int argc_save; +static char **argv_save; + +static const char *exe_path; +static int please_free_exe_path_when_done; + +/* Save the path under which the program was called, for use in the + backtrace routines. */ +void +store_exe_path (const char * argv0) +{ +#ifndef PATH_MAX +#define PATH_MAX 1024 +#endif + +#ifndef DIR_SEPARATOR +#define DIR_SEPARATOR '/' +#endif + + char buf[PATH_MAX], *cwd, *path; + + /* This can only happen if store_exe_path is called multiple times. */ + if (please_free_exe_path_when_done) + free ((char *) exe_path); + + /* On the simulator argv is not set. */ + if (argv0 == NULL || argv0[0] == '/') + { + exe_path = argv0; + please_free_exe_path_when_done = 0; + return; + } + + memset (buf, 0, sizeof (buf)); +#ifdef HAVE_GETCWD + cwd = getcwd (buf, sizeof (buf)); +#else + cwd = ""; +#endif + + /* exe_path will be cwd + "/" + argv[0] + "\0" */ + path = malloc (strlen (cwd) + 1 + strlen (argv0) + 1); + sprintf (path, "%s%c%s", cwd, DIR_SEPARATOR, argv0); + exe_path = path; + please_free_exe_path_when_done = 1; +} + + +/* Return the full path of the executable. */ +char * +full_exe_path (void) +{ + return (char *) exe_path; +} + + +/* Set the saved values of the command line arguments. */ + +void +set_args (int argc, char **argv) +{ + argc_save = argc; + argv_save = argv; + store_exe_path (argv[0]); +} +iexport(set_args); + + +/* Retrieve the saved values of the command line arguments. */ + +void +get_args (int *argc, char ***argv) +{ + *argc = argc_save; + *argv = argv_save; +} + + +/* Initialize the runtime library. */ + +static void __attribute__((constructor)) +init (void) +{ + /* Figure out the machine endianness. */ + determine_endianness (); + + /* Must be first */ + init_variables (); + + init_units (); + set_fpu (); + init_compile_options (); + +#ifdef DEBUG + /* Check for special command lines. */ + + if (argc > 1 && strcmp (argv[1], "--help") == 0) + show_variables (); + + /* if (argc > 1 && strcmp(argv[1], "--resume") == 0) resume(); */ +#endif + + random_seed_i4 (NULL, NULL, NULL); +} + + +/* Cleanup the runtime library. */ + +static void __attribute__((destructor)) +cleanup (void) +{ + close_units (); + + if (please_free_exe_path_when_done) + free ((char *) exe_path); +} diff --git a/libgfortran/runtime/memory.c b/libgfortran/runtime/memory.c new file mode 100644 index 000000000..a26d9e59e --- /dev/null +++ b/libgfortran/runtime/memory.c @@ -0,0 +1,61 @@ +/* Memory management routines. + Copyright 2002, 2005, 2006, 2007, 2009, 2010 Free Software Foundation, Inc. + Contributed by Paul Brook + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + +/* If GFC_CLEAR_MEMORY is defined, the memory allocation routines will + return memory that is guaranteed to be set to zero. This can have + a severe efficiency penalty, so it should never be set if good + performance is desired, but it can help when you're debugging code. */ +/* #define GFC_CLEAR_MEMORY */ + +void * +get_mem (size_t n) +{ + void *p; + +#ifdef GFC_CLEAR_MEMORY + p = (void *) calloc (1, n); +#else + p = (void *) malloc (n); +#endif + if (p == NULL) + os_error ("Memory allocation failed"); + + return p; +} + + +/* Allocate memory for internal (compiler generated) use. */ + +void * +internal_malloc_size (size_t size) +{ + if (unlikely (size == 0)) + size = 1; + + return get_mem (size); +} diff --git a/libgfortran/runtime/pause.c b/libgfortran/runtime/pause.c new file mode 100644 index 000000000..61ab4db03 --- /dev/null +++ b/libgfortran/runtime/pause.c @@ -0,0 +1,68 @@ +/* Implementation of the STOP statement. + Copyright 2002, 2005, 2007, 2009, 2010 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + +static void +do_pause (void) +{ + char buff[4]; + st_printf ("To resume execution, type go. " + "Other input will terminate the job.\n"); + + fgets(buff, 4, stdin); + if (strncmp(buff, "go\n", 3) != 0) + stop_string ('\0', 0); + st_printf ("RESUMED\n"); +} + +/* A numeric PAUSE statement. */ + +extern void pause_numeric (GFC_INTEGER_4); +export_proto(pause_numeric); + +void +pause_numeric (GFC_INTEGER_4 code) +{ + st_printf ("PAUSE %d\n", (int) code); + do_pause (); +} + +/* A character string or blank PAUSE statement. */ + +extern void pause_string (char *string, GFC_INTEGER_4 len); +export_proto(pause_string); + +void +pause_string (char *string, GFC_INTEGER_4 len) +{ + st_printf ("PAUSE "); + while (len--) + st_printf ("%c", *(string++)); + st_printf ("\n"); + + do_pause (); +} diff --git a/libgfortran/runtime/select.c b/libgfortran/runtime/select.c new file mode 100644 index 000000000..e9d7f3559 --- /dev/null +++ b/libgfortran/runtime/select.c @@ -0,0 +1,46 @@ +/* Implement the SELECT statement for character variables. + Copyright 2008, 2009 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" + + +/* The string selection function is defined using a few generic macros + in select_inc.c, so we avoid code duplication between the various + character type kinds. */ + +#undef CHARTYPE +#define CHARTYPE char +#undef SUFFIX +#define SUFFIX(x) x + +#include "select_inc.c" + + +#undef CHARTYPE +#define CHARTYPE gfc_char4_t +#undef SUFFIX +#define SUFFIX(x) x ## _char4 + +#include "select_inc.c" + diff --git a/libgfortran/runtime/select_inc.c b/libgfortran/runtime/select_inc.c new file mode 100644 index 000000000..904ad4d86 --- /dev/null +++ b/libgfortran/runtime/select_inc.c @@ -0,0 +1,133 @@ +/* Implement the SELECT statement for character variables. + Copyright 2008, 2009 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#define select_string SUFFIX(select_string) +#define select_struct SUFFIX(select_struct) +#define compare_string SUFFIX(compare_string) + +typedef struct +{ + CHARTYPE *low; + gfc_charlen_type low_len; + CHARTYPE *high; + gfc_charlen_type high_len; + int address; +} +select_struct; + +extern int select_string (select_struct *table, int table_len, + const CHARTYPE *selector, + gfc_charlen_type selector_len); +export_proto(select_string); + + +/* select_string()-- Given a selector string and a table of + * select_struct structures, return the address to jump to. */ + +int +select_string (select_struct *table, int table_len, const CHARTYPE *selector, + gfc_charlen_type selector_len) +{ + select_struct *t; + int i, low, high, mid; + int default_jump = -1; + + if (table_len == 0) + return -1; + + /* Record the default address if present */ + + if (table->low == NULL && table->high == NULL) + { + default_jump = table->address; + + table++; + table_len--; + if (table_len == 0) + return default_jump; + } + + /* Try the high and low bounds if present. */ + + if (table->low == NULL) + { + if (compare_string (table->high_len, table->high, + selector_len, selector) >= 0) + return table->address; + + table++; + table_len--; + if (table_len == 0) + return default_jump; + } + + t = table + table_len - 1; + + if (t->high == NULL) + { + if (compare_string (t->low_len, t->low, selector_len, selector) <= 0) + return t->address; + + table_len--; + if (table_len == 0) + return default_jump; + } + + /* At this point, the only table entries are bounded entries. Find + the right entry with a binary chop. */ + + low = -1; + high = table_len; + + while (low + 1 < high) + { + mid = (low + high) / 2; + + t = table + mid; + i = compare_string (t->low_len, t->low, selector_len, selector); + + if (i == 0) + return t->address; + + if (i < 0) + low = mid; + else + high = mid; + } + + /* The string now lies between the low indeces of the now-adjacent + high and low entries. Because it is less than the low entry of + 'high', it can't be that one. If low is still -1, then no + entries match. Otherwise, we have to check the high entry of + 'low'. */ + + if (low == -1) + return default_jump; + + t = table + low; + if (compare_string (selector_len, selector, t->high_len, t->high) <= 0) + return t->address; + + return default_jump; +} diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c new file mode 100644 index 000000000..29f5031b3 --- /dev/null +++ b/libgfortran/runtime/stop.c @@ -0,0 +1,109 @@ +/* Implementation of the STOP statement. + Copyright 2002, 2005, 2007, 2009, 2010 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 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + +/* A numeric STOP statement. */ + +extern void stop_numeric (GFC_INTEGER_4) + __attribute__ ((noreturn)); +export_proto(stop_numeric); + +void +stop_numeric (GFC_INTEGER_4 code) +{ + if (code == -1) + code = 0; + else + st_printf ("STOP %d\n", (int)code); + + sys_exit (code); +} + + +/* A Fortran 2008 numeric STOP statement. */ + +extern void stop_numeric_f08 (GFC_INTEGER_4) + __attribute__ ((noreturn)); +export_proto(stop_numeric_f08); + +void +stop_numeric_f08 (GFC_INTEGER_4 code) +{ + st_printf ("STOP %d\n", (int)code); + sys_exit (code); +} + + +/* A character string or blank STOP statement. */ + +void +stop_string (const char *string, GFC_INTEGER_4 len) +{ + if (string) + { + st_printf ("STOP "); + while (len--) + st_printf ("%c", *(string++)); + st_printf ("\n"); + } + sys_exit (0); +} + + +/* Per Fortran 2008, section 8.4: "Execution of a STOP statement initiates + normal termination of execution. Execution of an ERROR STOP statement + initiates error termination of execution." Thus, error_stop_string returns + a nonzero exit status code. */ + +extern void error_stop_string (const char *, GFC_INTEGER_4) + __attribute__ ((noreturn)); +export_proto(error_stop_string); + +void +error_stop_string (const char *string, GFC_INTEGER_4 len) +{ + st_printf ("ERROR STOP "); + while (len--) + st_printf ("%c", *(string++)); + st_printf ("\n"); + + sys_exit (1); +} + + +/* A numeric ERROR STOP statement. */ + +extern void error_stop_numeric (GFC_INTEGER_4) + __attribute__ ((noreturn)); +export_proto(error_stop_numeric); + +void +error_stop_numeric (GFC_INTEGER_4 code) +{ + st_printf ("ERROR STOP %d\n", (int) code); + sys_exit (code); +} diff --git a/libgfortran/runtime/string.c b/libgfortran/runtime/string.c new file mode 100644 index 000000000..ac2d53d26 --- /dev/null +++ b/libgfortran/runtime/string.c @@ -0,0 +1,112 @@ +/* Copyright (C) 2002, 2003, 2005, 2007, 2009, 2010 + 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 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ + +#include "libgfortran.h" +#include + + +/* Given a fortran string, return its length exclusive of the trailing + spaces. */ + +gfc_charlen_type +fstrlen (const char *string, gfc_charlen_type len) +{ + for (; len > 0; len--) + if (string[len-1] != ' ') + break; + + return len; +} + + +/* Copy a Fortran string (not null-terminated, hence length arguments + for both source and destination strings. Returns the non-padded + length of the destination. */ + +gfc_charlen_type +fstrcpy (char *dest, gfc_charlen_type destlen, + const char *src, gfc_charlen_type srclen) +{ + if (srclen >= destlen) + { + /* This will truncate if too long. */ + memcpy (dest, src, destlen); + return destlen; + } + else + { + memcpy (dest, src, srclen); + /* Pad with spaces. */ + memset (&dest[srclen], ' ', destlen - srclen); + return srclen; + } +} + + +/* Copy a null-terminated C string to a non-null-terminated Fortran + string. Returns the non-padded length of the destination string. */ + +gfc_charlen_type +cf_strcpy (char *dest, gfc_charlen_type dest_len, const char *src) +{ + size_t src_len; + + src_len = strlen (src); + + if (src_len >= (size_t) dest_len) + { + /* This will truncate if too long. */ + memcpy (dest, src, dest_len); + return dest_len; + } + else + { + memcpy (dest, src, src_len); + /* Pad with spaces. */ + memset (&dest[src_len], ' ', dest_len - src_len); + return src_len; + } +} + + +/* Given a fortran string and an array of st_option structures, search through + the array to find a match. If the option is not found, we generate an error + if no default is provided. */ + +int +find_option (st_parameter_common *cmp, const char *s1, gfc_charlen_type s1_len, + const st_option * opts, const char *error_message) +{ + /* Strip trailing blanks from the Fortran string. */ + size_t len = (size_t) fstrlen (s1, s1_len); + + for (; opts->name; opts++) + if (len == strlen(opts->name) && strncasecmp (s1, opts->name, len) == 0) + return opts->value; + + generate_error (cmp, LIBERROR_BAD_OPTION, error_message); + + return -1; +} -- cgit v1.2.3