[COMMITTED] algol68: factorize out serial_clause_dsa and use it appropriately

[Jose E. Marchesi]

---
 gcc/algol68/a68-low-clauses.cc | 82 ++++++++++++++++++++++------------
 1 file changed, 54 insertions(+), 28 deletions(-)

diff --git a/gcc/algol68/a68-low-clauses.cc b/gcc/algol68/a68-low-clauses.cc
index 821adda4d09..d59158dce4f 100644
--- a/gcc/algol68/a68-low-clauses.cc
+++ b/gcc/algol68/a68-low-clauses.cc
@@ -42,6 +42,33 @@
 
 #include "a68.h"
 
+/* Given a serial_clause node, return whether it performs dynamic stack
+   allocations.
+
+   This function allocates for the fact that the bottom-up parser generates
+   successively nested serial clauses like
+
+     SERIAL_CLAUSE
+       SERIAL_CLAUSE
+        ...
+
+   the outer of which corresponds to a single serial clause in the source code,
+   but it is the inner ones annotated by the dsa pass.  */
+
+static bool
+serial_clause_dsa (NODE_T *p)
+{
+  NODE_T *s = NEXT (SUB (p));
+
+  for (s = p; SUB (s) &&  IS (s, SERIAL_CLAUSE); s = SUB (s))
+    {
+      if (DYNAMIC_STACK_ALLOCS (s))
+	return true;
+    }
+
+  return false;
+}
+
 /* Lower one or more labels.
 
      label : defining identifier, colon symbol;
@@ -406,8 +433,8 @@ a68_lower_loop_clause (NODE_T *p ATTRIBUTE_UNUSED,
       }
 
     /* Serial clauses in DO .. OD do not yield any value.  */
-    a68_push_serial_clause_range (M_VOID,
-				  DYNAMIC_STACK_ALLOCS (NEXT (SUB (s))));
+    bool dsa = serial_clause_dsa (NEXT (SUB (s)));
+    a68_push_serial_clause_range (M_VOID, dsa);
     (void) a68_lower_tree (NEXT (SUB (s)), ctx);
     do_part = a68_pop_serial_clause_range ();
     a68_add_stmt (do_part);
@@ -596,13 +623,16 @@ a68_lower_conformity_clause (NODE_T *p, LOW_CTX_T ctx)
     {
     case CHOICE:
     case OUT_PART:
-      a68_push_serial_clause_range (conformity_clause_mode,
-				    DYNAMIC_STACK_ALLOCS (NEXT (SUB (s))));
-      (void) a68_lower_tree (NEXT (SUB (s)), ctx);
-      a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result),
-				 result, a68_pop_serial_clause_range ()));
-      a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label));
-      break;
+      {
+	bool dsa = serial_clause_dsa (NEXT (SUB (s)));
+	a68_push_serial_clause_range (conformity_clause_mode, dsa);
+
+	(void) a68_lower_tree (NEXT (SUB (s)), ctx);
+	a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result),
+				   result, a68_pop_serial_clause_range ()));
+	a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label));
+	break;
+      }
     case CLOSE_SYMBOL:
     case ESAC_SYMBOL:
       a68_add_stmt (fold_build2 (MODIFY_EXPR,
@@ -731,13 +761,16 @@ a68_lower_case_clause (NODE_T *p ATTRIBUTE_UNUSED,
     {
     case CHOICE:
     case OUT_PART:
-      a68_push_serial_clause_range (case_clause_mode,
-				    DYNAMIC_STACK_ALLOCS (NEXT (SUB (s))));
-      (void) a68_lower_tree (NEXT (SUB (s)), ctx);
-      a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result),
-				 result, a68_pop_serial_clause_range ()));
-      a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label));
-      break;
+      {
+	bool dsa = serial_clause_dsa (NEXT (SUB (s)));
+	a68_push_serial_clause_range (case_clause_mode, dsa);
+
+	(void) a68_lower_tree (NEXT (SUB (s)), ctx);
+	a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result),
+				   result, a68_pop_serial_clause_range ()));
+	a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label));
+	break;
+      }
     case CLOSE_SYMBOL:
     case ESAC_SYMBOL:
       a68_add_stmt (fold_build2 (MODIFY_EXPR,
@@ -901,8 +934,9 @@ a68_lower_conditional_clause (NODE_T *p, LOW_CTX_T ctx)
 
   /* THEN part.  */
   FORWARD (s);
+  bool dsa = serial_clause_dsa (NEXT (SUB (s)));
   a68_push_serial_clause_range (is_rows ? effective_rows_mode : conditional_clause_mode,
-				DYNAMIC_STACK_ALLOCS (NEXT (SUB (s))));
+				dsa);
   (void) a68_lower_tree (NEXT (SUB (s)), ctx);
   then_expr = a68_pop_serial_clause_range ();
 
@@ -913,8 +947,9 @@ a68_lower_conditional_clause (NODE_T *p, LOW_CTX_T ctx)
     case CHOICE:
     case ELSE_PART:
       {
+	bool dsa = serial_clause_dsa (NEXT (SUB (s)));
 	a68_push_serial_clause_range (is_rows ? effective_rows_mode : conditional_clause_mode,
-				      DYNAMIC_STACK_ALLOCS (NEXT (SUB (s))));
+				      dsa);
 	(void) a68_lower_tree (NEXT (SUB (s)), ctx);
 	else_expr = a68_pop_serial_clause_range ();
 	break;
@@ -1297,17 +1332,8 @@ a68_lower_closed_clause (NODE_T *p, LOW_CTX_T ctx)
      case the range we are pushing corresponds to all of them, so we have to
      keep this into account when determining whether using a DSA serial
      range.  */
-  // XXX the same has to be done in all other occurences of
-  // a68_push_serial_clause_range
-  bool dsa = false;
-  NODE_T *s = NEXT (SUB (p));
-  for (s = NEXT (SUB (p)); SUB (s) && IS (s, SERIAL_CLAUSE); s = SUB (s))
-    {
-      dsa = DYNAMIC_STACK_ALLOCS (s);
-      if (dsa)
-	break;
-    }
 
+  bool dsa = serial_clause_dsa (NEXT (SUB (p)));
   a68_push_serial_clause_range (clause_mode, dsa);
   (void) a68_lower_tree (NEXT (SUB (p)), ctx);
   return a68_pop_serial_clause_range ();
-- 
2.30.2