X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=libgfortran%2Fgenerated%2Fproduct_c4.c;h=68144dcfbe279cb619f2e60d82f6e7a9df3a9fd2;hb=37e0271a833027439fd91f2364506a04d96cb72c;hp=c69295123ef2ff6ccee5b1e8e243425e1641ff80;hpb=5fcc57ced0054855920854726836938ace1573c9;p=pf3gnuchains%2Fgcc-fork.git diff --git a/libgfortran/generated/product_c4.c b/libgfortran/generated/product_c4.c index c69295123ef..68144dcfbe2 100644 --- a/libgfortran/generated/product_c4.c +++ b/libgfortran/generated/product_c4.c @@ -2,37 +2,56 @@ Copyright 2002 Free Software Foundation, Inc. Contributed by Paul Brook -This file is part of the GNU Fortran 95 runtime library (libgfor). +This file is part of the GNU Fortran 95 runtime library (libgfortran). Libgfortran is free software; you can redistribute it and/or -modify it under the terms of the GNU Lesser General Public +modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either -version 2.1 of the License, or (at your option) any later version. +version 2 of the License, or (at your option) any later version. + +In addition to the permissions in the GNU General Public License, the +Free Software Foundation gives you unlimited permission to link the +compiled version of this file into combinations with other programs, +and to distribute those combinations without any restriction coming +from the use of this file. (The General Public License restrictions +do apply in other respects; for example, they cover modification of +the file, and distribution when not linked into a combine +executable.) Libgfortran is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU Lesser General Public License for more details. +GNU General Public License for more details. -You should have received a copy of the GNU Lesser General Public -License along with libgfor; see the file COPYING.LIB. If not, -write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +You should have received a copy of the GNU General Public +License along with libgfortran; see the file COPYING. If not, +write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include "config.h" #include #include #include "libgfortran.h" + +#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 * retarray, gfc_array_c4 *array, index_type *pdim) +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 - 1]; - index_type extent[GFC_MAX_DIMENSIONS - 1]; - index_type sstride[GFC_MAX_DIMENSIONS - 1]; - index_type dstride[GFC_MAX_DIMENSIONS - 1]; - GFC_COMPLEX_4 *base; - GFC_COMPLEX_4 *dest; + 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; @@ -42,11 +61,6 @@ __product_c4 (gfc_array_c4 * retarray, gfc_array_c4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); - if (array->dim[0].stride == 0) - array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -75,11 +89,19 @@ __product_c4 (gfc_array_c4 * retarray, gfc_array_c4 *array, index_type *pdim) retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; } - retarray->data = internal_malloc (sizeof (GFC_COMPLEX_4) * - (retarray->dim[rank-1].stride * extent[rank-1])); - retarray->base = 0; + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -93,7 +115,7 @@ __product_c4 (gfc_array_c4 * retarray, gfc_array_c4 *array, index_type *pdim) while (base) { - GFC_COMPLEX_4 *src; + const GFC_COMPLEX_4 * restrict src; GFC_COMPLEX_4 result; src = base; { @@ -142,17 +164,26 @@ __product_c4 (gfc_array_c4 * retarray, gfc_array_c4 *array, index_type *pdim) } } + +extern void mproduct_c4 (gfc_array_c4 * const restrict, + gfc_array_c4 * const restrict, const index_type * const restrict, + gfc_array_l4 * const restrict); +export_proto(mproduct_c4); + void -__mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, index_type *pdim, gfc_array_l4 * mask) +mproduct_c4 (gfc_array_c4 * const restrict retarray, + gfc_array_c4 * const restrict array, + const index_type * const restrict pdim, + gfc_array_l4 * const restrict mask) { - index_type count[GFC_MAX_DIMENSIONS - 1]; - index_type extent[GFC_MAX_DIMENSIONS - 1]; - index_type sstride[GFC_MAX_DIMENSIONS - 1]; - index_type dstride[GFC_MAX_DIMENSIONS - 1]; - index_type mstride[GFC_MAX_DIMENSIONS - 1]; - GFC_COMPLEX_4 *dest; - GFC_COMPLEX_4 *base; - GFC_LOGICAL_4 *mbase; + 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_4 * restrict mbase; int rank; int dim; index_type n; @@ -162,11 +193,6 @@ __mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, index_type *pdim, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); - if (array->dim[0].stride == 0) - array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -188,6 +214,31 @@ __mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, index_type *pdim, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->offset = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -212,8 +263,8 @@ __mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, index_type *pdim, while (base) { - GFC_COMPLEX_4 *src; - GFC_LOGICAL_4 *msrc; + const GFC_COMPLEX_4 * restrict src; + const GFC_LOGICAL_4 * restrict msrc; GFC_COMPLEX_4 result; src = base; msrc = mbase; @@ -267,3 +318,55 @@ __mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, index_type *pdim, } } + +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 rank; + index_type n; + index_type dstride; + GFC_COMPLEX_4 *dest; + + if (*mask) + { + product_c4 (retarray, array, pdim); + return; + } + rank = GFC_DESCRIPTOR_RANK (array); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->offset = 0; + retarray->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + } + + dstride = retarray->dim[0].stride; + dest = retarray->data; + + for (n = 0; n < rank; n++) + dest[n * dstride] = 1 ; +} + +#endif