X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=libgfortran%2Fgenerated%2Fmaxloc1_8_r10.c;h=cb4b69201ee8ea8436a43567007a0c1c8cd68119;hb=827aef63c4ec0ed551bd722b147d88e485585eb9;hp=deef31c91eced11f679bbc86bb5cbfad73f78e45;hpb=35a465686d10e9e2357cb0fbccc4537f5a62a9bd;p=pf3gnuchains%2Fgcc-fork.git diff --git a/libgfortran/generated/maxloc1_8_r10.c b/libgfortran/generated/maxloc1_8_r10.c index deef31c91ec..cb4b69201ee 100644 --- a/libgfortran/generated/maxloc1_8_r10.c +++ b/libgfortran/generated/maxloc1_8_r10.c @@ -1,5 +1,5 @@ /* Implementation of the MAXLOC intrinsic - Copyright 2002 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,32 +7,26 @@ This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can 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 "config.h" +#include "libgfortran.h" #include #include #include -#include "libgfortran.h" #if defined (HAVE_GFC_REAL_10) && defined (HAVE_GFC_INTEGER_8) @@ -58,27 +52,29 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, 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 = array->dim[dim].ubound + 1 - array->dim[dim].lbound; - delta = array->dim[dim].stride; + 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] = 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); if (extent[n] < 0) extent[n] = 0; } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); + extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); if (extent[n] < 0) extent[n] = 0; @@ -86,30 +82,31 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; for (n = 0; n < rank; n++) { - retarray->dim[n].lbound = 0; - retarray->dim[n].ubound = extent[n]-1; if (n == 0) - retarray->dim[n].stride = 1; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(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) * retarray->dim[rank-1].stride + 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. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; + } else retarray->data = internal_malloc_size (alloc_size); @@ -117,13 +114,31 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + 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] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) len = 0; } @@ -131,7 +146,8 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, base = array->data; dest = retarray->data; - while (base) + continue_loop = 1; + while (continue_loop) { const GFC_REAL_10 * restrict src; GFC_INTEGER_8 result; @@ -175,8 +191,8 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (n == rank) { /* Break out of the look. */ - base = NULL; - break; + continue_loop = 0; + break; } else { @@ -191,14 +207,14 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, extern void mmaxloc1_8_r10 (gfc_array_i8 * const restrict, gfc_array_r10 * const restrict, const index_type * const restrict, - gfc_array_l4 * 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_l4 * const restrict mask) + gfc_array_l1 * const restrict mask) { index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; @@ -207,28 +223,43 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, index_type mstride[GFC_MAX_DIMENSIONS]; GFC_INTEGER_8 * restrict dest; const GFC_REAL_10 * restrict base; - const GFC_LOGICAL_4 * restrict mbase; + 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 = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + len = GFC_DESCRIPTOR_EXTENT(array,dim); if (len <= 0) return; - delta = array->dim[dim].stride; - mdelta = mask->dim[dim].stride; + + 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] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride; - 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); if (extent[n] < 0) extent[n] = 0; @@ -236,10 +267,9 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, } for (n = dim; n < rank; n++) { - sstride[n] = array->dim[n + 1].stride; - mstride[n] = mask->dim[n + 1].stride; - extent[n] = - array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + 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; @@ -247,19 +277,20 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (retarray->data == NULL) { - size_t alloc_size; + size_t alloc_size, str; for (n = 0; n < rank; n++) { - retarray->dim[n].lbound = 0; - retarray->dim[n].ubound = extent[n]-1; if (n == 0) - retarray->dim[n].stride = 1; + str = 1; else - retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + 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) * retarray->dim[rank-1].stride + alloc_size = sizeof (GFC_INTEGER_8) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; retarray->offset = 0; @@ -268,8 +299,7 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (alloc_size == 0) { /* Make sure we have a zero-sized array. */ - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = -1; + GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); return; } else @@ -279,35 +309,51 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + 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++) + { + index_type mask_extent, array_extent; + + array_extent = GFC_DESCRIPTOR_EXTENT(array,n); + mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) { count[n] = 0; - dstride[n] = retarray->dim[n].stride; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); if (extent[n] <= 0) return; } dest = retarray->data; base = array->data; - mbase = mask->data; - - if (GFC_DESCRIPTOR_SIZE (mask) != 4) - { - /* This allows the same loop to be used for all logical types. */ - assert (GFC_DESCRIPTOR_SIZE (mask) == 8); - for (n = 0; n < rank; n++) - mstride[n] <<= 1; - mdelta <<= 1; - mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); - } while (base) { const GFC_REAL_10 * restrict src; - const GFC_LOGICAL_4 * restrict msrc; + const GFC_LOGICAL_1 * restrict msrc; GFC_INTEGER_8 result; src = base; msrc = mbase; @@ -378,43 +424,130 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, const index_type * const restrict pdim, GFC_LOGICAL_4 * 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]; + GFC_INTEGER_8 * restrict dest; index_type rank; index_type n; - index_type dstride; - GFC_INTEGER_8 *dest; + index_type dim; + if (*mask) { maxloc1_8_r10 (retarray, array, pdim); return; } - rank = GFC_DESCRIPTOR_RANK (array); - if (rank <= 0) - runtime_error ("Rank of array needs to be > 0"); + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + + 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) { - retarray->dim[0].lbound = 0; - retarray->dim[0].ubound = rank-1; - retarray->dim[0].stride = 1; - retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + size_t alloc_size, str; + + for (n = 0; n < rank; n++) + { + if (n == 0) + str = 1; + else + str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; + + GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); + + } + retarray->offset = 0; - retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + 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 (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + 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]); + } + } + } - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); } - dstride = retarray->dim[0].stride; - dest = retarray->data; + dest = retarray->data; - for (n = 0; n < rank; n++) - dest[n * dstride] = 0 ; + 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