Signed-off-by: Jose E. Marchesi <[email protected]>
gcc/algol68/ChangeLog
* a68-low-ranges.cc (a68_pop_range): Do not consolidate refs in
last unit in the range's statement list, becuase it has already
been consolidated.
(a68_add_completer): Just call to a68_consolidate_ref and avoid
tsi_delink.
(a68_pop_serial_clause_range): Likewise.
* a68-low-clauses.cc (a68_lower_labeled_unit): Consolidate ref in
second componend of compound expr.
* a68-low.cc (a68_consolidate_ref): Simplify and do not handle
compound expressions in a special way.
gcc/testsuite/ChangeLog
* algol68/execute/labeled-unit-1.a68: New test.
* algol68/execute/plusab-5.a68: Likewise.
---
gcc/algol68/a68-low-clauses.cc | 5 +-
gcc/algol68/a68-low-ranges.cc | 52 +++----------------
gcc/algol68/a68-low.cc | 40 ++++++--------
.../algol68/execute/labeled-unit-1.a68 | 9 ++++
gcc/testsuite/algol68/execute/plusab-5.a68 | 9 ++++
5 files changed, 46 insertions(+), 69 deletions(-)
create mode 100644 gcc/testsuite/algol68/execute/labeled-unit-1.a68
create mode 100644 gcc/testsuite/algol68/execute/plusab-5.a68
diff --git a/gcc/algol68/a68-low-clauses.cc b/gcc/algol68/a68-low-clauses.cc
index 29ccc43b076..e6731810012 100644
--- a/gcc/algol68/a68-low-clauses.cc
+++ b/gcc/algol68/a68-low-clauses.cc
@@ -128,7 +128,10 @@ tree
a68_lower_labeled_unit (NODE_T *p, LOW_CTX_T ctx)
{
tree label_expr = a68_lower_tree (SUB (p), ctx);
- tree unit_expr = a68_lower_tree (NEXT (SUB (p)), ctx);
+ tree unit_expr = a68_lower_tree (NEXT_SUB (p), ctx);
+
+ /* If the labeled unit yields a name, make sure an address is computed. */
+ unit_expr = a68_consolidate_ref (MOID (NEXT_SUB (p)), unit_expr);
return fold_build2_loc (a68_get_node_location (p),
COMPOUND_EXPR,
diff --git a/gcc/algol68/a68-low-ranges.cc b/gcc/algol68/a68-low-ranges.cc
index 9a2008aa571..70e189344d9 100644
--- a/gcc/algol68/a68-low-ranges.cc
+++ b/gcc/algol68/a68-low-ranges.cc
@@ -187,16 +187,6 @@ a68_pop_range (void)
current_range = range->next;
tree type = (range->mode == NULL ? void_type_node : CTYPE (range->mode));
- /* If TYPE is a pointer type and the last expression in the statement list is
- a variable of the type pointed by TYPE then take its address. */
- tree_stmt_iterator i = tsi_last (range->stmt_list);
- if (POINTER_TYPE_P (type) && TREE_TYPE (type) == TREE_TYPE (tsi_stmt (i)))
- {
- append_to_statement_list_force (a68_consolidate_ref (range->mode,
tsi_stmt (i)),
- &range->stmt_list);
- tsi_delink (&i);
- }
-
tree clause = NULL_TREE;
if (range->frameless)
clause = range->stmt_list;
@@ -318,30 +308,15 @@ a68_add_completer (void)
struct range *range = current_range;
/* The last statement in the statements list is either a single unit or a
- labeled unit, i.e a COMPOUND_EXPR whose first expression is a label and
- second expression is the unit. Consolidate the unit within the labeled
- unit to a ref. */
+ labeled unit. Consolidate the unit within the labeled unit to a ref and
+ put it in the clause result decl. */
tree_stmt_iterator i = tsi_last (range->stmt_list);
- tree last_expr = tsi_stmt (i);
+ *tsi_stmt_ptr (i) = fold_build2 (MODIFY_EXPR,
+ void_type_node,
+ range->clause_result_decl,
+ a68_consolidate_ref (range->mode, tsi_stmt
(i)));
- if (TREE_CODE (last_expr) == COMPOUND_EXPR
- && TREE_CODE (TREE_OPERAND (last_expr, 0)) == LABEL_EXPR)
- {
- TREE_OPERAND (last_expr, 1) = a68_consolidate_ref (range->mode,
- TREE_OPERAND
(last_expr, 1));
- TREE_TYPE (last_expr) = TREE_TYPE (TREE_OPERAND (last_expr, 1));
- }
- else
- last_expr = a68_consolidate_ref (range->mode, last_expr);
-
- /* Now assign the labeled unit to the clause result decl then jump to the end
- of the serial clause. */
- append_to_statement_list_force (fold_build2 (MODIFY_EXPR,
- void_type_node,
- range->clause_result_decl,
- last_expr),
- &range->stmt_list);
- tsi_delink (&i);
+ /* Jump to the end of the serial clause. */
append_to_statement_list_force (fold_build1 (GOTO_EXPR, void_type_node,
range->clause_exit_label_decl),
&range->stmt_list);
@@ -562,18 +537,7 @@ a68_pop_serial_clause_range (void)
serial clause. */
{
tree_stmt_iterator si = tsi_last (range->stmt_list);
- tree last_expr = tsi_stmt (si);
- if (TREE_CODE (last_expr) == COMPOUND_EXPR
- && TREE_CODE (TREE_OPERAND (last_expr, 0)) == LABEL_EXPR)
- {
- TREE_OPERAND (last_expr, 1) = a68_consolidate_ref (range->mode,
- TREE_OPERAND
(last_expr, 1));
- TREE_TYPE (last_expr) = TREE_TYPE (TREE_OPERAND (last_expr, 1));
- }
- else
- last_expr = a68_consolidate_ref (range->mode, last_expr);
- a68_add_stmt (last_expr);
- tsi_delink (&si);
+ *tsi_stmt_ptr (si) = a68_consolidate_ref (range->mode, tsi_stmt (si));
}
/* If the serial clause has completers, we have to make use of the
diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc
index de7f21dc910..40636601c03 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -403,32 +403,25 @@ a68_consolidate_ref (MOID_T *m, tree expr)
/* Address EXPR as many times as necessary to match the number of REFs in the
desired mode. */
- while (num_pointers < num_refs)
+
+ if (num_pointers == num_refs)
+ ; /* We are good. */
+ else if (num_pointers == num_refs - 1)
{
- if (TREE_CODE (expr) == COMPOUND_EXPR)
- {
- /* (..., x) -> (..., &x) */
- // gcc_assert (TREE_CODE (TREE_OPERAND (expr, 0)) ==
MODIFY_EXPR);
- // gcc_assert (VAR_P (TREE_OPERAND (expr, 1)));
- TREE_OPERAND (expr, 1) = a68_consolidate_ref (m, TREE_OPERAND (expr,
1));
- TREE_TYPE (expr) = TREE_TYPE (TREE_OPERAND (expr, 1));
- }
+ /* x -> &x */
+ if (TREE_CODE (expr) == INDIRECT_REF)
+ /* expr is an indirection. Remove the pointer rather than adding an
+ addr. This avoids &* situations and marking stuff as addressable
+ unnecessarily. */
+ expr = TREE_OPERAND (expr,0);
else
{
- /* x -> &x */
- if (TREE_CODE (expr) == INDIRECT_REF)
- /* expr is an indirection. Remove the pointer rather than adding
- an addr. This avoids &* situations and marking stuff as
- addressable unnecessarily. */
- expr = TREE_OPERAND (expr,0);
- else
- {
- TREE_ADDRESSABLE (expr) = true;
- expr = fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE
(expr)), expr);
- }
+ TREE_ADDRESSABLE (expr) = true;
+ expr = fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (expr)),
expr);
}
- num_pointers += 1;
}
+ else
+ gcc_unreachable ();
return expr;
}
@@ -450,9 +443,8 @@ a68_make_anonymous_routine_decl (MOID_T *mode)
free (name);
DECL_EXTERNAL (func_decl) = 0;
DECL_STATIC_CHAIN (func_decl) = !a68_in_global_range ();
- /* Nested functions should be addressable.
- XXX this should be propagated to their containing functions, so for now
- we mark them all as addressable. */
+ /* Anonymous routines will always be nested, and nested functions should be
+ addressable. */
TREE_ADDRESSABLE (func_decl) = 1;
/* A nested function is not global. */
TREE_PUBLIC (func_decl) = a68_in_global_range ();
diff --git a/gcc/testsuite/algol68/execute/labeled-unit-1.a68
b/gcc/testsuite/algol68/execute/labeled-unit-1.a68
new file mode 100644
index 00000000000..b7536ce4ba6
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/labeled-unit-1.a68
@@ -0,0 +1,9 @@
+{ Check ref consolidation of labeled unit. }
+
+begin int foo;
+ (skip; lala: lele: foo) := 100;
+ assert(foo = 100);
+ ref int bar = loc int;
+ (skip; lala: lele: bar) := 200;
+ assert(bar = 200)
+end
diff --git a/gcc/testsuite/algol68/execute/plusab-5.a68
b/gcc/testsuite/algol68/execute/plusab-5.a68
new file mode 100644
index 00000000000..00925b82d3b
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/plusab-5.a68
@@ -0,0 +1,9 @@
+{ Check ref consolidation of var and ide. }
+
+begin int foo;
+ foo +:= 10 := 20;
+ assert(foo = 20);
+ ref int bar = loc int;
+ bar +:= 10 := 30;
+ assert(bar = 30)
+end
--
2.39.5
