https://gcc.gnu.org/g:ac02dbd44494c0f1185c3e50576043491ea638bc
commit r17-4654-gac02dbd44494c0f1185c3e50576043491ea638bc Author: Jose E. Marchesi <[email protected]> Date: Wed Sep 23 22:00:17 2026 +0200 a68: emit proper DW_DIE_typedef in DWARF 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 <[email protected]> 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. Diff: --- 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 1c77bb560194..606e5fdf5efd 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 f6058fbd357d..5ccc4935998f 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 bc9da115d15b..1c4ab2b2344e 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 ae2a4cfcf182..4c9b17b516e4 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 ebe74ca8a801..0a3611f8b3e4 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;
