X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=libgfortran%2Fgenerated%2Fmaxloc0_8_r10.c;h=0d5183c41a6b13fb3e5ed6e79f13ec41bfaef3ab;hb=5f0d36be6d31b78172bb45c0dbba9b1dc7f6ae84;hp=898f1f576736f679b34c18af48c65e3427ea1d09;hpb=8dec97a01c853098d6632fe60e9a442dd9210b35;p=pf3gnuchains%2Fgcc-fork.git diff --git a/libgfortran/generated/maxloc0_8_r10.c b/libgfortran/generated/maxloc0_8_r10.c index 898f1f57673..0d5183c41a6 100644 --- a/libgfortran/generated/maxloc0_8_r10.c +++ b/libgfortran/generated/maxloc0_8_r10.c @@ -1,5 +1,5 @@ /* Implementation of the MAXLOC intrinsic - Copyright 2002, 2007 Free Software Foundation, Inc. + Copyright 2002, 2007, 2009 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). @@ -7,26 +7,21 @@ This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -In addition to the permissions in the GNU General Public License, the -Free Software Foundation gives you unlimited permission to link the -compiled version of this file into combinations with other programs, -and to distribute those combinations without any restriction coming -from the use of this file. (The General Public License restrictions -do apply in other respects; for example, they cover modification of -the file, and distribution when not linked into a combine -executable.) +version 3 of the License, or (at your option) any later version. Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -You should have received a copy of the GNU General Public -License along with libgfortran; see the file COPYING. If not, -write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ #include "libgfortran.h" #include @@ -50,7 +45,7 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, index_type sstride[GFC_MAX_DIMENSIONS]; index_type dstride; const GFC_REAL_10 *base; - GFC_INTEGER_8 *dest; + GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; @@ -60,39 +55,24 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + 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 (compile_options.bounds_check) - { - int ret_rank; - index_type ret_extent; - - ret_rank = GFC_DESCRIPTOR_RANK (retarray); - if (ret_rank != 1) - runtime_error ("rank of return array in MAXLOC intrinsic" - " should be 1, is %d", ret_rank); - - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %d", - (long int) ret_extent, rank); - } + if (unlikely (compile_options.bounds_check)) + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); + extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); count[n] = 0; if (extent[n] <= 0) { @@ -107,51 +87,83 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, /* Initialize the return value. */ for (n = 0; n < rank; n++) - dest[n * dstride] = 0; + dest[n * dstride] = 1; { - GFC_REAL_10 maxval; - - maxval = -GFC_REAL_10_HUGE; + 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) { - { - /* Implementation start. */ + do + { + /* Implementation start. */ - if (*base > maxval || !dest[0]) - { - maxval = *base; - for (n = 0; n < rank; n++) - dest[n * dstride] = count[n] + 1; - } - /* Implementation end. */ - } - /* Advance to the next element. */ - count[0]++; - base += sstride[0]; +#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; - while (count[n] == extent[n]) - { - /* When we get to the end of a dimension, reset it and increment - the next dimension. */ - count[n] = 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]; - } - } + 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]); } } } @@ -184,48 +196,20 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + 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 (compile_options.bounds_check) + if (unlikely (compile_options.bounds_check)) { - int ret_rank, mask_rank; - index_type ret_extent; - int n; - index_type array_extent, mask_extent; - - ret_rank = GFC_DESCRIPTOR_RANK (retarray); - if (ret_rank != 1) - runtime_error ("rank of return array in MAXLOC intrinsic" - " should be 1, is %d", ret_rank); - - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %d", - (long int) ret_extent, rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %d, is %d", rank, mask_rank); - - for (n=0; ndim[n].ubound + 1 - array->dim[n].lbound; - mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %d:" - " is %ld, should be %ld", n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -242,13 +226,13 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, else runtime_error ("Funny sized logical array"); - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n < rank; n++) { - sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride * mask_kind; - extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + 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) { @@ -267,50 +251,87 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, { GFC_REAL_10 maxval; + int fast = 0; - maxval = -GFC_REAL_10_HUGE; - +#if defined(GFC_REAL_10_INFINITY) + maxval = -GFC_REAL_10_INFINITY; +#else + maxval = -GFC_REAL_10_HUGE; +#endif while (base) { - { - /* Implementation start. */ + do + { + /* Implementation start. */ - if (*mbase && (*base > maxval || !dest[0])) - { - maxval = *base; - for (n = 0; n < rank; n++) - dest[n * dstride] = count[n] + 1; - } - /* Implementation end. */ - } - /* Advance to the next element. */ - count[0]++; - base += sstride[0]; - mbase += mstride[0]; + } + 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; - while (count[n] == extent[n]) - { - /* When we get to the end of a dimension, reset it and increment - the next dimension. */ - count[n] = 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]; - } - } + 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]); } } } @@ -343,32 +364,18 @@ smaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; + 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 + else if (unlikely (compile_options.bounds_check)) { - if (compile_options.bounds_check) - { - int ret_rank; - index_type ret_extent; - - ret_rank = GFC_DESCRIPTOR_RANK (retarray); - if (ret_rank != 1) - runtime_error ("rank of return array in MAXLOC intrinsic" - " should be 1, is %d", ret_rank); - - ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } - dstride = retarray->dim[0].stride; + dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); dest = retarray->data; for (n = 0; n