[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:92979f0da0066746862c0d67a9bb239b5b766d6b

commit 92979f0da0066746862c0d67a9bb239b5b766d6b
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 4deb75b06aa4..1a21e7eaa79a 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -10646,60 +10646,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);
@@ -10710,18 +10659,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.