Commit 104099b8 by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): New case to deal with the definition of named numbers.

	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Named_{Integer|Real}>:
	New case to deal with the definition of named numbers.
	<E_Variable>: Minor tweaks.  Set DECL_IGNORED_P on the CONST_DECL
	if a corresponding variable is built.
	* gcc-interface/trans.c (gnat_to_gnu) <N_Integer_Literal>: Return
	error_mark_node instead of aborting on overflow for named numbers.
	<N_Number_Declaration>: Reuse the <N_Object_Declaration> case and
	deal with error_mark_node specifically.
	* gcc-interface/utils.c (create_var_decl): Do not set DECL_IGNORED_P
	on CONST_DECLs.
	(gnat_write_global_declarations): Output global constants.

From-SVN: r276864
parent 848830dc
2019-10-11 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Named_{Integer|Real}>:
New case to deal with the definition of named numbers.
<E_Variable>: Minor tweaks. Set DECL_IGNORED_P on the CONST_DECL
if a corresponding variable is built.
* gcc-interface/trans.c (gnat_to_gnu) <N_Integer_Literal>: Return
error_mark_node instead of aborting on overflow for named numbers.
<N_Number_Declaration>: Reuse the <N_Object_Declaration> case and
deal with error_mark_node specifically.
* gcc-interface/utils.c (create_var_decl): Do not set DECL_IGNORED_P
on CONST_DECLs.
(gnat_write_global_declarations): Output global constants.
2019-10-10 Gary Dismukes <dismukes@adacore.com> 2019-10-10 Gary Dismukes <dismukes@adacore.com>
* exp_ch7.adb (Check_Unnesting_In_Decls_Or_Stmts): When * exp_ch7.adb (Check_Unnesting_In_Decls_Or_Stmts): When
......
...@@ -585,6 +585,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -585,6 +585,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
gcc_unreachable (); gcc_unreachable ();
} }
case E_Named_Integer:
case E_Named_Real:
{
tree gnu_ext_name = NULL_TREE;
if (Is_Public (gnat_entity))
gnu_ext_name = create_concat_name (gnat_entity, NULL);
/* All references are supposed to be folded in the front-end. */
gcc_assert (definition && gnu_expr);
gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
gnu_expr = convert (gnu_type, gnu_expr);
/* Build a CONST_DECL for debugging purposes exclusively. */
gnu_decl
= create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
gnu_expr, true, Is_Public (gnat_entity),
false, false, false, artificial_p,
debug_info_p, NULL, gnat_entity, true);
}
break;
case E_Constant: case E_Constant:
/* Ignore constant definitions already marked with the error node. See /* Ignore constant definitions already marked with the error node. See
the N_Object_Declaration case of gnat_to_gnu for the rationale. */ the N_Object_Declaration case of gnat_to_gnu for the rationale. */
...@@ -1519,18 +1542,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -1519,18 +1542,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* If this is a constant and we are defining it or it generates a real /* If this is a constant and we are defining it or it generates a real
symbol at the object level and we are referencing it, we may want symbol at the object level and we are referencing it, we may want
or need to have a true variable to represent it: or need to have a true variable to represent it:
- if optimization isn't enabled, for debugging purposes,
- if the constant is public and not overlaid on something else, - if the constant is public and not overlaid on something else,
- if its address is taken, - if its address is taken,
- if either itself or its type is aliased. */ - if it is aliased,
- if optimization isn't enabled, for debugging purposes. */
if (TREE_CODE (gnu_decl) == CONST_DECL if (TREE_CODE (gnu_decl) == CONST_DECL
&& (definition || Sloc (gnat_entity) > Standard_Location) && (definition || Sloc (gnat_entity) > Standard_Location)
&& ((!optimize && debug_info_p) && ((Is_Public (gnat_entity) && No (Address_Clause (gnat_entity)))
|| (Is_Public (gnat_entity)
&& No (Address_Clause (gnat_entity)))
|| Address_Taken (gnat_entity) || Address_Taken (gnat_entity)
|| Is_Aliased (gnat_entity) || Is_Aliased (gnat_entity)
|| Is_Aliased (gnat_type))) || (!optimize && debug_info_p)))
{ {
tree gnu_corr_var tree gnu_corr_var
= create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
...@@ -1540,6 +1561,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -1540,6 +1561,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
attr_list, gnat_entity, false); attr_list, gnat_entity, false);
SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var); SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
DECL_IGNORED_P (gnu_decl) = 1;
} }
/* If this is a constant, even if we don't need a true variable, we /* If this is a constant, even if we don't need a true variable, we
......
...@@ -6881,11 +6881,17 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -6881,11 +6881,17 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = UI_To_gnu (Intval (gnat_node), gnu_type); gnu_result = UI_To_gnu (Intval (gnat_node), gnu_type);
/* If the result overflows (meaning it doesn't fit in its base type), /* If the result overflows (meaning it doesn't fit in its base type),
abort. We would like to check that the value is within the range abort, unless this is for a named number because that's not fatal.
of the subtype, but that causes problems with subtypes whose usage We would like to check that the value is within the range of the
will raise Constraint_Error and with biased representation, so subtype, but that causes problems with subtypes whose usage will
we don't. */ raise Constraint_Error and also with biased representation. */
gcc_assert (!TREE_OVERFLOW (gnu_result)); if (TREE_OVERFLOW (gnu_result))
{
if (Nkind (Parent (gnat_node)) == N_Number_Declaration)
gnu_result = error_mark_node;
else
gcc_unreachable ();
}
} }
break; break;
...@@ -7030,6 +7036,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7030,6 +7036,7 @@ gnat_to_gnu (Node_Id gnat_node)
break; break;
case N_Object_Declaration: case N_Object_Declaration:
case N_Number_Declaration:
case N_Exception_Declaration: case N_Exception_Declaration:
gnat_temp = Defining_Entity (gnat_node); gnat_temp = Defining_Entity (gnat_node);
gnu_result = alloc_stmt_list (); gnu_result = alloc_stmt_list ();
...@@ -7052,8 +7059,15 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7052,8 +7059,15 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_expr = gnat_to_gnu (Expression (gnat_node)); gnu_expr = gnat_to_gnu (Expression (gnat_node));
if (type_annotate_only && TREE_CODE (gnu_expr) == ERROR_MARK) if (TREE_CODE (gnu_expr) == ERROR_MARK)
gnu_expr = NULL_TREE; {
/* If this is a named number for which we cannot manipulate
the value, just skip the declaration altogether. */
if (kind == N_Number_Declaration)
break;
else if (type_annotate_only)
gnu_expr = NULL_TREE;
}
} }
else else
gnu_expr = NULL_TREE; gnu_expr = NULL_TREE;
...@@ -7163,7 +7177,6 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -7163,7 +7177,6 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = alloc_stmt_list (); gnu_result = alloc_stmt_list ();
break; break;
case N_Number_Declaration:
case N_Package_Renaming_Declaration: case N_Package_Renaming_Declaration:
/* These are fully handled in the front end. */ /* These are fully handled in the front end. */
/* ??? For package renamings, find a way to use GENERIC namespaces so /* ??? For package renamings, find a way to use GENERIC namespaces so
......
...@@ -2731,13 +2731,11 @@ create_var_decl (tree name, tree asm_name, tree type, tree init, ...@@ -2731,13 +2731,11 @@ create_var_decl (tree name, tree asm_name, tree type, tree init,
&& !have_global_bss_p ()) && !have_global_bss_p ())
DECL_COMMON (var_decl) = 1; DECL_COMMON (var_decl) = 1;
/* Do not emit debug info for a CONST_DECL if optimization isn't enabled, /* Do not emit debug info if not requested, or for an external constant whose
since we will create an associated variable. Likewise for an external initializer is not absolute because this would require a global relocation
constant whose initializer is not absolute, because this would mean a in a read-only section which runs afoul of the PE-COFF run-time relocation
global relocation in a read-only section which runs afoul of the PE-COFF mechanism. */
run-time relocation mechanism. */
if (!debug_info_p if (!debug_info_p
|| (TREE_CODE (var_decl) == CONST_DECL && !optimize)
|| (extern_flag || (extern_flag
&& constant_p && constant_p
&& init && init
...@@ -5840,6 +5838,11 @@ gnat_write_global_declarations (void) ...@@ -5840,6 +5838,11 @@ gnat_write_global_declarations (void)
&& DECL_FUNCTION_IS_DEF (iter)) && DECL_FUNCTION_IS_DEF (iter))
debug_hooks->early_global_decl (iter); debug_hooks->early_global_decl (iter);
/* Output global constants. */
FOR_EACH_VEC_SAFE_ELT (global_decls, i, iter)
if (TREE_CODE (iter) == CONST_DECL && !DECL_IGNORED_P (iter))
debug_hooks->early_global_decl (iter);
/* Then output the global variables. We need to do that after the debug /* Then output the global variables. We need to do that after the debug
information for global types is emitted so that they are finalized. Skip information for global types is emitted so that they are finalized. Skip
external global variables, unless we need to emit debug info for them: external global variables, unless we need to emit debug info for them:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment