[COMMITTED] algol68: optimize dupping of multiples whose elements do not have rows

Jose E. Marchesi jemarch@gnu.org
Sat May 3 14:13:14 GMT 2025


---
 gcc/algol68/a68-low-clauses.cc |   5 +-
 gcc/algol68/a68-low.cc         | 140 ++++++++++++++++++++-------------
 2 files changed, 88 insertions(+), 57 deletions(-)

diff --git a/gcc/algol68/a68-low-clauses.cc b/gcc/algol68/a68-low-clauses.cc
index 3d196a4e65b..16a572c800d 100644
--- a/gcc/algol68/a68-low-clauses.cc
+++ b/gcc/algol68/a68-low-clauses.cc
@@ -1195,11 +1195,10 @@ a68_lower_collateral_clause (NODE_T *p ATTRIBUTE_UNUSED,
 	      /* Copy the elements of a copy of the sub-multiple in the
 		 elements of the multiple.  */
 	      tree sub_multiple_elements = a68_multiple_elements (sub_multiple);
-	      // XXX is this dup always necessary or it depends on HAS_ROWS
-	      // of each element, i.e. do we need to loop on each element?
+	      // XXX should we make a copy of the sub_multiple_elements here?
 	      // We DO need to iterate slicing, because of strides: if
 	      // the sub_multiple is a trimmer.
-	      sub_multiple_elements = a68_low_dup (sub_multiple_elements);
+	      sub_multiple_elements = sub_multiple_elements;
 	      tree sub_multiple_elements_type = TREE_TYPE (sub_multiple_elements);
 	      tree sub_multiple_num_elems = a68_multiple_num_elems (sub_multiple);
 	      tree sub_multiple_element_type = TREE_TYPE (sub_multiple_elements_type);
diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc
index b73f194ac0e..f54158bb26c 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -415,7 +415,7 @@ a68_low_deref (tree exp, NODE_T *p)
     }
 }
 
-/* Get a deep-copy of a given value EXP.  */
+/* Get a deep-copy of a given Algol 68 value EXP.  */
 
 tree
 a68_low_dup (tree expr, bool use_heap)
@@ -426,80 +426,112 @@ a68_low_dup (tree expr, bool use_heap)
   /* XXX */
   use_heap = true;
 
+  /* Determine the mode corresponding to the type of EXPR.  */
+  MOID_T *m = a68_type_moid (type);
+  gcc_assert (m != NO_MOID);
+  while (EQUIVALENT (m) != NO_MOID)
+    m = EQUIVALENT (m);
+
   if (A68_ROW_TYPE_P (type))
     {
+      /* We need to copy the elements as well as the descriptor.  There is no
+	 need to check bounds.  */
+
+      /* Deflexe the mode as appropriate.  */
+      while (IS_FLEX (m))
+	m = SUB (m);
+      gcc_assert (IS_ROW (m) || m == M_STRING);
+
+      a68_push_range (NULL);
+
+      /* First allocate space for the dupped elements.  */
       expr = save_expr (expr);
-      /* We need to copy the elements as well as the descriptor.  There is
-	 no need to check bounds.  */
       tree elements = a68_multiple_elements (expr);
       tree element_pointer_type = TREE_TYPE (elements);
       tree element_type = TREE_TYPE (element_pointer_type);
-      a68_push_range (NULL);
-
-      /* We calculate num_elems by dividing new_elements_size by the byte
-	 size of the type of the elements.  This includes elements that are
-	 not accessible due to trimming.  */
-      tree new_elements_size = a68_multiple_elements_size (expr);
-      new_elements_size = save_expr (new_elements_size);
-      tree num_elems = a68_lower_tmpvar ("numelems%", size_type_node,
-					 fold_build2 (TRUNC_DIV_EXPR, sizetype,
-						      new_elements_size,
-						      size_in_bytes (element_type)));
-      tree orig_elements = a68_lower_tmpvar ("orig_elements%",
-					     element_pointer_type, elements);
+      tree new_elements_size = save_expr (a68_multiple_elements_size (expr));
       tree new_elements = a68_lower_tmpvar ("new_elements%",
-					    element_pointer_type,
+					    TREE_TYPE (elements),
 					    (use_heap
 					     ? a68_lower_malloc (TREE_TYPE (TREE_TYPE (elements)),
 								 new_elements_size)
 					     : a68_lower_alloca (TREE_TYPE (TREE_TYPE (elements)),
 								 new_elements_size)));
-      tree index = a68_lower_tmpvar ("index%", size_type_node, size_zero_node);
 
-      /* Begin of loop body.  */
-      a68_push_range (NULL);
+      /* Then copy the elements.
 
-      /* if (index == num_elems) break; */
-      a68_add_stmt (fold_build1 (EXIT_EXPR,
-				 void_type_node,
-				 fold_build2 (EQ_EXPR,
-					      size_type_node,
-					      index, num_elems)));
-      /* new_elements[index] = elements[index] */
-      tree offset = fold_build2 (MULT_EXPR, sizetype,
-				 index, size_in_bytes (element_type));
-      a68_add_stmt (fold_build2 (MODIFY_EXPR,
-				 element_type,
-				 fold_build2 (MEM_REF,
-					      element_type,
+	 If the mode of the elements stored in the multiple dont have rows,
+	 then we can just use memcpy.  Otherwise, we have to loop and recurse
+	 to dup all the elements in the multiple one by one.
+
+	 The above applies to multiples of any number of dimensions.  */
+      if (m == M_STRING || !HAS_ROWS (SUB (m)))
+	{
+	  a68_add_stmt (a68_lower_memcpy (new_elements,
+					  elements,
+					  new_elements_size));
+	  a68_add_stmt (new_elements);
+	}
+      else
+	{
+	  /* We calculate num_elems by dividing new_elements_size by the byte
+	     size of the type of the elements.  This includes elements that are
+	     not accessible due to trimming.  */
+	  tree num_elems = a68_lower_tmpvar ("numelems%", size_type_node,
+					     fold_build2 (TRUNC_DIV_EXPR, sizetype,
+							  new_elements_size,
+							  size_in_bytes (element_type)));
+	  tree orig_elements = a68_lower_tmpvar ("orig_elements%",
+						 element_pointer_type, elements);
+	  tree index = a68_lower_tmpvar ("index%", size_type_node, size_zero_node);
+
+	  /* Begin of loop body.  */
+	  a68_push_range (NULL);
+
+	  /* if (index == num_elems) break; */
+	  a68_add_stmt (fold_build1 (EXIT_EXPR,
+				     void_type_node,
+				     fold_build2 (EQ_EXPR,
+						  size_type_node,
+						  index, num_elems)));
+	  /* new_elements[index] = elements[index] */
+	  tree offset = fold_build2 (MULT_EXPR, sizetype,
+				     index, size_in_bytes (element_type));
+	  tree new_elem_lvalue = fold_build2 (MEM_REF, element_type,
 					      fold_build2 (POINTER_PLUS_EXPR,
 							   element_pointer_type,
 							   new_elements,
 							   offset),
 					      fold_convert (element_pointer_type,
-							    integer_zero_node)),
-				 a68_low_dup (fold_build2 (MEM_REF,
-							   element_type,
-							   fold_build2 (POINTER_PLUS_EXPR,
-									element_pointer_type,
-									orig_elements,
-									offset),
-							   fold_convert (element_pointer_type,
-									 integer_zero_node)),
-					      use_heap)));
-      /* index++ */
-      a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR,
-				 size_type_node,
-				 index, size_one_node));
-      tree loop_body = a68_pop_range ();
-      /* End of loop body.  */
-
-      a68_add_stmt (fold_build1 (LOOP_EXPR,
-				 void_type_node,
-				 loop_body));
-      a68_add_stmt (new_elements);
+							    integer_zero_node));
+	  tree elem = fold_build2 (MEM_REF, element_type,
+				   fold_build2 (POINTER_PLUS_EXPR,
+						element_pointer_type,
+						orig_elements,
+						offset),
+				   fold_convert (element_pointer_type,
+						 integer_zero_node));
+	  a68_add_stmt (fold_build2 (MODIFY_EXPR, element_type,
+				     new_elem_lvalue,
+				     a68_low_dup (elem, use_heap)));
+	  /* index++ */
+	  a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR,
+				     size_type_node,
+				     index, size_one_node));
+	  tree loop_body = a68_pop_range ();
+	  /* End of loop body.  */
+
+	  a68_add_stmt (fold_build1 (LOOP_EXPR,
+				     void_type_node,
+				     loop_body));
+	  a68_add_stmt (new_elements);
+	}
+
       new_elements = a68_pop_range ();
       TREE_TYPE (new_elements) = element_pointer_type;
+
+      /* Now build a descriptor pointing to the dupped elements and return it.
+	 Note that the descriptor is always allocated on the stack.  */
       dup = a68_row_value_raw (type,
 			       a68_multiple_triplets (expr),
 			       new_elements,
-- 
2.30.2



More information about the Algol68 mailing list