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

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

commit 7dfb7a9bf0d766230fcb1acb25af8a0275284b71
Author: Mikael Morin <[email protected]>
Date:   Wed Jul 22 22:06:34 2026 +0200

    Extraction gfc_set_gfc_from_cfi
    
    Correction artefact conflit rebase

Diff:
---
 gcc/fortran/trans-descriptor.cc | 98 +++++++++++++++++++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  3 ++
 gcc/fortran/trans-expr.cc       | 91 +-------------------------------------
 3 files changed, 102 insertions(+), 90 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 4e2d0e0eabbd..bfcbc4559d6a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1965,3 +1965,101 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree desc, tree ptr,
 				   gfc_array_index_type, offset));
   gfc_conv_descriptor_offset_set (block, desc, offset);
 }
+
+
+void
+gfc_set_gfc_from_cfi (stmtblock_t *block, tree gfc, gfc_expr *e, tree rank,
+		      tree gfc_strlen, tree cfi, gfc_symbol *fsym)
+{
+  stmtblock_t block2;
+  gfc_init_block (&block2);
+  if (e->rank == 0)
+    {
+      tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_add_modify (block, gfc, fold_convert (TREE_TYPE (gfc), tmp));
+    }
+  else
+    {
+      tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_conv_descriptor_data_set (block, gfc, tmp);
+
+      if (fsym->attr.allocatable)
+	{
+	  /* gfc->span = cfi->elem_len.  */
+	  tmp = fold_convert (gfc_array_index_type,
+			      gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]));
+	}
+      else
+	{
+	  /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
+			  ? cfi->dim[0].sm : cfi->elem_len).  */
+	  tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
+	  tree tmp2 = fold_convert (gfc_array_index_type,
+				    gfc_get_cfi_desc_elem_len (cfi));
+	  tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+				 gfc_array_index_type, tmp, tmp2);
+	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     tmp, gfc_index_zero_node);
+	  tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
+			    gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]), tmp2);
+	}
+      gfc_conv_descriptor_span_set (&block2, gfc, tmp);
+
+      /* Calculate offset + set lbound, ubound and stride.  */
+      gfc_conv_descriptor_offset_set (&block2, gfc, gfc_index_zero_node);
+      /* Loop: for (i = 0; i < rank; ++i).  */
+      tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
+      /* Loop body.  */
+      stmtblock_t loop_body;
+      gfc_init_block (&loop_body);
+      /* gfc->dim[i].lbound = ... */
+      tmp = gfc_get_cfi_dim_lbound (cfi, idx);
+      gfc_conv_descriptor_lbound_set (&loop_body, gfc, idx, tmp);
+
+      /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_lbound_get (gfc, idx),
+			     gfc_index_one_node);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     gfc_get_cfi_dim_extent (cfi, idx), tmp);
+      gfc_conv_descriptor_ubound_set (&loop_body, gfc, idx, tmp);
+
+      /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
+      tmp = gfc_get_cfi_dim_sm (cfi, idx);
+      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			     gfc_array_index_type, tmp,
+			     fold_convert (gfc_array_index_type,
+					   gfc_get_cfi_desc_elem_len (cfi)));
+      gfc_conv_descriptor_stride_set (&loop_body, gfc, idx, tmp);
+
+      /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_stride_get (gfc, idx),
+			     gfc_conv_descriptor_lbound_get (gfc, idx));
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_offset_get (gfc), tmp);
+      gfc_conv_descriptor_offset_set (&loop_body, gfc, tmp);
+      /* Generate loop.  */
+      gfc_simple_for_loop (&block2, idx, gfc_rank_cst[0], rank, LT_EXPR,
+			   gfc_rank_cst[1], gfc_finish_block (&loop_body));
+    }
+
+  if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
+    {
+      tree tmp = fold_convert (gfc_charlen_type_node,
+			       gfc_get_cfi_desc_elem_len (cfi));
+      if (e->ts.kind != 1)
+	tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			       gfc_charlen_type_node, tmp,
+			       build_int_cst (gfc_charlen_type_node,
+					      e->ts.kind));
+      gfc_add_modify (&block2, gfc_strlen, tmp);
+    }
+
+  tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			 tmp, null_pointer_node);
+  tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (block, tmp);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index afcea057ad02..7928a9aad1d0 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -119,4 +119,7 @@ void gfc_set_contiguous_descriptor (stmtblock_t *, tree, tree, tree);
 void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
 				    gfc_expr *, gfc_expr *, locus *);
 
+void gfc_set_gfc_from_cfi (stmtblock_t *, tree, gfc_expr *, tree, tree,
+			   tree, gfc_symbol *);
+
 #endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f9ba2ef337d4..10ce63767364 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6396,96 +6396,7 @@ done:
       || fsym->attr.intent == INTENT_IN)
     goto post_call;
 
-  gfc_init_block (&block2);
-  if (e->rank == 0)
-    {
-      tmp = gfc_get_cfi_desc_base_addr (cfi);
-      gfc_add_modify (&block, gfc, fold_convert (TREE_TYPE (gfc), tmp));
-    }
-  else
-    {
-      tmp = gfc_get_cfi_desc_base_addr (cfi);
-      gfc_conv_descriptor_data_set (&block, gfc, tmp);
-
-      if (fsym->attr.allocatable)
-	{
-	  /* gfc->span = cfi->elem_len.  */
-	  tmp = fold_convert (gfc_array_index_type,
-			      gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]));
-	}
-      else
-	{
-	  /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
-			  ? cfi->dim[0].sm : cfi->elem_len).  */
-	  tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
-	  tmp2 = fold_convert (gfc_array_index_type,
-			       gfc_get_cfi_desc_elem_len (cfi));
-	  tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
-				 gfc_array_index_type, tmp, tmp2);
-	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
-			     tmp, gfc_index_zero_node);
-	  tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
-			    gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]), tmp2);
-	}
-      gfc_conv_descriptor_span_set (&block2, gfc, tmp);
-
-      /* Calculate offset + set lbound, ubound and stride.  */
-      gfc_conv_descriptor_offset_set (&block2, gfc, gfc_index_zero_node);
-      /* Loop: for (i = 0; i < rank; ++i).  */
-      tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
-      /* Loop body.  */
-      stmtblock_t loop_body;
-      gfc_init_block (&loop_body);
-      /* gfc->dim[i].lbound = ... */
-      tmp = gfc_get_cfi_dim_lbound (cfi, idx);
-      gfc_conv_descriptor_lbound_set (&loop_body, gfc, idx, tmp);
-
-      /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
-      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-			     gfc_conv_descriptor_lbound_get (gfc, idx),
-			     gfc_index_one_node);
-      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-			     gfc_get_cfi_dim_extent (cfi, idx), tmp);
-      gfc_conv_descriptor_ubound_set (&loop_body, gfc, idx, tmp);
-
-      /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
-      tmp = gfc_get_cfi_dim_sm (cfi, idx);
-      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
-			     gfc_array_index_type, tmp,
-			     fold_convert (gfc_array_index_type,
-					   gfc_get_cfi_desc_elem_len (cfi)));
-      gfc_conv_descriptor_stride_set (&loop_body, gfc, idx, tmp);
-
-      /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
-      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-			     gfc_conv_descriptor_stride_get (gfc, idx),
-			     gfc_conv_descriptor_lbound_get (gfc, idx));
-      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-			     gfc_conv_descriptor_offset_get (gfc), tmp);
-      gfc_conv_descriptor_offset_set (&loop_body, gfc, tmp);
-      /* Generate loop.  */
-      gfc_simple_for_loop (&block2, idx, gfc_rank_cst[0], rank, LT_EXPR,
-			   gfc_rank_cst[1], gfc_finish_block (&loop_body));
-    }
-
-  if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
-    {
-      tmp = fold_convert (gfc_charlen_type_node,
-			  gfc_get_cfi_desc_elem_len (cfi));
-      if (e->ts.kind != 1)
-	tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
-			       gfc_charlen_type_node, tmp,
-			       build_int_cst (gfc_charlen_type_node,
-					      e->ts.kind));
-      gfc_add_modify (&block2, gfc_strlen, tmp);
-    }
-
-  tmp = gfc_get_cfi_desc_base_addr (cfi),
-  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
-			 tmp, null_pointer_node);
-  tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
-		  build_empty_stmt (input_location));
-  gfc_add_expr_to_block (&block, tmp);
+  gfc_set_gfc_from_cfi (&block, gfc, e, rank, gfc_strlen, cfi, fsym);
 
 post_call:
   gfc_add_block_to_block (&block, &se.post);
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.