[gcc(refs/users/mikael/heads/refactor_descriptor_v291.01)] Extraction gfc_set_pdt_array_descriptor

Mikael Morin via Gcc-cvs <[email protected]>
Newsgroups gmane.comp.gcc.cvs
Message-ID <[email protected]> 
https://gcc.gnu.org/g:7539cd840e30039e02a4aa86ed4651e93d1a8456

commit 7539cd840e30039e02a4aa86ed4651e93d1a8456
Author: Mikael Morin <[email protected]>
Date:   Thu Jul 31 12:34:22 2025 +0200

    Extraction gfc_set_pdt_array_descriptor

Diff:
---
 gcc/fortran/trans-array.cc      | 66 +++++------------------------------------
 gcc/fortran/trans-descriptor.cc | 54 +++++++++++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  2 ++
 3 files changed, 63 insertions(+), 59 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8ac04afe317b..5d0a052905f9 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10633,60 +10633,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 
 	  if (c->attr.pdt_array)
 	    {
-	      gfc_se tse;
-	      int i;
-	      tree size = gfc_index_one_node;
-	      tree offset = gfc_index_zero_node;
-	      tree lower, upper;
-	      gfc_expr *e;
-
-	      /* This chunk takes the expressions for 'lower' and 'upper'
-		 in the arrayspec and substitutes in the expressions for
-		 the parameters from 'pdt_param_list'. The descriptor
-		 fields can then be filled from the values so obtained.  */
-	      gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)));
-	      for (i = 0; i < c->as->rank; i++)
-		{
-		  gfc_init_se (&tse, NULL);
-		  e = gfc_copy_expr (c->as->lower[i]);
-		  gfc_insert_parameter_exprs (e, pdt_param_list);
-		  gfc_conv_expr_type (&tse, e, gfc_array_index_type);
-		  gfc_free_expr (e);
-		  lower = tse.expr;
-		  gfc_add_block_to_block (&fnblock, &tse.pre);
-		  gfc_conv_descriptor_lbound_set (&fnblock, comp,
-						  gfc_rank_cst[i],
-						  lower);
-		  gfc_add_block_to_block (&fnblock, &tse.post);
-		  e = gfc_copy_expr (c->as->upper[i]);
-		  gfc_insert_parameter_exprs (e, pdt_param_list);
-		  gfc_conv_expr_type (&tse, e, gfc_array_index_type);
-		  gfc_free_expr (e);
-		  upper = tse.expr;
-		  gfc_add_block_to_block (&fnblock, &tse.pre);
-		  gfc_conv_descriptor_ubound_set (&fnblock, comp,
-						  gfc_rank_cst[i],
-						  upper);
-		  gfc_add_block_to_block (&fnblock, &tse.post);
-		  gfc_conv_descriptor_stride_set (&fnblock, comp,
-						  gfc_rank_cst[i],
-						  size);
-		  size = gfc_evaluate_now (size, &fnblock);
-		  offset = fold_build2_loc (input_location,
-					    MINUS_EXPR,
-					    gfc_array_index_type,
-					    offset, size);
-		  offset = gfc_evaluate_now (offset, &fnblock);
-		  tmp = fold_build2_loc (input_location, MINUS_EXPR,
-					 gfc_array_index_type,
-					 upper, lower);
-		  tmp = fold_build2_loc (input_location, PLUS_EXPR,
-					 gfc_array_index_type,
-					 tmp, gfc_index_one_node);
-		  size = fold_build2_loc (input_location, MULT_EXPR,
-					  gfc_array_index_type, size, tmp);
-		}
-	      gfc_conv_descriptor_offset_set (&fnblock, comp, offset);
+	      tree nelts = gfc_set_pdt_array_descriptor (&fnblock, comp, c->as,
+							 pdt_param_list);
+
 	      if (c->ts.type == BT_CLASS)
 		{
 		  tmp = gfc_get_vptr_from_expr (comp);
@@ -10697,18 +10646,17 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	      else
 		tmp = TYPE_SIZE_UNIT (gfc_get_element_type (ctype));
 	      tmp = fold_convert (gfc_array_index_type, tmp);
-	      size = fold_build2_loc (input_location, MULT_EXPR,
-				      gfc_array_index_type, size, tmp);
+	      tree size = fold_build2_loc (input_location, MULT_EXPR,
+					   gfc_array_index_type, nelts, tmp);
 	      size = gfc_evaluate_now (size, &fnblock);
 	      tmp = gfc_call_malloc (&fnblock, NULL, size);
 	      gfc_conv_descriptor_data_set (&fnblock, comp, tmp);
-	      gfc_conv_descriptor_dtype_set (&fnblock, comp,
-					     gfc_get_dtype (ctype));
 
 	      if (c->initializer && c->initializer->rank)
 		{
+		  gfc_se tse;
 		  gfc_init_se (&tse, NULL);
-		  e = gfc_copy_expr (c->initializer);
+		  gfc_expr *e = gfc_copy_expr (c->initializer);
 		  gfc_insert_parameter_exprs (e, pdt_param_list);
 		  gfc_conv_expr_descriptor (&tse, e);
 		  gfc_add_block_to_block (&fnblock, &tse.pre);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index c3a332d41b9e..287d193c4d31 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2600,3 +2600,57 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t *block, gfc_loopinfo *loop,
     gfc_conv_descriptor_dtype_set (block, desc,
 				   gfc_get_dtype (TREE_TYPE (desc)));
 }
+
+
+tree
+gfc_set_pdt_array_descriptor (stmtblock_t *block, tree descr,
+			      gfc_array_spec *as,
+			      gfc_actual_arglist *pdt_param_list)
+{
+  gfc_se tse;
+  tree size = gfc_index_one_node;
+  tree offset = gfc_index_zero_node;
+  gfc_expr *e;
+
+  /* This chunk takes the expressions for 'lower' and 'upper'
+     in the arrayspec and substitutes in the expressions for
+     the parameters from 'pdt_param_list'. The descriptor
+     fields can then be filled from the values so obtained.  */
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (descr)));
+  for (int i = 0; i < as->rank; i++)
+    {
+      gfc_init_se (&tse, NULL);
+      e = gfc_copy_expr (as->lower[i]);
+      gfc_insert_parameter_exprs (e, pdt_param_list);
+      gfc_conv_expr_type (&tse, e, gfc_array_index_type);
+      gfc_free_expr (e);
+      tree lower = tse.expr;
+      gfc_add_block_to_block (block, &tse.pre);
+      gfc_conv_descriptor_lbound_set (block, descr, gfc_rank_cst[i], lower);
+      gfc_add_block_to_block (block, &tse.post);
+      e = gfc_copy_expr (as->upper[i]);
+      gfc_insert_parameter_exprs (e, pdt_param_list);
+      gfc_conv_expr_type (&tse, e, gfc_array_index_type);
+      gfc_free_expr (e);
+      tree upper = tse.expr;
+      gfc_add_block_to_block (block, &tse.pre);
+      gfc_conv_descriptor_ubound_set (block, descr, gfc_rank_cst[i], upper);
+      gfc_add_block_to_block (block, &tse.post);
+      gfc_conv_descriptor_stride_set (block, descr, gfc_rank_cst[i], size);
+      size = gfc_evaluate_now (size, block);
+      offset = fold_build2_loc (input_location, MINUS_EXPR,
+				gfc_array_index_type, offset, size);
+      offset = gfc_evaluate_now (offset, block);
+      tree tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				  gfc_array_index_type, upper, lower);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     tmp, gfc_index_one_node);
+      size = fold_build2_loc (input_location, MULT_EXPR,
+			      gfc_array_index_type, size, tmp);
+    }
+  gfc_conv_descriptor_offset_set (block, descr, offset);
+  gfc_conv_descriptor_dtype_set (block, descr,
+				 gfc_get_dtype (TREE_TYPE (descr)));
+
+  return size;
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index fdc0181da532..2c968af9b6e4 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -134,5 +134,7 @@ void gfc_set_temporary_descriptor (stmtblock_t *, tree, tree, tree, tree,
 void gfc_set_descriptor_for_assign_realloc (stmtblock_t *, gfc_loopinfo *,
 					    gfc_expr *, gfc_expr *, tree, tree,
 					    tree, tree, bool);
+tree gfc_set_pdt_array_descriptor (stmtblock_t *, tree, gfc_array_spec *,
+				   gfc_actual_arglist *);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.