[COMMITTED] a68: guard execution of top-level module preludes and postludes

[Jose E. Marchesi]

---
 gcc/algol68/a68-low.cc                        | 88 ++++++++++++++++---
 .../algol68/execute/modules/module16.a68      |  8 ++
 .../algol68/execute/modules/program-16.a68    |  8 ++
 3 files changed, 90 insertions(+), 14 deletions(-)
 create mode 100644 gcc/testsuite/algol68/execute/modules/module16.a68
 create mode 100644 gcc/testsuite/algol68/execute/modules/program-16.a68

diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc
index 7d2b5e97472..859d873c28e 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -1240,6 +1240,19 @@ lower_module_text (NODE_T *p, LOW_CTX_T ctx)
 			   : NEXT (def_part));
   NODE_T *prelude_enquiry = NEXT_SUB (def_part);
 
+  /* The global sentinel of the module, initialized to 0.  */
+  tree sentinel_decl = build_decl (UNKNOWN_LOCATION,
+				   VAR_DECL, NULL /* name */,
+				   sizetype);
+  char *sentinel_name = xasprintf ("%s__sentinel", ctx.module_definition_name);
+  DECL_NAME (sentinel_decl) = get_identifier (sentinel_name);
+  free (sentinel_name);
+  TREE_PUBLIC (sentinel_decl) = 0;
+  TREE_STATIC (sentinel_decl) = 1;
+  DECL_CONTEXT (sentinel_decl) = NULL_TREE;  /* File scope.  */
+  make_decl_rtl (sentinel_decl);
+  varpool_node::finalize_decl (sentinel_decl);
+
   /* Create the prelude function.  */
   tree prelude_decl = build_decl (a68_get_node_location (def_part),
 				  FUNCTION_DECL,
@@ -1255,10 +1268,34 @@ lower_module_text (NODE_T *p, LOW_CTX_T ctx)
 
   a68_push_function_range (prelude_decl,
 			   void_type_node /* result_type */, true /* top_level */);
-  /* Add calls to preludes of modules in REVELATION_PART.  */
-  lower_revelations (revelation_part, ctx, true /* prelude */);
-  tree prelude_body_expr = a68_lower_tree (prelude_enquiry, ctx);
-  a68_pop_function_range (prelude_body_expr);
+  {
+    /* Increase sentinel.  */
+    a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR,
+			       sizetype,
+			       sentinel_decl, size_one_node));
+
+    a68_push_stmt_list (M_VOID);
+    {
+      a68_push_stmt_list (M_VOID);
+      {
+	/* Add calls to preludes of modules in REVELATION_PART.  */
+	lower_revelations (revelation_part, ctx, true /* prelude */);
+	a68_add_stmt (a68_lower_tree (prelude_enquiry, ctx));
+      }
+      tree do_prelude = a68_pop_stmt_list ();
+
+      a68_push_stmt_list (M_VOID);
+      tree do_nothing = a68_pop_stmt_list ();
+
+      /* Do the prelude work only if sentinel is 1.  */
+      a68_add_stmt (fold_build3 (COND_EXPR, void_type_node,
+				 fold_build2 (EQ_EXPR, sizetype,
+					      sentinel_decl, size_one_node),
+				 do_prelude, do_nothing));
+    }
+    tree prelude_body = a68_pop_stmt_list ();
+    a68_pop_function_range (prelude_body);
+  }
 
   /* Create the postlude function.  This is done even if the module definition
      has no postlude in the source code.  */
@@ -1277,19 +1314,42 @@ lower_module_text (NODE_T *p, LOW_CTX_T ctx)
   DECL_EXTERNAL (postlude_decl) = 0;
   TREE_PUBLIC (postlude_decl) = 1;
   TREE_STATIC (postlude_decl) = 1;
-  
+
   a68_push_function_range (postlude_decl,
 			   void_type_node /* result_type */, true /* top_level */);
+  {
+    /* Decrease sentinel.  */
+    a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR,
+			       sizetype,
+			       sentinel_decl, size_one_node));
 
-  NODE_T *postlude_serial = NO_NODE;
-  if (postlude_part != NO_NODE)
-    postlude_serial = NEXT_SUB (postlude_part);
-  /* Add calls to postludes of modules in REVELATION_PART.  */
-  lower_revelations (revelation_part, ctx, false /* prelude */);
-  tree postlude_body_expr = NULL_TREE;
-  if (postlude_serial != NO_NODE)
-    postlude_body_expr = a68_lower_tree (postlude_serial, ctx);
-  a68_pop_function_range (postlude_body_expr);
+    a68_push_stmt_list (M_VOID);
+    {
+      a68_push_stmt_list (M_VOID);
+      {
+	/* Add calls to postludes of modules in REVELATION_PART.  */
+	lower_revelations (revelation_part, ctx, false /* prelude */);
+	/* Perhaps the postlude code, if there is one.  */
+	NODE_T *postlude_serial = NO_NODE;
+	if (postlude_part != NO_NODE)
+	  postlude_serial = NEXT_SUB (postlude_part);
+	if (postlude_serial != NO_NODE)
+	  a68_add_stmt (a68_lower_tree (postlude_serial, ctx));
+      }
+      tree do_postlude = a68_pop_stmt_list ();
+
+      a68_push_stmt_list (M_VOID);
+      tree do_nothing = a68_pop_stmt_list ();
+
+      /* Do the postlude work only if sentinel is 0.  */
+      a68_add_stmt (fold_build3 (COND_EXPR, void_type_node,
+				 fold_build2 (EQ_EXPR, sizetype,
+					      sentinel_decl, size_zero_node),
+				 do_postlude, do_nothing));
+    }
+    tree postlude_body = a68_pop_stmt_list ();
+    a68_pop_function_range (postlude_body);
+  }
 
   return NULL_TREE;
 }
diff --git a/gcc/testsuite/algol68/execute/modules/module16.a68 b/gcc/testsuite/algol68/execute/modules/module16.a68
new file mode 100644
index 00000000000..d798d4ff874
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/module16.a68
@@ -0,0 +1,8 @@
+module Module_16 =
+def
+    pub int counter;
+    skip
+postlude
+    assert (counter = 666);
+    skip
+fed
diff --git a/gcc/testsuite/algol68/execute/modules/program-16.a68 b/gcc/testsuite/algol68/execute/modules/program-16.a68
new file mode 100644
index 00000000000..dd6ddb6b941
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/program-16.a68
@@ -0,0 +1,8 @@
+{ dg-modules module16 }
+
+access Module_16
+begin assert (counter = 0);
+      counter := 20;
+      access Module_16 (assert (counter = 20));
+      counter := 666
+end
-- 
2.30.2