[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:d8b8f0fd6ea889705def1de15880d36e1ad38a27

commit d8b8f0fd6ea889705def1de15880d36e1ad38a27
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 6323c00394f7..eaae67094650 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2585,3 +2585,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 01ea3d166a99..4c99c3ed3243 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -132,5 +132,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.