X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=libgfortran%2Fgenerated%2Fmaxloc1_8_i8.c;h=e30e104dfc6a787aa81edc080cd78e82fbfc0f3e;hp=c0179cd8b7a677ee777e6decf0f1e0d201f0ffc5;hb=ae66f8f3e538f159667cb6cfca4532c3b0e91784;hpb=a14c06e97aeeb4b6c164edf6d00fab4e82642d84 diff --git a/libgfortran/generated/maxloc1_8_i8.c b/libgfortran/generated/maxloc1_8_i8.c index c0179cd8b7a..e30e104dfc6 100644 --- a/libgfortran/generated/maxloc1_8_i8.c +++ b/libgfortran/generated/maxloc1_8_i8.c @@ -1,5 +1,5 @@ /* Implementation of the MAXLOC intrinsic - Copyright 2002 Free Software Foundation, Inc. + Copyright 2002, 2007 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of the GNU Fortran 95 runtime library (libgfortran). @@ -28,12 +28,10 @@ License along with libgfortran; see the file COPYING. If not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ -#include "config.h" +#include "libgfortran.h" #include #include -#include #include -#include "libgfortran.h" #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) @@ -118,7 +116,26 @@ maxloc1_8_i8 (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 (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + 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++) @@ -140,7 +157,7 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, { GFC_INTEGER_8 maxval; - maxval = -GFC_INTEGER_8_HUGE; + maxval = (-GFC_INTEGER_8_HUGE-1); result = 0; if (len <= 0) *dest = 0; @@ -192,14 +209,14 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, extern void mmaxloc1_8_i8 (gfc_array_i8 * const restrict, gfc_array_i8 * const restrict, const index_type * const restrict, - gfc_array_l4 * 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_l4 * const restrict mask) + gfc_array_l1 * const restrict mask) { index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; @@ -208,13 +225,14 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, index_type mstride[GFC_MAX_DIMENSIONS]; GFC_INTEGER_8 * restrict dest; const GFC_INTEGER_8 * 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; @@ -222,13 +240,27 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; 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 = array->dim[dim].stride; - mdelta = mask->dim[dim].stride; + mdelta = mask->dim[dim].stride * mask_kind; for (n = 0; n < dim; n++) { sstride[n] = array->dim[n].stride; - mstride[n] = mask->dim[n].stride; + mstride[n] = mask->dim[n].stride * mask_kind; extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; if (extent[n] < 0) @@ -238,7 +270,7 @@ mmaxloc1_8_i8 (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; + mstride[n] = mask->dim[n + 1].stride * mask_kind; extent[n] = array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; @@ -280,7 +312,35 @@ mmaxloc1_8_i8 (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 (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + 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 = array->dim[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 %ld:" + " is %ld, should be %ld", (long int) n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -293,29 +353,18 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, 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_INTEGER_8 * restrict src; - const GFC_LOGICAL_4 * restrict msrc; + const GFC_LOGICAL_1 * restrict msrc; GFC_INTEGER_8 result; src = base; msrc = mbase; { GFC_INTEGER_8 maxval; - maxval = -GFC_INTEGER_8_HUGE; + maxval = (-GFC_INTEGER_8_HUGE-1); result = 0; if (len <= 0) *dest = 0; @@ -404,13 +453,21 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %ld", (long int) ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data;