OSDN Git Service

* trans-array.c (gfc_conv_expr_descriptor): Save some horizontal space.
[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-array.c
index fa05d2b..0034b49 100644 (file)
@@ -1458,8 +1458,8 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
              size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (type));
              bound = build_int_cst (size_type_node, n * size);
              tmp = build_call_expr_loc (input_location,
-                                    built_in_decls[BUILT_IN_MEMCPY], 3,
-                                    tmp, init, bound);
+                                        builtin_decl_explicit (BUILT_IN_MEMCPY),
+                                        3, tmp, init, bound);
              gfc_add_expr_to_block (&body, tmp);
 
              *poffset = fold_build2_loc (input_location, PLUS_EXPR,
@@ -2609,6 +2609,18 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
       /* Temporary array or derived type component.  */
       gcc_assert (se->loop);
       index = se->loop->loopvar[se->loop->order[i]];
+
+      /* Pointer functions can have stride[0] different from unity. 
+        Use the stride returned by the function call and stored in
+        the descriptor for the temporary.  */ 
+      if (se->ss && se->ss->type == GFC_SS_FUNCTION
+           && se->ss->expr
+           && se->ss->expr->symtree
+           && se->ss->expr->symtree->n.sym->result
+           && se->ss->expr->symtree->n.sym->result->attr.pointer)
+       stride = gfc_conv_descriptor_stride_get (info->descriptor,
+                                                gfc_rank_cst[dim]);
+
       if (!integer_zerop (info->delta[dim]))
        index = fold_build2_loc (input_location, PLUS_EXPR,
                                 gfc_array_index_type, index, info->delta[dim]);
@@ -3200,8 +3212,7 @@ evaluate_bound (stmtblock_t *block, tree *bounds, gfc_expr ** values,
 /* Calculate the lower bound of an array section.  */
 
 static void
-gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim,
-                             bool coarray, bool coarray_last)
+gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim)
 {
   gfc_expr *stride = NULL;
   tree desc;
@@ -3219,16 +3230,14 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim,
       /* We use a zero-based index to access the vector.  */
       info->start[dim] = gfc_index_zero_node;
       info->end[dim] = NULL;
-      if (!coarray)
-       info->stride[dim] = gfc_index_one_node;
+      info->stride[dim] = gfc_index_one_node;
       return;
     }
 
   gcc_assert (ar->dimen_type[dim] == DIMEN_RANGE
              || ar->dimen_type[dim] == DIMEN_THIS_IMAGE);
   desc = info->descriptor;
-  if (!coarray)
-    stride = ar->stride[dim];
+  stride = ar->stride[dim];
 
   /* Calculate the start of the range.  For vector subscripts this will
      be the range of the vector.  */
@@ -3237,13 +3246,12 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim,
   /* Similarly calculate the end.  Although this is not used in the
      scalarizer, it is needed when checking bounds and where the end
      is an expression with side-effects.  */
-  if (!coarray_last)
-    evaluate_bound (&loop->pre, info->end, ar->end, desc, dim, false);
+  evaluate_bound (&loop->pre, info->end, ar->end, desc, dim, false);
 
   /* Calculate the stride.  */
-  if (!coarray && stride == NULL)
+  if (stride == NULL)
     info->stride[dim] = gfc_index_one_node;
-  else if (!coarray)
+  else
     {
       gfc_init_se (&se, NULL);
       gfc_conv_expr_type (&se, stride, gfc_array_index_type);
@@ -3284,9 +3292,6 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
            {
            case GFC_ISYM_LBOUND:
            case GFC_ISYM_UBOUND:
-             loop->dimen = ss->data.info.dimen;
-             goto done;
-
            case GFC_ISYM_LCOBOUND:
            case GFC_ISYM_UCOBOUND:
            case GFC_ISYM_THIS_IMAGE:
@@ -3320,8 +3325,7 @@ done:
          gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter);
 
          for (n = 0; n < ss->data.info.dimen; n++)
-           gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n],
-                                         false, false);
+           gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n]);
          break;
 
        case GFC_SS_INTRINSIC:
@@ -5970,19 +5974,30 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       tree to;
       tree base;
 
+      ndim = info->ref ? info->ref->u.ar.dimen : info->dimen;
+
       if (se->want_coarray)
        {
+         gfc_array_ref *ar = &info->ref->u.ar;
+
          codim = gfc_get_corank (expr);
          for (n = ss->data.info.dimen; n < ss->data.info.dimen + codim - 1;
               n++)
            {
-             gfc_conv_section_startstride (&loop, ss, n, true, false);
+             /* Make sure we are not lost somehow.  */
+             gcc_assert (ar->dimen_type[n] == DIMEN_THIS_IMAGE);
+
+             /* Make sure the call to gfc_conv_section_startstride won't
+                generate unnecessary code to calculate stride.  */
+             gcc_assert (ar->stride[n] == NULL);
+
+             gfc_conv_section_startstride (&loop, ss, n);
              loop.from[n] = info->start[n];
              loop.to[n]   = info->end[n];
            }
 
          gcc_assert (n == ss->data.info.dimen + codim - 1);
-         evaluate_bound (&loop.pre, info->start, info->ref->u.ar.start,
+         evaluate_bound (&loop.pre, info->start, ar->start,
                          info->descriptor, n, true);
          loop.from[n] = info->start[n];
        }
@@ -6035,7 +6050,6 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       else
        base = NULL_TREE;
 
-      ndim = info->ref ? info->ref->u.ar.dimen : info->dimen;
       for (n = 0; n < ndim; n++)
        {
          stride = gfc_conv_array_stride (desc, n);
@@ -6622,7 +6636,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
          gfc_add_expr_to_block (&block, tmp);
        }
 
-      tmp = built_in_decls[BUILT_IN_MEMCPY];
+      tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
       tmp = build_call_expr_loc (input_location, tmp, 3,
                                 dest, src, size);
     }
@@ -6646,7 +6660,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
 
       /* We know the temporary and the value will be the same length,
         so can use memcpy.  */
-      tmp = built_in_decls[BUILT_IN_MEMCPY];
+      tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
       tmp = build_call_expr_loc (input_location,
                        tmp, 3, gfc_conv_descriptor_data_get (dest),
                        gfc_conv_descriptor_data_get (src), size);
@@ -7402,7 +7416,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
      in the array reference - (*desc.data)[<element>]. */
   gfc_init_block (&realloc_block);
   tmp = build_call_expr_loc (input_location,
-                            built_in_decls[BUILT_IN_REALLOC], 2,
+                            builtin_decl_explicit (BUILT_IN_REALLOC), 2,
                             fold_convert (pvoid_type_node, array1),
                             size2);
   gfc_conv_descriptor_data_set (&realloc_block,
@@ -7418,8 +7432,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
   /* Malloc expression.  */
   gfc_init_block (&alloc_block);
   tmp = build_call_expr_loc (input_location,
-                            built_in_decls[BUILT_IN_MALLOC], 1,
-                            size2);
+                            builtin_decl_explicit (BUILT_IN_MALLOC),
+                            1, size2);
   gfc_conv_descriptor_data_set (&alloc_block,
                                desc, tmp);
   tmp = gfc_conv_descriptor_dtype (desc);
@@ -7612,12 +7626,6 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
 
       ar = &ref->u.ar;
 
-      if (ar->as->rank == 0 && ref->next != NULL)
-       {
-         /* Scalar coarray.  */
-         continue;
-       }
-
       switch (ar->type)
        {
        case AR_ELEMENT:
@@ -7632,7 +7640,6 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
          /* Make sure array is the same as array(:,:), this way
             we don't need to special case all the time.  */
          ar->dimen = ar->as->rank;
-         ar->codimen = 0;
          for (n = 0; n < ar->dimen; n++)
            {
              ar->dimen_type[n] = DIMEN_RANGE;
@@ -7641,14 +7648,6 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
              gcc_assert (ar->end[n] == NULL);
              gcc_assert (ar->stride[n] == NULL);
            }
-         for (n = ar->dimen; n < ar->dimen + ar->as->corank; n++)
-           {
-             newss->data.info.dim[n] = n;
-             ar->dimen_type[n] = DIMEN_RANGE;
-
-             gcc_assert (ar->start[n] == NULL);
-             gcc_assert (ar->end[n] == NULL);
-           }
          ss = newss;
          break;
 
@@ -7657,14 +7656,12 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
          newss->data.info.ref = ref;
 
          /* We add SS chains for all the subscripts in the section.  */
-         for (n = 0; n < ar->dimen + ar->codimen; n++)
+         for (n = 0; n < ar->dimen; n++)
            {
              gfc_ss *indexss;
 
              switch (ar->dimen_type[n])
                {
-               case DIMEN_THIS_IMAGE:
-                 continue;
                case DIMEN_ELEMENT:
                  /* Add SS for elemental (scalar) subscripts.  */
                  gcc_assert (ar->start[n]);
@@ -7677,8 +7674,7 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
                   /* We don't add anything for sections, just remember this
                      dimension for later.  */
                  newss->data.info.dim[newss->data.info.dimen] = n;
-                 if (n < ar->dimen)
-                   newss->data.info.dimen++;
+                 newss->data.info.dimen++;
                  break;
 
                case DIMEN_VECTOR:
@@ -7689,8 +7685,7 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
                  indexss->loop_chain = gfc_ss_terminator;
                  newss->data.info.subscript[n] = indexss;
                  newss->data.info.dim[newss->data.info.dimen] = n;
-                 if (n < ar->dimen)
-                   newss->data.info.dimen++;
+                 newss->data.info.dimen++;
                  break;
 
                default: