[COMMITTED] algol68: support heap allocated proc variables
Jose E. Marchesi
jemarch@gnu.org
Sat Apr 5 09:23:26 GMT 2025
This patch removes the HEAPVAR annotation from the taxes table, since
it is redundant to the existing annotation HEAP.
It also fixes a68_lower_procedure_variable_declaration to use a
pointer to a pointer to a function for heap allocated proc variables.
Note that, due to the way GCC handles nested functions and the Algol
68 scope rules for procedure values, no actual heap allocation is
necessary in this case.
Finally, the patch simplifies a68_lower_variable_declaration so it
uses HEAP (TAX (defining_identifier)) rather than fishing the
qualifier from the parse tree.
---
gcc/algol68/a68-low-decls.cc | 27 +++++++++++++++--------
gcc/algol68/a68-low.cc | 3 ++-
gcc/algol68/a68-parser-extract.cc | 7 +-----
gcc/algol68/a68-parser.cc | 1 -
gcc/algol68/a68-types.h | 8 +++----
gcc/testsuite/algol68/execute/proc-29.a68 | 4 ++++
6 files changed, 28 insertions(+), 22 deletions(-)
create mode 100644 gcc/testsuite/algol68/execute/proc-29.a68
diff --git a/gcc/algol68/a68-low-decls.cc b/gcc/algol68/a68-low-decls.cc
index 2e8b4c79bd3..0036bc7f2b9 100644
--- a/gcc/algol68/a68-low-decls.cc
+++ b/gcc/algol68/a68-low-decls.cc
@@ -123,7 +123,6 @@ tree
a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
{
NODE_T *defining_identifier, *unit;
- NODE_T *qualifier = NO_NODE;
NODE_T *declarer = NO_NODE;
tree sub_expr = NULL_TREE;
@@ -137,8 +136,10 @@ a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
}
else if (IS (SUB (p), QUALIFIER))
{
- qualifier = SUB (p);
- declarer = NEXT (qualifier);
+ /* The qualifier determines what kind of generator is used in the
+ variable declaration. This is already annotated in the tax entry for
+ the definining identifier. */
+ declarer = NEXT (SUB (p));
defining_identifier = NEXT (NEXT (SUB (p)));
}
else if (IS (SUB (p), DECLARER))
@@ -193,15 +194,15 @@ a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
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. */
- if (VARHEAP (TAX (defining_identifier)) || HAS_ROWS (SUB (MOID (defining_identifier))))
+ bool heap = HEAP (TAX (defining_identifier)) == HEAP_SYMBOL;
+ if (heap || HAS_ROWS (SUB (MOID (defining_identifier))))
{
- bool gen_heap = (qualifier != NO_NODE && !IS (qualifier, LOC_SYMBOL));
gcc_assert(IS_REF (MOID (declarer)));
expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (var_decl),
var_decl,
a68_low_generator (declarer,
SUB (MOID (declarer)),
- gen_heap, ctx));
+ heap, ctx));
}
if (unit != NO_NODE)
@@ -461,7 +462,8 @@ a68_lower_procedure_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
defining_identifier = NEXT (SUB (p));
else if (IS (SUB (p), QUALIFIER))
/* The qualifier determines what kind of generator is used in the variable
- declaration. No qualifier means LOC. XXX use it eventually. */
+ declaration. This is already annotated in the tax entry for the
+ definining identifier. */
defining_identifier = NEXT (NEXT (SUB (p)));
else
gcc_unreachable ();
@@ -487,8 +489,15 @@ a68_lower_procedure_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
DECL_EXPR,
TREE_TYPE (decl),
decl));
- /* Initialize. */
- a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (decl), decl, routine));
+ /* Initialize.
+
+ If the variable is heap allocated then the var_decl created above is a
+ pointer. We don't allocate the actual function on the heap, because the
+ scope of procedures is not global. */
+ bool heap = HEAP (TAX (defining_identifier)) == HEAP_SYMBOL;
+ a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (decl), decl,
+ heap ? fold_build1 (ADDR_EXPR, TREE_TYPE (decl),
+ routine) : routine));
/* Tail in a compound expression with sub declarations, if any. */
if (sub_decl != NULL_TREE)
diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc
index 2290a47564e..f29fcd5ee25 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -410,7 +410,8 @@ a68_make_variable_declaration_decl (NODE_T *identifier)
gcc_assert (IS_REF (MOID (identifier)));
MOID_T *mode = MOID (identifier);
- bool use_pointer = VARHEAP (TAX (identifier)) || HAS_ROWS (SUB (MOID (identifier)));
+ bool use_pointer = ((HEAP (TAX (identifier)) == HEAP_SYMBOL)
+ || HAS_ROWS (SUB (MOID (identifier))));
tree type = use_pointer ? CTYPE (mode) : CTYPE (SUB (mode));
tree decl = build_decl (a68_get_node_location (identifier),
VAR_DECL,
diff --git a/gcc/algol68/a68-parser-extract.cc b/gcc/algol68/a68-parser-extract.cc
index 76d49c88aa4..b7ed19494d2 100644
--- a/gcc/algol68/a68-parser-extract.cc
+++ b/gcc/algol68/a68-parser-extract.cc
@@ -504,12 +504,8 @@ extract_variables (NODE_T *p)
|| a68_whether (q, LOC_SYMBOL, DECLARER, IDENTIFIER, STOP)
|| a68_whether (q, DECLARER, IDENTIFIER, STOP))
{
- bool heap = false;
if (!IS (q, DECLARER))
- {
- heap = !IS(q, LOC_SYMBOL);
- FORWARD (q);
- }
+ FORWARD (q);
bool siga = true;
do
@@ -527,7 +523,6 @@ extract_variables (NODE_T *p)
if (tag == NO_TAG)
gcc_unreachable ();
VARIABLE (tag) = true;
- VARHEAP (tag) = heap;
ATTRIBUTE (q) = DEFINING_IDENTIFIER;
q = skip_unit (q);
}
diff --git a/gcc/algol68/a68-parser.cc b/gcc/algol68/a68-parser.cc
index 7da4e76d6aa..1a2f80ce921 100644
--- a/gcc/algol68/a68-parser.cc
+++ b/gcc/algol68/a68-parser.cc
@@ -759,7 +759,6 @@ a68_new_tag (void)
BODY (z) = NO_TAG;
PORTABLE (z) = true;
VARIABLE (z) = false;
- VARHEAP (z) = false;
IS_RECURSIVE (z) = false;
ASCRIBED_ROUTINE_TEXT (z) = false;
LOWERER (z) = NO_LOWERER;
diff --git a/gcc/algol68/a68-types.h b/gcc/algol68/a68-types.h
index ca4952cb8ca..b8a49e91cb9 100644
--- a/gcc/algol68/a68-types.h
+++ b/gcc/algol68/a68-types.h
@@ -557,9 +557,8 @@ struct TABLE_T
variable declaration, as opposed to an identity declaration. This is set by
extract_variables and is used by the lowering pass.
- VARHEAP is set when the defining identifier in NODE is defined in a variable
- declaration whose implied generator is HEAP. This is set by
- extract_variables and is used by the lowering pass.
+ HEAP is used for defining identifier in NODE is defined in a variable
+ declaration. It is HEAP_SYMBOL or LOC_SYMBOL.
IS_RECURSIVE is set for mode indicants whose definition is recursive,
i.e. they appear in actual declarers within its own definition.
@@ -590,7 +589,7 @@ struct TAG_T
NODE_T *node, *unit;
char *value;
bool scope_assigned, use, in_proc, loc_assigned, portable, variable;
- bool ascribed_routine_text, varheap, is_recursive;
+ bool ascribed_routine_text, is_recursive;
int priority, heap, scope, youngest_environ, number;
STATUS_MASK_T status;
tree tree_decl;
@@ -946,7 +945,6 @@ struct A68_T
#define UNIT(p) ((p)->unit)
#define USE(p) ((p)->use)
#define VALUE(p) ((p)->value)
-#define VARHEAP(p) ((p)->varheap)
#define VARIABLE(p) ((p)->variable)
#define WHERE(p) ((p)->where)
#define IS_FLEXETY_ROW(m) (IS_FLEX (m) || IS_ROW (m) || m == M_STRING)
diff --git a/gcc/testsuite/algol68/execute/proc-29.a68 b/gcc/testsuite/algol68/execute/proc-29.a68
new file mode 100644
index 00000000000..1fde862d2dc
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/proc-29.a68
@@ -0,0 +1,4 @@
+# A heap proc variable. #
+BEGIN HEAP PROC foo := INT: 666;
+ ASSERT (foo = 666)
+END
--
2.30.2
More information about the Algol68
mailing list