[COMMITTED] a68: introduce 'static' memory allocation for declared variables

Jose E. Marchesi jemarch@gnu.org
Thu Nov 20 20:52:39 GMT 2025


---
 gcc/algol68/a68-low-decls.cc                  | 66 ++++++++++++++-----
 gcc/algol68/a68-low.cc                        |  5 +-
 gcc/algol68/a68-parser-attrs.def              |  1 +
 gcc/algol68/a68-parser-extract.cc             |  2 +
 gcc/algol68/a68-parser-taxes.cc               | 39 +++++++----
 .../algol68/execute/modules/module17.a68      | 13 ++++
 .../algol68/execute/modules/program-17.a68    |  7 ++
 7 files changed, 103 insertions(+), 30 deletions(-)
 create mode 100644 gcc/testsuite/algol68/execute/modules/module17.a68
 create mode 100644 gcc/testsuite/algol68/execute/modules/program-17.a68

diff --git a/gcc/algol68/a68-low-decls.cc b/gcc/algol68/a68-low-decls.cc
index 9314ac5f2a9..eca2e855431 100644
--- a/gcc/algol68/a68-low-decls.cc
+++ b/gcc/algol68/a68-low-decls.cc
@@ -193,23 +193,57 @@ a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
 
   tree expr = NULL_TREE;
 
-  /* If the variable is heap allocated or has rows, the var_decl created above
-     is a pointer.  Run a generator to get the memory with descriptors filled
-     in.  Note that we cannot set the pointer as the initial of the var_decl
-     because the bounds in the actual declarer shall be elaborated at the point
-     of the code where the declaration appears, not at the beginning of its
-     reach.  Note that the mode of the declarer will be always a REF since this
-     is a variable declaration: the referred mode is what we pass to
-     a68_low_generator.  */
-  bool heap = HEAP (TAX (defining_identifier)) == HEAP_SYMBOL;
-  if (heap || HAS_ROWS (SUB (MOID (defining_identifier))))
+  /* Allocate memory for the declared variables.
+
+     This is done differently depending on the sample generator used in the
+     variable declaration, be it explicit or the default LOC.
+
+     If the LOC generator is used and the value has no rows, it means it
+     doesnt' need a dynamic part and the var_decl created above is not a
+     pointer.  So the memory has been allocated already and there is nothing
+     else to do at this point.
+
+     If the HEAP generator is used, or if the generated value has rows, it
+     means the var_decl created above is a pointer.  We need to run a generator
+     to get the memory with descriptors filled in.  Note that we cannot set the
+     pointer as the initial of the var_decl because the bouns in the actual
+     declarer shall be elaborated at the point of the code where the
+     declaration appears, not at the beginning of its reach.  Note that the
+     mode of the declarer will be always a REF, since this is a varaible
+     declaration: the referred mode is what we pass to the a68_low_generator.
+
+     If the STATIC generator is used, the var_decl created above is not a
+     pointer.  The static part of the value has been already allocated, and if
+     the value needs a dynamic part (i.e. if it has rows) then it is allocated
+     using the heap.  Note how we allocate the whole value (including the
+     static part) and then we copy if over the var_decl.  */
+
+  if (HEAP (TAX (defining_identifier)) == STATIC_SYMBOL)
+    {
+      if (HAS_ROWS (SUB (MOID (defining_identifier))))
+	{
+	  expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (var_decl),
+			      var_decl,
+			      fold_build1 (INDIRECT_REF,
+					   TREE_TYPE (var_decl),
+					   a68_low_generator (declarer,
+							      MOID (declarer),
+							      true /* heap */,
+							      ctx)));
+	}
+    }
+  else
     {
-      gcc_assert(IS_REF (MOID (declarer)));
-      expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (var_decl),
-			  var_decl,
-			  a68_low_generator (declarer,
-					     SUB (MOID (declarer)),
-					     heap, ctx));
+      bool heap = HEAP (TAX (defining_identifier)) == HEAP_SYMBOL;
+      if (heap || HAS_ROWS (SUB (MOID (defining_identifier))))
+	{
+	  gcc_assert(IS_REF (MOID (declarer)));
+	  expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (var_decl),
+			      var_decl,
+			      a68_low_generator (declarer,
+						 SUB (MOID (declarer)),
+						 heap, ctx));
+	}
     }
 
   if (unit != NO_NODE)
diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc
index 37980d4b266..468cc474f1e 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -586,8 +586,9 @@ a68_make_variable_declaration_decl (NODE_T *identifier,
   gcc_assert (IS_REF (MOID (identifier)));
 
   MOID_T *mode = MOID (identifier);
-  bool use_pointer = ((HEAP (TAX (identifier)) == HEAP_SYMBOL)
-		      || HAS_ROWS (SUB (MOID (identifier))));
+  bool use_pointer = (HEAP (TAX (identifier)) != STATIC_SYMBOL
+		      && ((HEAP (TAX (identifier)) == HEAP_SYMBOL)
+			  || HAS_ROWS (SUB (MOID (identifier)))));
   bool public_range = PUBLIC_RANGE (TABLE (TAX (identifier)));
   tree type = use_pointer ? CTYPE (mode) : CTYPE (SUB (mode));
   tree decl = build_decl (a68_get_node_location (identifier),
diff --git a/gcc/algol68/a68-parser-attrs.def b/gcc/algol68/a68-parser-attrs.def
index d8274bab56c..31fc0d91f7d 100644
--- a/gcc/algol68/a68-parser-attrs.def
+++ b/gcc/algol68/a68-parser-attrs.def
@@ -340,6 +340,7 @@ A68_ATTR(SPECIFIER, "specifier")
 A68_ATTR(SPECIFIER_IDENTIFIER, "specifier identifier")
 A68_ATTR(STANDARD, "standard")
 A68_ATTR(STATIC_REPLICATOR, "static replicator")
+A68_ATTR(STATIC_SYMBOL, "static-symbol")
 A68_ATTR(STOWED_MODE, "stowed mode")
 A68_ATTR(STRING_C_PATTERN, "string C-like pattern")
 A68_ATTR(STRING_PATTERN, "string pattern")
diff --git a/gcc/algol68/a68-parser-extract.cc b/gcc/algol68/a68-parser-extract.cc
index 8d0265fd7ed..34774713c60 100644
--- a/gcc/algol68/a68-parser-extract.cc
+++ b/gcc/algol68/a68-parser-extract.cc
@@ -299,6 +299,7 @@ extract_revelation (NODE_T *q, bool is_public ATTRIBUTE_UNUSED)
       EXTERN_SYMBOL (tag) = xstrdup (EXTRACT_SYMBOL (e));
       VARIABLE (tag) = VARIABLE (e);
       IN_PROC (tag) = IN_PROC (e);
+      HEAP (tag) = STATIC_SYMBOL;
       MOIF (tag) = moif;
     }
 
@@ -318,6 +319,7 @@ extract_revelation (NODE_T *q, bool is_public ATTRIBUTE_UNUSED)
       gcc_assert (tag != NO_TAG);
       VARIABLE (tag) = VARIABLE (e);
       IN_PROC (tag) = IN_PROC (e);
+      HEAP (tag) = STATIC_SYMBOL;
       MOIF (tag) = moif;
       EXTERN_SYMBOL (tag) = xstrdup (EXTRACT_SYMBOL (e));
     }
diff --git a/gcc/algol68/a68-parser-taxes.cc b/gcc/algol68/a68-parser-taxes.cc
index 6e75cedc586..f2cce8c9e81 100644
--- a/gcc/algol68/a68-parser-taxes.cc
+++ b/gcc/algol68/a68-parser-taxes.cc
@@ -961,12 +961,16 @@ tax_variable_dec (NODE_T *p, int *q, MOID_T **m, bool e)
 	  MOID (p) = *m;
 	  TAX (p) = entry;
 	  PUBLICIZED (entry) = PUBLICIZED (p);
-	  HEAP (entry) = *q;
 
 	  if (PUBLICIZED (p) && e && *q == LOC_SYMBOL)
 	    a68_error (p, "publicized variable should not be allocated on the stack");
 
-	  if (*q == LOC_SYMBOL && !PUBLICIZED (p))
+	  if (PUBLICIZED (p))
+	    HEAP (entry) = STATIC_SYMBOL;
+	  else
+	    HEAP (entry) = *q;
+	  
+	  if (HEAP (entry) == LOC_SYMBOL)
 	    {
 	      TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, SUB (*m), GENERATOR);
 	      HEAP (z) = LOC_SYMBOL;
@@ -985,36 +989,47 @@ tax_variable_dec (NODE_T *p, int *q, MOID_T **m, bool e)
     }
 }
 
-/* Enter procedure variable declarations in the symbol table.  */
+/* Enter procedure variable declarations in the symbol table.
+
+   E is true if an explicit sample generator was specified in the procedure
+   variable declaration.  */
 
 static void
-tax_proc_variable_dec (NODE_T *p, int *q)
+tax_proc_variable_dec (NODE_T *p, int *q, bool e)
 {
   if (p != NO_NODE)
     {
       if (IS (p, PROCEDURE_VARIABLE_DECLARATION))
 	{
-	  tax_proc_variable_dec (SUB (p), q);
-	  tax_proc_variable_dec (NEXT (p), q);
+	  tax_proc_variable_dec (SUB (p), q, e);
+	  tax_proc_variable_dec (NEXT (p), q, e);
 	}
       else if (IS (p, QUALIFIER))
 	{
 	  *q = ATTRIBUTE (SUB (p));
-	  tax_proc_variable_dec (NEXT (p), q);
+	  tax_proc_variable_dec (NEXT (p), q, true);
 	}
       else if (a68_is_one_of (p, PROC_SYMBOL, COMMA_SYMBOL, STOP))
 	{
-	  tax_proc_variable_dec (NEXT (p), q);
+	  tax_proc_variable_dec (NEXT (p), q, e);
 	}
       else if (IS (p, DEFINING_IDENTIFIER))
 	{
 	  TAG_T *entry = find_tag_local (TABLE (p), IDENTIFIER, NSYMBOL (p));
 
 	  TAX (p) = entry;
-	  HEAP (entry) = *q;
 	  MOID (entry) = MOID (p);
 	  PUBLICIZED (entry) = PUBLICIZED (p);
-	  if (*q == LOC_SYMBOL)
+
+	  if (PUBLICIZED (p) && e && *q == LOC_SYMBOL)
+	    a68_error (p, "publicized variable should not be allocated on the stack");
+
+	  if (PUBLICIZED (p))
+	    HEAP (entry) = STATIC_SYMBOL;
+	  else
+	    HEAP (entry) = *q;
+
+	  if (HEAP (entry) == LOC_SYMBOL)
 	    {
 	      TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, SUB_MOID (p), GENERATOR);
 	      HEAP (z) = LOC_SYMBOL;
@@ -1025,7 +1040,7 @@ tax_proc_variable_dec (NODE_T *p, int *q)
 	    {
 	      BODY (entry) = NO_TAG;
 	    }
-	  tax_proc_variable_dec (NEXT (p), q);
+	  tax_proc_variable_dec (NEXT (p), q, e);
 	}
       else
 	tax_tags (p);
@@ -1271,7 +1286,7 @@ tax_tags (NODE_T *p)
       else if (IS (p, PROCEDURE_DECLARATION))
 	tax_proc_dec (p);
       else if (IS (p, PROCEDURE_VARIABLE_DECLARATION))
-	tax_proc_variable_dec (p, &heap);
+	tax_proc_variable_dec (p, &heap, false);
       else if (IS (p, OPERATOR_DECLARATION))
 	tax_op_dec (p, &m);
       else if (IS (p, BRIEF_OPERATOR_DECLARATION))
diff --git a/gcc/testsuite/algol68/execute/modules/module17.a68 b/gcc/testsuite/algol68/execute/modules/module17.a68
new file mode 100644
index 00000000000..232ddeb5b91
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/module17.a68
@@ -0,0 +1,13 @@
+module Module =
+def
+    pub int ce_port;
+    pub string ce_host;
+
+    pub proc ce_connect = void:
+           myconnect (ce_host, ce_port);
+
+    proc myconnect = (string host, int port) void:
+       skip;
+
+    skip
+fed
diff --git a/gcc/testsuite/algol68/execute/modules/program-17.a68 b/gcc/testsuite/algol68/execute/modules/program-17.a68
new file mode 100644
index 00000000000..90a1728c68b
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/program-17.a68
@@ -0,0 +1,7 @@
+{ dg-modules module17 }
+
+access Module17
+begin ce_port := 8888;
+      ce_host := "localhost";
+      ce_connect
+end
-- 
2.30.2



More information about the Algol68 mailing list