Index: gcc/libgfortran/generated/maxloc0_8_r4.c |
diff --git a/gcc/libgfortran/generated/maxloc0_8_r4.c b/gcc/libgfortran/generated/maxloc0_8_r4.c |
index 971e278abdaaac99fdcf0238d0ca1c8cce7421f0..cebe571ccbeea214c3395a2585d732247a4d2405 100644 |
--- a/gcc/libgfortran/generated/maxloc0_8_r4.c |
+++ b/gcc/libgfortran/generated/maxloc0_8_r4.c |
@@ -55,9 +55,7 @@ maxloc0_8_r4 (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); |
@@ -65,29 +63,16 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray, |
else |
{ |
if (unlikely (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 %ld", (long int) 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 %ld", |
- (long int) ret_extent, (long int) rank); |
- } |
+ 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) |
{ |
@@ -102,51 +87,83 @@ maxloc0_8_r4 (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_4 maxval; |
- |
- maxval = -GFC_REAL_4_HUGE; |
+ GFC_REAL_4 maxval; |
+#if defined(GFC_REAL_4_QUIET_NAN) |
+ int fast = 0; |
+#endif |
+#if defined(GFC_REAL_4_INFINITY) |
+ maxval = -GFC_REAL_4_INFINITY; |
+#else |
+ maxval = -GFC_REAL_4_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_4_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]); |
} |
} |
} |
@@ -179,9 +196,7 @@ mmaxloc0_8_r4 (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); |
@@ -190,38 +205,11 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, |
{ |
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 %ld", (long int) 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 %ld", |
- (long int) ret_extent, (long int) rank); |
- |
- mask_rank = GFC_DESCRIPTOR_RANK (mask); |
- if (rank != mask_rank) |
- runtime_error ("rank of MASK argument in MAXLOC intrnisic" |
- "should be %ld, is %ld", (long int) rank, |
- (long int) mask_rank); |
- |
- for (n=0; n<rank; n++) |
- { |
- 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); |
- } |
+ |
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array, |
+ "MAXLOC"); |
+ bounds_equal_extents ((array_t *) mask, (array_t *) array, |
+ "MASK argument", "MAXLOC"); |
} |
} |
@@ -238,13 +226,13 @@ mmaxloc0_8_r4 (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) |
{ |
@@ -263,50 +251,87 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, |
{ |
GFC_REAL_4 maxval; |
+ int fast = 0; |
- maxval = -GFC_REAL_4_HUGE; |
- |
+#if defined(GFC_REAL_4_INFINITY) |
+ maxval = -GFC_REAL_4_INFINITY; |
+#else |
+ maxval = -GFC_REAL_4_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_4_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]); |
} |
} |
} |
@@ -339,32 +364,18 @@ smaxloc0_8_r4 (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 (unlikely (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 %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"); |
- } |
+ 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++) |
dest[n * dstride] = 0 ; |