OSDN Git Service

2010-02-18 Martin Jambor <mjambor@suse.cz>
[pf3gnuchains/gcc-fork.git] / libgfortran / generated / product_r8.c
index d120369..06ee57d 100644 (file)
@@ -57,24 +57,23 @@ product_r8 (gfc_array_r8 * const restrict retarray,
   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)
     len = 0;
-  delta = array->dim[dim].stride;
+  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;
@@ -82,30 +81,31 @@ product_r8 (gfc_array_r8 * 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;
-          else
-            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
-        }
+       {
+         if (n == 0)
+           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) * retarray->dim[rank-1].stride
+      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.  */
-         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);
@@ -119,28 +119,16 @@ product_r8 (gfc_array_r8 * const restrict retarray,
                       (long int) rank);
 
       if (unlikely (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"
-                              " PRODUCT intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
-                              (long int) ret_extent, (long int) extent[n]);
-           }
-       }
+       bounds_ifunction_return ((array_t *) retarray, extent,
+                                "return value", "PRODUCT");
     }
 
   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;
+       len = 0;
     }
 
   base = array->data;
@@ -155,7 +143,7 @@ product_r8 (gfc_array_r8 * const restrict retarray,
       {
 
   result = 1;
-        if (len <= 0)
+       if (len <= 0)
          *dest = 1;
        else
          {
@@ -163,7 +151,7 @@ product_r8 (gfc_array_r8 * const restrict retarray,
              {
 
   result *= *src;
-          }
+             }
            *dest = result;
          }
       }
@@ -173,28 +161,28 @@ product_r8 (gfc_array_r8 * const restrict retarray,
       dest += dstride[0];
       n = 0;
       while (count[n] == extent[n])
-        {
-          /* When we get to the end of a dimension, reset it and increment
-             the next dimension.  */
-          count[n] = 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.  */
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 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];
-            }
-        }
+           }
+         else
+           {
+             count[n]++;
+             base += sstride[n];
+             dest += dstride[n];
+           }
+       }
     }
 }
 
@@ -229,7 +217,7 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray,
   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;
 
@@ -246,14 +234,14 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray,
   else
     runtime_error ("Funny sized logical array");
 
-  delta = array->dim[dim].stride;
-  mdelta = mask->dim[dim].stride * mask_kind;
+  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 * 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);
 
       if (extent[n] < 0)
        extent[n] = 0;
@@ -261,10 +249,9 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray,
     }
   for (n = dim; n < rank; n++)
     {
-      sstride[n] = array->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;
+      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;
@@ -272,19 +259,20 @@ mproduct_r8 (gfc_array_r8 * 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;
-          else
-            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
-        }
-
-      alloc_size = sizeof (GFC_REAL_8) * retarray->dim[rank-1].stride
+       {
+         if (n == 0)
+           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;
@@ -293,8 +281,7 @@ mproduct_r8 (gfc_array_r8 * 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
@@ -308,39 +295,19 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray,
 
       if (unlikely (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"
-                              " 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++)
-            {
-              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"
-                              " PRODUCT intrinsic in dimension %ld:"
-                              " is %ld, should be %ld", (long int) n + 1,
-                              (long int) mask_extent, (long int) array_extent);
-           }
+         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] = retarray->dim[n].stride;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
       if (extent[n] <= 0)
-        return;
+       return;
     }
 
   dest = retarray->data;
@@ -356,7 +323,7 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray,
       {
 
   result = 1;
-        if (len <= 0)
+       if (len <= 0)
          *dest = 1;
        else
          {
@@ -365,7 +332,7 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray,
 
   if (*msrc)
     result *= *src;
-              }
+             }
            *dest = result;
          }
       }
@@ -376,30 +343,30 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray,
       dest += dstride[0];
       n = 0;
       while (count[n] == extent[n])
-        {
-          /* When we get to the end of a dimension, reset it and increment
-             the next dimension.  */
-          count[n] = 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];
-            }
-        }
+       {
+         /* When we get to the end of a dimension, reset it and increment
+            the next dimension.  */
+         count[n] = 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];
+           }
+       }
     }
 }
 
@@ -417,7 +384,6 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray,
 {
   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_REAL_8 * restrict dest;
   index_type rank;
@@ -436,8 +402,7 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray,
 
   for (n = 0; n < dim; n++)
     {
-      sstride[n] = array->dim[n].stride;
-      extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound;
+      extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
 
       if (extent[n] <= 0)
        extent[n] = 0;
@@ -445,39 +410,38 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray,
 
   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;
+       GFC_DESCRIPTOR_EXTENT(array,n + 1);
 
       if (extent[n] <= 0)
-        extent[n] = 0;
+       extent[n] = 0;
     }
 
   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;
-          else
-            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
-        }
+       {
+         if (n == 0)
+           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) * retarray->dim[rank-1].stride
+      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.  */
-         retarray->dim[0].lbound = 0;
-         retarray->dim[0].ubound = -1;
+         GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
          return;
        }
       else
@@ -497,8 +461,7 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray,
            {
              index_type ret_extent;
 
-             ret_extent = retarray->dim[n].ubound + 1
-               - retarray->dim[n].lbound;
+             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:"
@@ -511,7 +474,7 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray,
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
-      dstride[n] = retarray->dim[n].stride;
+      dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
     }
 
   dest = retarray->data;
@@ -523,21 +486,21 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray,
       dest += dstride[0];
       n = 0;
       while (count[n] == extent[n])
-        {
+       {
          /* When we get to the end of a dimension, reset it and increment
-             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)
+            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];
-            }
+         else
+           {
+             count[n]++;
+             dest += dstride[n];
+           }
        }
     }
 }