[COMMITTED] algol68: generalize and fix a68_multiple_copy_elems
Jose E. Marchesi
jemarch@gnu.org
Sat May 31 02:54:04 GMT 2025
---
gcc/algol68/a68-low-multiples.cc | 182 +++++++++++-------
gcc/algol68/a68-low.cc | 7 +-
gcc/algol68/a68.h | 2 +-
.../execute/assignation-multiple-2.a68 | 15 ++
4 files changed, 137 insertions(+), 69 deletions(-)
create mode 100644 gcc/testsuite/algol68/execute/assignation-multiple-2.a68
diff --git a/gcc/algol68/a68-low-multiples.cc b/gcc/algol68/a68-low-multiples.cc
index d35854e31c7..22688f07387 100644
--- a/gcc/algol68/a68-low-multiples.cc
+++ b/gcc/algol68/a68-low-multiples.cc
@@ -588,14 +588,6 @@ a68_multiple_slice (NODE_T *p,
tree element_pointer_type = TREE_TYPE (elements);
tree element_type = TREE_TYPE (element_pointer_type);
-#if 0
- /* Multiply index by the element size. */
- index = fold_build2 (MULT_EXPR,
- sizetype,
- index,
- fold_convert (sizetype, size_in_bytes (element_type)));
-#endif
-
/* Now refer to the indexed element. In case we are slicing a ref to a
multiple, return the address of the element and not the element
itself. */
@@ -628,74 +620,134 @@ a68_multiple_slice (NODE_T *p,
return slice;
}
-/* Copy the elements of the multiple FROM to the multiple TO.
+/* Auxiliary routine for a68_multiple_copy_elemens. */
+
+static tree
+copy_multiple_dimension_elems (size_t dim, size_t num_dimensions,
+ tree to, tree from,
+ tree to_elements, tree from_elements,
+ tree *to_offset, tree *from_offset,
+ tree *indexes)
+{
+ tree element_pointer_type = TREE_TYPE (from_elements);
+ tree element_type = TREE_TYPE (element_pointer_type);
+ tree upb = a68_multiple_upper_bound (from, size_int (dim));
- The dimensions and bounds of both multiples are supposed to match, but since
- strides can be different the elements buffers may be of different sizes.
+ char *name = xasprintf ("r%d%%", dim);
+ indexes[dim] = a68_lower_tmpvar (name, ssizetype,
+ a68_multiple_lower_bound (from,
+ size_int (dim)));
+ free (name);
- Therefore we have to copy element by element, dimension by dimension,
- slicing the destination, and taking strides into account. */
+ /* Loop body. */
+ a68_push_range (NULL);
+ {
+ /* if (indexes[dim] > upb) break; */
+ a68_add_stmt (fold_build1 (EXIT_EXPR, void_type_node,
+ fold_build2 (GT_EXPR, size_type_node,
+ indexes[dim], upb)));
+
+ /* Add this dimension's contribution to the offsets. */
+ tree index = fold_convert (sizetype,
+ fold_build2 (MINUS_EXPR, ssizetype,
+ upb, indexes[dim]));
+ *to_offset = fold_build2 (PLUS_EXPR, sizetype,
+ *to_offset,
+ fold_build2 (MULT_EXPR, sizetype,
+ index,
+ a68_multiple_stride (to, size_int (dim))));
+ *from_offset = fold_build2 (PLUS_EXPR, sizetype,
+ *from_offset,
+ fold_build2 (MULT_EXPR, sizetype,
+ index,
+ a68_multiple_stride (from, size_int (dim))));
+
+ if (dim == num_dimensions - 1)
+ {
+ /* Most inner loop, copy one element. */
+
+ tree to_off = a68_lower_tmpvar ("to_offset%", sizetype, *to_offset);
+ tree from_off = a68_lower_tmpvar ("from_offset%", sizetype, *from_offset);
+
+ tree to_elem = fold_build2 (MEM_REF,
+ element_type,
+ fold_build2 (POINTER_PLUS_EXPR,
+ element_pointer_type,
+ to_elements,
+ to_off),
+ fold_convert (element_pointer_type,
+ integer_zero_node));
+ tree from_elem = fold_build2 (MEM_REF,
+ element_type,
+ fold_build2 (POINTER_PLUS_EXPR,
+ element_pointer_type,
+ from_elements,
+ from_off),
+ fold_convert (element_pointer_type,
+ integer_zero_node));
+
+ /* XXX
+ if may_overlap then modify only if dst_offset < src_offset */
+ a68_add_stmt (fold_build2 (MODIFY_EXPR, element_type,
+ to_elem, from_elem));
+ }
+ else
+ {
+ a68_add_stmt (copy_multiple_dimension_elems (dim + 1, num_dimensions,
+ to, from,
+ to_elements, from_elements,
+ to_offset, from_offset,
+ indexes));
+ }
+
+ /* indexes[dim]++ */
+ a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, ssizetype,
+ indexes[dim], ssize_int (1)));
+ }
+ tree loop_body = a68_pop_range ();
+
+ return fold_build1 (LOOP_EXPR, void_type_node, loop_body);
+}
+
+/* Copy the elements of a given multiple (string) FROM to the multiple (string)
+ TO.
+
+ The dimensions and bounds of both multiples are supposed to match, and they
+ are supposed to not be flat.
+
+ XXX simple cases with same strides may be done with a memcpy.
+ XXX compile this into a support routine to reduce code size. */
tree
-a68_multiple_copy_elems (tree to, tree from)
+a68_multiple_copy_elems (MOID_T *mode, tree to, tree from)
{
gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (to))
&& A68_ROW_TYPE_P (TREE_TYPE (from)));
- tree from_elems = a68_multiple_elements (from);
- tree to_elems = a68_multiple_elements (to);
- tree element_pointer_type = TREE_TYPE (from_elems);
- tree element_type = TREE_TYPE (element_pointer_type);
+ /* Deflex modes as needed and determine dimension. */
+ if (IS_FLEX (mode))
+ mode = SUB (mode);
+ int num_dimensions = (mode == M_STRING ? 1 : DIM (mode));
a68_push_range (NULL);
- tree num_elems = a68_lower_tmpvar ("numelems%", size_type_node,
- a68_multiple_num_elems (from));
- tree from_elements = a68_lower_tmpvar ("from_elements%", element_pointer_type,
- from_elems);
+ to = a68_lower_tmpvar ("to%", TREE_TYPE (to), to);
+ from = a68_lower_tmpvar ("from%", TREE_TYPE (from), from);
+ tree from_elements = a68_multiple_elements (from);
+ tree element_pointer_type = TREE_TYPE (from_elements);
+ from_elements = a68_lower_tmpvar ("from_elements%", element_pointer_type,
+ from_elements);
tree to_elements = a68_lower_tmpvar ("to_elements%", element_pointer_type,
- to_elems);
- 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));
- a68_add_stmt (fold_build2 (MODIFY_EXPR,
- element_type,
- fold_build2 (MEM_REF,
- element_type,
- fold_build2 (POINTER_PLUS_EXPR,
- element_pointer_type,
- to_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,
- from_elements,
- offset),
- fold_convert (element_pointer_type,
- integer_zero_node)))));
- /* 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_multiple_elements (to));
+
+ tree *indexes = (tree *) xmalloc (num_dimensions * sizeof (tree));
+ tree to_offset = size_zero_node;
+ tree from_offset = size_zero_node;
+ a68_add_stmt (copy_multiple_dimension_elems (0 /* dim */, num_dimensions,
+ to, from,
+ to_elements, from_elements,
+ &to_offset, &from_offset,
+ indexes));
+ free (indexes);
return a68_pop_range ();
}
diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc
index 967fc228c42..047ba7fae36 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -679,8 +679,9 @@ a68_low_assignation (NODE_T *p,
if (IS_FLEXETY_ROW (mode_rhs))
{
/* Make a deep copy of the rhs. Note that we have to use the heap
- because the scope of the lhs may be older than the scope of the
- rhs. */
+ because the scope of the lhs may be older than the scope of the rhs.
+ XXX this can be ommitted if a68_multiple_copy_elems below supports
+ overlapping multiples. */
if (HAS_ROWS (mode_rhs))
rhs = a68_low_dup (rhs, true /* use_heap */);
rhs = save_expr (rhs);
@@ -740,7 +741,7 @@ a68_low_assignation (NODE_T *p,
/* Copy over the elements in a loop. The space occupied by the
previous elements stored in the lhs multiple will be recovered by
either stack shrinkage or garbage collected. */
- tree copy_elements = a68_multiple_copy_elems (effective_lhs, rhs);
+ tree copy_elements = a68_multiple_copy_elems (mode_rhs, effective_lhs, rhs);
assignation = fold_build2 (COMPOUND_EXPR,
TREE_TYPE (lhs),
copy_elements,
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index d60a04b4ed0..67220d1955b 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -657,7 +657,7 @@ tree a68_row_malloc (tree type, int dim,
tree *lower_bound, tree *upper_bound);
tree a68_multiple_slice (NODE_T *p, tree multiple, bool slicing_name,
int num_indexes, tree *indexes);
-tree a68_multiple_copy_elems (tree to, tree from);
+tree a68_multiple_copy_elems (MOID_T *to_mode, tree to, tree from);
tree a68_rows_dim (tree exp);
tree a68_rows_value (tree multiple);
tree a68_rows_lower_bound (tree rows, tree dim);
diff --git a/gcc/testsuite/algol68/execute/assignation-multiple-2.a68 b/gcc/testsuite/algol68/execute/assignation-multiple-2.a68
new file mode 100644
index 00000000000..22ff7e11942
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/assignation-multiple-2.a68
@@ -0,0 +1,15 @@
+begin [5]struct(char i, real r) foo;
+
+ { The stride in the single dimension of the multiple resulting
+ from the selection is not the size of a 'char'. }
+ i of foo := ("a","b","c","d","e");
+ puts ((i of foo) + "'n");
+ { Via indexing then selection. }
+ assert (i of foo[1] = "a");
+ assert (i of foo[2] = "b");
+ assert (i of foo[3] = "c");
+ assert (i of foo[4] = "d");
+ assert (i of foo[5] = "e");
+ { Via selection of multiple. }
+ assert (i of foo = "abcde");
+end
--
2.30.2
More information about the Algol68
mailing list