[COMMITTED 4/4] a68: emit proper DW_DIE_typedef in DWARF
Jose E. Marchesi
jemarch@gnu.org
Fri Sep 25 12:07:27 GMT 2026
In the Algol 68 front-end the mode declarations introduce new mode
indicants in their respective ranges, but the parser very early
replace them by the modes they denote. This patch uses GENERIC
features so proper DW_DIE_typedef dies get generated in DWARF.
This commit
Signed-off-by: Jose E. Marchesi <jemarch@gnu.org>
gcc/algol68/ChangeLog
* a68-types.h (struct TAG_T): Add field ctyp.
* a68-parser.cc (a68_new_tag): Initialize CTYPE.
* a68-low-decls.cc (fish_declarer_from_tree): New function.
(grok_typedef_in_decl): Likewise.
(a68_lower_mode_declaration): Install typedef variant type for a
defining-indicant in the symtab.
(a68_lower_variable_declaration): Call grok_typedef_in_decl.
(a68_lower_identity_declaration): Likewise.
* a68-low-ranges.cc (a68_pop_serial_clause_range): Compare main
variant types in sanity check at block exit.
* a68-low.cc (a68_low_assignation): Likewise in assignation.
---
gcc/algol68/a68-low-decls.cc | 87 +++++++++++++++++++++++++++++++----
gcc/algol68/a68-low-ranges.cc | 15 ++++--
gcc/algol68/a68-low.cc | 13 ++++--
gcc/algol68/a68-parser.cc | 1 +
gcc/algol68/a68-types.h | 11 ++++-
5 files changed, 108 insertions(+), 19 deletions(-)
diff --git a/gcc/algol68/a68-low-decls.cc b/gcc/algol68/a68-low-decls.cc
index 1c77bb56019..606e5fdf5ef 100644
--- a/gcc/algol68/a68-low-decls.cc
+++ b/gcc/algol68/a68-low-decls.cc
@@ -42,6 +42,52 @@
#include "a68.h"
+/* Auxiliary function to fish a declarer from some software construct. The
+ first declarer found is returned, or NULL_TREE if none is found. */
+
+static NODE_T *
+fish_declarer_from_tree (NODE_T *p)
+{
+ for (; p != NO_NODE; p = NEXT (p))
+ {
+ if (IS (p, DECLARER))
+ return p;
+
+ NODE_T *declarer = fish_declarer_from_tree (SUB (p));
+ if (declarer != NO_NODE)
+ return declarer;
+ }
+
+ return NO_NODE;
+}
+
+/* If the given DECLARER is an indicant whose symtab entry is annotated with a
+ CTYPE, then it is a typedef type derived from the type installed in the
+ given DECL. The derived type was created and installed in the symtab entry
+ by a68_lower_mode_declaration. Install it in DECL so the typedef gets
+ reflected intthe DWARF that gets generated for DECL. */
+
+static void
+grok_typedef_in_decl (tree decl, NODE_T *declarer, bool use_pointer = false)
+{
+ if (SUB (declarer) != NO_NODE && IS (SUB (declarer), INDICANT))
+ {
+ NODE_T *indicant = SUB (declarer);
+
+ /* Note that indicants for standard modes do not have symtab entries. */
+ if (TAX (indicant) != NO_TAG && CTYPE (TAX (indicant)) != NULL_TREE)
+ {
+ if (use_pointer)
+ {
+ gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
+ TREE_TYPE (TREE_TYPE (decl)) = CTYPE (TAX (indicant));
+ }
+ else
+ TREE_TYPE (decl) = CTYPE (TAX (indicant));
+ }
+ }
+}
+
/* Lower one or more mode declarations.
mode declaration : mode symbol, defining indicant,
@@ -86,7 +132,6 @@ a68_lower_mode_declaration (NODE_T *p, LOW_CTX_T ctx)
}
tree type = CTYPE (MOID (defining_indicant));
-
tree decl_name = a68_get_mangled_indicant (NSYMBOL (defining_indicant),
ctx.module_definition_name);
tree decl = build_decl (a68_get_node_location (p),
@@ -99,8 +144,21 @@ a68_lower_mode_declaration (NODE_T *p, LOW_CTX_T ctx)
else
a68_add_decl (decl);
+ DECL_ORIGINAL_TYPE (decl) = type;
+
+ tree variant_type = build_variant_type_copy (type);
+ TYPE_STUB_DECL (variant_type) = TYPE_STUB_DECL (type);
+ TYPE_NAME (variant_type) = decl;
+ TREE_TYPE (decl) = variant_type;
+
TYPE_CONTEXT (type) = DECL_CONTEXT (decl);
- TYPE_NAME (type) = decl;
+ TYPE_CONTEXT (variant_type) = TYPE_CONTEXT (type);
+
+ /* Install the derived typedef type in the symtab entry for the
+ defining-indicant, so the lowerers for identity declarations, variable
+ declarations, etc, having the indicant as declarer, can use this type
+ rather than the original type. */
+ CTYPE (TAX (defining_indicant)) = variant_type;
return void_node;
}
@@ -134,10 +192,7 @@ a68_lower_mode_declaration (NODE_T *p, LOW_CTX_T ctx)
HEAP generator, however, then the VAR_DECL declares a value of type pointer
to CTYPE (AMODE0. In this later case no optimization is possible and it has
exactly the same effect than an identity declaration `REF AMODE
- defining_identifier = HEAP AMODE'.
-
- Note that the defining identifier is annotated with its mode, so there is no
- need to go hunting for the declarer in the subtree. */
+ defining_identifier = HEAP AMODE'. */
tree
a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
@@ -145,6 +200,8 @@ a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
NODE_T *defining_identifier, *unit;
NODE_T *declarer = NO_NODE;
+ // XXX this is better than using ctx NODE_T *declarer = fish_declarer_from_tree (p);
+
tree sub_expr = NULL_TREE;
if (IS (SUB (p), VARIABLE_DECLARATION))
@@ -178,6 +235,9 @@ a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
gcc_unreachable ();
}
+ gcc_assert (declarer != NO_NODE);
+ gcc_assert (defining_identifier != NO_NODE);
+
/* Communicate declarer upward. */
if (ctx.declarer != NULL)
*ctx.declarer = declarer;
@@ -212,6 +272,12 @@ a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
else
a68_add_decl (var_decl);
+ // XXX sucks to replicate this logic here.
+ bool use_pointer = (HEAP (TAX (defining_identifier)) != STATIC_SYMBOL
+ && ((HEAP (TAX (defining_identifier)) == HEAP_SYMBOL)
+ || HAS_ROWS (SUB (MOID (defining_identifier)))));
+ grok_typedef_in_decl (var_decl, declarer, use_pointer);
+
/* Add a decl_expr in the current range. */
a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p),
DECL_EXPR,
@@ -329,9 +395,7 @@ a68_lower_identity_declaration (NODE_T *p, LOW_CTX_T ctx)
tree unit_tree = NULL_TREE;
tree sub_expr = NULL_TREE;
- /* Note that the formal declarer in the construct is not used. This is
- because it is already reflected in the mode of the identity
- declaration. */
+ NODE_T *declarer = fish_declarer_from_tree (p);
NODE_T *defining_identifier;
if (IS (SUB (p), IDENTITY_DECLARATION))
@@ -350,6 +414,9 @@ a68_lower_identity_declaration (NODE_T *p, LOW_CTX_T ctx)
else
gcc_unreachable ();
+ gcc_assert (declarer != NO_NODE);
+ gcc_assert (defining_identifier != NO_NODE);
+
NODE_T *unit = NEXT (NEXT (defining_identifier));
tree expr = NULL_TREE;
@@ -384,6 +451,8 @@ a68_lower_identity_declaration (NODE_T *p, LOW_CTX_T ctx)
TREE_TYPE (id_decl),
id_decl));
+ grok_typedef_in_decl (id_decl, declarer);
+
unit_tree = a68_lower_tree (unit, ctx);
unit_tree = a68_consolidate_ref (MOID (unit), unit_tree);
expr = a68_low_ascription (MOID (defining_identifier),
diff --git a/gcc/algol68/a68-low-ranges.cc b/gcc/algol68/a68-low-ranges.cc
index f6058fbd357..5ccc4935998 100644
--- a/gcc/algol68/a68-low-ranges.cc
+++ b/gcc/algol68/a68-low-ranges.cc
@@ -617,19 +617,24 @@ a68_pop_serial_clause_range (void)
same than the type corresponding to the clause mode. */
{
tree_stmt_iterator si = tsi_last (range->stmt_list);
- if (TREE_TYPE (tsi_stmt (si)) != clause_type
+ tree last_stmt_type = TREE_TYPE (tsi_stmt (si));
+
+ /* We need original type to compare below. */
+ if (typedef_variant_p (last_stmt_type))
+ last_stmt_type = DECL_ORIGINAL_TYPE (TYPE_NAME (last_stmt_type));
+
+ if (last_stmt_type != clause_type
/* But NIL can appear in a context expecting VOID with no widening. */
&& !(clause_type == a68_void_type
- && POINTER_TYPE_P (TREE_TYPE (tsi_stmt (si)))
+ && POINTER_TYPE_P (last_stmt_type)
&& TREE_CODE (tsi_stmt (si)) == INTEGER_CST
&& tree_to_shwi (tsi_stmt (si)) == 0)
/* And any row type is valid when M_ROWS is expected. */
- && !(A68_ROWS_TYPE_P (clause_type)
- && A68_ROWS_TYPE_P (TREE_TYPE (tsi_stmt (si))))
+ && !(A68_ROWS_TYPE_P (clause_type) && A68_ROWS_TYPE_P (last_stmt_type))
/* Do not rely on comparing pointer types, as the equality fails in
that case. We need a better way of comparing types, either using
TYPE_CANONICAL or caching. */
- && !(POINTER_TYPE_P (TREE_TYPE (tsi_stmt (si))) && POINTER_TYPE_P (clause_type)))
+ && !(POINTER_TYPE_P (last_stmt_type) && POINTER_TYPE_P (clause_type)))
{
printf ("last statement:\n");
debug_tree (tsi_stmt (si));
diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc
index bc9da115d15..1c4ab2b2344 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -628,7 +628,7 @@ a68_make_variable_declaration_decl (NODE_T *identifier,
If ADDRP is true then it is the address of the external symbol we are
interested in. In that case the mode of P shall be a ref.
-
+
Note that this function is not used for formal holes with proc modes, called
from a68_wrap_formal_var_hole. See a68_wrap_formal_proc_hole. */
@@ -993,6 +993,11 @@ a68_low_assignation (NODE_T *p,
tree assignation = NULL_TREE;
tree orig_rhs = rhs;
+ /* The lhs might be a selection that has been "ref_consolidated". */
+ if (TREE_CODE (lhs) == ADDR_EXPR
+ && TREE_CODE (TREE_OPERAND (lhs, 0)) == COMPONENT_REF)
+ lhs = TREE_OPERAND (lhs, 0);
+
if (IS_FLEXETY_ROW (mode_rhs))
{
/* Make a deep copy of the rhs. Note that we have to use the heap
@@ -1011,7 +1016,8 @@ a68_low_assignation (NODE_T *p,
is performed. XXX but bound checking in contained values may be
necessary, ghost elements. */
if (POINTER_TYPE_P (TREE_TYPE (lhs))
- && TREE_TYPE (TREE_TYPE (lhs)) == TREE_TYPE (rhs))
+ && (TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (lhs)))
+ == TYPE_MAIN_VARIANT (TREE_TYPE (rhs))))
{
/* Make sure to not evaluate the expression yielding the pointer
more than once. */
@@ -1091,7 +1097,8 @@ a68_low_assignation (NODE_T *p,
rhs = a68_low_dup (rhs, true /* use_heap */);
if (POINTER_TYPE_P (TREE_TYPE (lhs))
- && TREE_TYPE (TREE_TYPE (lhs)) == TREE_TYPE (rhs))
+ && (TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (lhs)))
+ == TYPE_MAIN_VARIANT (TREE_TYPE (rhs))))
{
/* If the left hand side is a pointer, deref it, but return the
pointer. Make sure to not evaluate the expression yielding the
diff --git a/gcc/algol68/a68-parser.cc b/gcc/algol68/a68-parser.cc
index ae2a4cfcf18..4c9b17b516e 100644
--- a/gcc/algol68/a68-parser.cc
+++ b/gcc/algol68/a68-parser.cc
@@ -882,6 +882,7 @@ a68_new_tag (void)
TAX_TREE_DECL (z) = NULL_TREE;
MOIF (z) = NO_MOIF;
EXTERN_SYMBOL (z) = NO_TEXT;
+ CTYPE (z) = NULL_TREE;
NUMBER (z) = ++A68_PARSER (tag_number);
return z;
}
diff --git a/gcc/algol68/a68-types.h b/gcc/algol68/a68-types.h
index ebe74ca8a80..0a3611f8b3e 100644
--- a/gcc/algol68/a68-types.h
+++ b/gcc/algol68/a68-types.h
@@ -630,7 +630,14 @@ struct GTY(()) TABLE_T
ascribed to the identifier.
ACCESS is a static property that describes how to compute the value yielded
- by the identifier given the GENERIC tree it lowers to. */
+ by the identifier given the GENERIC tree it lowers to.
+
+ CTYPE is either NULL_TREE or a GENERIC type. This is currently used for
+ declarers that are applied indicants, and is the type that is created in
+ a68_lower_mode_declaration, a variant derived from the actual ctype of the
+ MOID of the applied indicant. The lowerers for identity declarations,
+ variable declarations etc must use this type if it exists in the declaration
+ declarer. */
struct GTY((chain_next ("%h.next"))) TAG_T
{
@@ -642,7 +649,7 @@ struct GTY((chain_next ("%h.next"))) TAG_T
bool ascribed_routine_text, is_recursive, publicized;
int priority, heap, scope, youngest_environ, number;
STATUS_MASK_T status;
- tree tree_decl;
+ tree tree_decl, ctype;
MOIF_T *moif;
LOWERER_T lowerer;
ORIGIN_T *origin;
--
2.39.5
More information about the Algol68
mailing list