OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

ada-tree.def (TRANSFORM_EXPR, [...]): Deleted.

Browse Source 
* ada-tree.def (TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR): Deleted.
	(GNAT_NOP_EXPR, GNAT_LOOP_ID, EXPR_STMT, NULL_STMT): Likewise.
	(BLOCK_STMT, IF_STMT, GOTO_STMT, LABEL_STMT, RETURN_STMT): Likewise.
	(ASM_STMT, BREAK_STMT, REGION_STMT,HANDLER_STMT): Likewise.
	(STMT_STMT, USE_STMT): New statement codes.
	(LOOP_STMT, EXIT_STMT): Make slight semantic changes.
	* ada-tree.h: Reflect above changes.
 	(struct tree_loop_id): Deleted.
	(union lang_tree_node, struct lang_decl, struct lang_type):
	Now just contains a tree node; update macros using TYPE_LANG_SPECIFIC
	and DECL_LANGUAGE_SPECIFIC to reflect these changes.
	(DECL_INIT_BY_ASSIGN_P, TRE_LOOP_NODE_ID, TREE_SLOC): Deleted.
	(IS_ADA_STMT): New macro.
	* decl.c (annotate_decl_with_node): New function.
	(gnat_to_gnu_entity): Use it and Sloc_to_locus instead of set_lineno.
	(gnat_to_gnu_entity, case object): Remove call to expand CONVERT_EXPR.
	Call add_stmt_with_node to do needed assignments.
	Add call to update setjmp buffer directly, not via EXPR_STMT.
	(maybe_variable): Argment GNAT_NODE deleted.
	* gigi.h (maybe_variable): Likewise.
	(make_transform, add_stmt_with_node, set_block_for_group): New.
	(gnat_gimplify_expr, gnat_expand_body, Sloc_to_locus): Likewise.
	(set_block_jmpbuf_decl, get_block_jmpbuf_decl): Likewise.
	(discard_file_names, gnu_block_stack, gnat_to_code): Deleted.
	(set_lineno, set_lineno_from_sloc): Likewise.
	(record_code_position, insert_code_for): Likewise.
	(gnat_poplevel): Now returns void.
	(end_subprog_body): Now takes argument.
	* misc.c (cgraph.h, tree-inline.h): New includes.
	(gnat_tree_size, LANG_HOOKS_TREE_SIZE): Deleted.
	(gnat_post_options, LANG_HOOKS_POST_OPTIONS): New.
	(LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION): Likewise.
	(LANG_HOOKS_RTL_EXPAND_STMT, LANG_HOOKS_GIMPLIFY_EXPR): Likewise.
	(gnat_parse_file): Don't set immediate_size_expand.
	Call cgraph functions.
	(gnat_expand_expr): Remove most cases.
	(record_code_position, insert_code_for): Remove from here.
	* trans.c (toplev.h, tree-gimple.h): Now included.
	(discard_file_names): Deleted.
	(gnu_block_stack, gnu_block_stmt_node, gnu_block_stmt_free_list): Del.
	(first_nondeleted_insn, make_expr_stmt_from_rtl): Likewise.
	(struct stmt_group, current_stmt_group, stmt_group_free_list): New.
	(gnu_stack_free_list, record_cost_position, insert_code_for): Likewise.
	(add_cleanup, push_stack, gnat_gimplify_stmt, add_cleanup): Likewise.
	(gnat_gimplify_type_sizes, gnat_gimplify_one_sizepos): Likewise.
	(gnat_expand_body_1, gnat_gimplify_expr, annotate_with_node): Likewise.
	(set_block_for_group, add_stmt_list): Likewise.
	(start_stmt_group): Renamed from start_block_stmt.
	(end_stmt_group): Likewise, from end_block_stmt.
	(build_stmt_group): Likewise, from build_block_stmt, also add arg.
	(gigi): Don't set discard_file_names or call set_lineno.
	Disallow front end ZCX; call gnat_to_gnu, not gnat_to_code.
	(tree_transform): Deleted, now renamed to be gnat_to_gnu.
	Numerous changes throughout to reflect new names and complete
	function-at-a-time implementation.
	(gnat_expand_stmt): Delete or comment out all cases.
	(process_inlined_subprograms): Use add_stmt.
	(process_decls): Use gnat_to_gnu, not gnat_to_code, and don't
	call set_lineno; also remove unneeded block handling.
	(process_type): Remove unneeded block handling.
	(build_unit_elab): Remove calls to deleted functions.
	* utils.c (cgraph.h, tree-inline.h, tree-gimple.h): Now include.
	(tree-dump.h): Likewise.
	(struct ada_binding_level): Add field jmpbuf_decl.
	(gnat_define_builtin, gnat_install_builtins): New.
	(gnat_gimplify_function, gnat_finalize): Likewise.
	(gnat_poplevel): No longer return BLOCK, set it instead.
	Remove code dealing with nested functions.
	(gnat_init_decl_processing): Also set size_type_node.
	Call gnat_install_builtins.
	(create_var_decl): Don't set DECL_INIT_BY_ASSIGN.
	(create_subprog_decl): Change handling of inline_flag; set TREE_STATIC.
	Remove special-case for "main".
	(end_subprog_body): Add arg and rework for tree-ssa.
	(convert): Don't use GNAT_NOP_EXPR or look for TRANSFORM_EXPR.
	Add case for BOOLEAN_TYPE.
	* utils2.c (rtl.h): Now include.
	(build_call_raise): Test Debug_Flag_NN directly.
	(build_call_alloc_dealloc): Don't use local stack allocation for now.
	(gnat_mark_addressable, case GNAT_NOP_EXPR): Deleted.
	(gnat_mark_addressable, case VAR_DECL): Handle both early & late cases.

From-SVN: r82714
This commit is contained in:
Richard Kenner 2004-06-07 19:52:53 +00:00 committed by Richard Kenner
parent 45b0c94cb4
commit 821e1ea1b1
9 changed files with 1485 additions and 1618 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
gcc/ada/ChangeLog
View File

@ -1,3 +1,87 @@
2004-06-07 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* ada-tree.def (TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR): Deleted.
(GNAT_NOP_EXPR, GNAT_LOOP_ID, EXPR_STMT, NULL_STMT): Likewise.
(BLOCK_STMT, IF_STMT, GOTO_STMT, LABEL_STMT, RETURN_STMT): Likewise.
(ASM_STMT, BREAK_STMT, REGION_STMT,HANDLER_STMT): Likewise.
(STMT_STMT, USE_STMT): New statement codes.
(LOOP_STMT, EXIT_STMT): Make slight semantic changes.
* ada-tree.h: Reflect above changes.
(struct tree_loop_id): Deleted.
(union lang_tree_node, struct lang_decl, struct lang_type):
Now just contains a tree node; update macros using TYPE_LANG_SPECIFIC
and DECL_LANGUAGE_SPECIFIC to reflect these changes.
(DECL_INIT_BY_ASSIGN_P, TRE_LOOP_NODE_ID, TREE_SLOC): Deleted.
(IS_ADA_STMT): New macro.
* decl.c (annotate_decl_with_node): New function.
(gnat_to_gnu_entity): Use it and Sloc_to_locus instead of set_lineno.
(gnat_to_gnu_entity, case object): Remove call to expand CONVERT_EXPR.
Call add_stmt_with_node to do needed assignments.
Add call to update setjmp buffer directly, not via EXPR_STMT.
(maybe_variable): Argment GNAT_NODE deleted.
* gigi.h (maybe_variable): Likewise.
(make_transform, add_stmt_with_node, set_block_for_group): New.
(gnat_gimplify_expr, gnat_expand_body, Sloc_to_locus): Likewise.
(set_block_jmpbuf_decl, get_block_jmpbuf_decl): Likewise.
(discard_file_names, gnu_block_stack, gnat_to_code): Deleted.
(set_lineno, set_lineno_from_sloc): Likewise.
(record_code_position, insert_code_for): Likewise.
(gnat_poplevel): Now returns void.
(end_subprog_body): Now takes argument.
* misc.c (cgraph.h, tree-inline.h): New includes.
(gnat_tree_size, LANG_HOOKS_TREE_SIZE): Deleted.
(gnat_post_options, LANG_HOOKS_POST_OPTIONS): New.
(LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION): Likewise.
(LANG_HOOKS_RTL_EXPAND_STMT, LANG_HOOKS_GIMPLIFY_EXPR): Likewise.
(gnat_parse_file): Don't set immediate_size_expand.
Call cgraph functions.
(gnat_expand_expr): Remove most cases.
(record_code_position, insert_code_for): Remove from here.
* trans.c (toplev.h, tree-gimple.h): Now included.
(discard_file_names): Deleted.
(gnu_block_stack, gnu_block_stmt_node, gnu_block_stmt_free_list): Del.
(first_nondeleted_insn, make_expr_stmt_from_rtl): Likewise.
(struct stmt_group, current_stmt_group, stmt_group_free_list): New.
(gnu_stack_free_list, record_cost_position, insert_code_for): Likewise.
(add_cleanup, push_stack, gnat_gimplify_stmt, add_cleanup): Likewise.
(gnat_gimplify_type_sizes, gnat_gimplify_one_sizepos): Likewise.
(gnat_expand_body_1, gnat_gimplify_expr, annotate_with_node): Likewise.
(set_block_for_group, add_stmt_list): Likewise.
(start_stmt_group): Renamed from start_block_stmt.
(end_stmt_group): Likewise, from end_block_stmt.
(build_stmt_group): Likewise, from build_block_stmt, also add arg.
(gigi): Don't set discard_file_names or call set_lineno.
Disallow front end ZCX; call gnat_to_gnu, not gnat_to_code.
(tree_transform): Deleted, now renamed to be gnat_to_gnu.
Numerous changes throughout to reflect new names and complete
function-at-a-time implementation.
(gnat_expand_stmt): Delete or comment out all cases.
(process_inlined_subprograms): Use add_stmt.
(process_decls): Use gnat_to_gnu, not gnat_to_code, and don't
call set_lineno; also remove unneeded block handling.
(process_type): Remove unneeded block handling.
(build_unit_elab): Remove calls to deleted functions.
* utils.c (cgraph.h, tree-inline.h, tree-gimple.h): Now include.
(tree-dump.h): Likewise.
(struct ada_binding_level): Add field jmpbuf_decl.
(gnat_define_builtin, gnat_install_builtins): New.
(gnat_gimplify_function, gnat_finalize): Likewise.
(gnat_poplevel): No longer return BLOCK, set it instead.
Remove code dealing with nested functions.
(gnat_init_decl_processing): Also set size_type_node.
Call gnat_install_builtins.
(create_var_decl): Don't set DECL_INIT_BY_ASSIGN.
(create_subprog_decl): Change handling of inline_flag; set TREE_STATIC.
Remove special-case for "main".
(end_subprog_body): Add arg and rework for tree-ssa.
(convert): Don't use GNAT_NOP_EXPR or look for TRANSFORM_EXPR.
Add case for BOOLEAN_TYPE.
* utils2.c (rtl.h): Now include.
(build_call_raise): Test Debug_Flag_NN directly.
(build_call_alloc_dealloc): Don't use local stack allocation for now.
(gnat_mark_addressable, case GNAT_NOP_EXPR): Deleted.
(gnat_mark_addressable, case VAR_DECL): Handle both early & late cases.
2004-06-07 Robert Dewar <dewar@gnat.com> 2004-06-07 Robert Dewar <dewar@gnat.com>
* a-direct.ads, einfo.ads: Minor comment updates * a-direct.ads, einfo.ads: Minor comment updates

95
gcc/ada/ada-tree.def
View File

@ -24,21 +24,6 @@
* * * *
****************************************************************************/ ****************************************************************************/
/* A GNAT tree node to transform to a GCC tree. This is only used when the
node would generate code, rather then just a tree, and we are in the global
context.
The only field used is TREE_COMPLEXITY, which contains the GNAT node
number. */
DEFTREECODE (TRANSFORM_EXPR, "transform_expr", 'e', 0)
/* Dynamically allocate on the stack a number of bytes of memory given
by operand 0 at the alignment given by operand 1 and return the
address of the resulting memory. */
DEFTREECODE (ALLOCATE_EXPR, "allocate_expr", '2', 2)
/* A type that is an unconstrained array itself. This node is never passed /* A type that is an unconstrained array itself. This node is never passed
to GCC. TREE_TYPE is the type of the fat pointer and TYPE_OBJECT_RECORD_TYPE to GCC. TREE_TYPE is the type of the fat pointer and TYPE_OBJECT_RECORD_TYPE
is the type of a record containing the template and data. */ is the type of a record containing the template and data. */
@ -54,70 +39,50 @@ DEFTREECODE (UNCONSTRAINED_ARRAY_REF, "unconstrained_array_ref", 'r', 1)
/* An expression that returns an RTL suitable for its type. Operand 0 /* An expression that returns an RTL suitable for its type. Operand 0
is an expression to be evaluated for side effects only. */ is an expression to be evaluated for side effects only. */
DEFTREECODE (NULL_EXPR, "null_expr", 'e', 1) DEFTREECODE (NULL_EXPR, "null_expr", 'e', 1)
/* An expression that emits a USE for its single operand. */
DEFTREECODE (USE_EXPR, "use_expr", 'e', 1)
/* Same as ADDR_EXPR, except that if the operand represents a bit field, /* Same as ADDR_EXPR, except that if the operand represents a bit field,
return the address of the byte containing the bit. This is used return the address of the byte containing the bit. This is used
for the 'Address attribute and never shows up in the tree. */ for the 'Address attribute and never shows up in the tree. */
DEFTREECODE (ATTR_ADDR_EXPR, "attr_addr_expr", 'r', 1) DEFTREECODE (ATTR_ADDR_EXPR, "attr_addr_expr", 'r', 1)
/* An expression that is treated as a conversion while generating code, but is
used to prevent infinite recursion when conversions of biased types are
involved. */
DEFTREECODE (GNAT_NOP_EXPR, "gnat_nop_expr", '1', 1)
/* This is used as a place to store the ID of a loop.
??? This should be redone at some point. */
DEFTREECODE (GNAT_LOOP_ID, "gnat_loop_id", 'x', 0)
/* Here are the tree codes for the statement types known to Ada. These /* Here are the tree codes for the statement types known to Ada. These
must be at the end of this file to allow IS_STMT to work. must be at the end of this file to allow IS_ADA_STMT to work. */
We start with an expression statement, whose only operand is an /* This defines the variable in DECL_STMT_VAR. */
expression, EXPR_STMT_EXPR, Execution of the statement means evaluation of
the expression (such as a MODIFY_EXPR) and discarding its result. */
DEFTREECODE (EXPR_STMT, "expr_stmt", 's', 1)
/* This is a null statement. The intent is for it not to survive very far. */
DEFTREECODE (NULL_STMT, "null_stmt", 's', 0)
/* This defines the variable in DECL_STMT_VAR and performs any initialization
in DECL_INITIAL. */
DEFTREECODE (DECL_STMT, "decl_stmt", 's', 1) DEFTREECODE (DECL_STMT, "decl_stmt", 's', 1)
/* This represents a list of statements. BLOCK_STMT_LIST is a list /* This is how record_code_position and insert_code_for work. The former
statement tree, chained via TREE_CHAIN. BLOCK_STMT_BLOCK, if nonzero, makes this tree node, whose operand is a statement. The latter inserts
is the BLOCK node for these statements. */ the actual statements into this node. Gimplification consists of
DEFTREECODE (BLOCK_STMT, "block_stmt", 's', 2) just returning the inner statement. */
DEFTREECODE (STMT_STMT, "stmt_stmt", 's', 1)
/* This is an IF statement. IF_STMT_COND is the condition being tested, /* A loop. LOOP_STMT_TOP_COND and LOOP_STMT_BOT_COND are the tests to exit a
IF_STMT_TRUE is the statement to be executed if the condition is loop at the top and bottom, respectively. LOOP_STMT_UPDATE is the statement
true; IF_STMT_ELSEIF, if non-null, is a list of more IF_STMT nodes (where to update the loop iterator at the continue point. LOOP_STMT_BODY are the
we only look at IF_STMT_COND and IF_STMT_TRUE) that correspond to statements in the body of the loop. LOOP_STMT_LABEL is used during
any "else if" parts; and IF_STMT_ELSE is the statement to be executed if gimplification to point to the LABEL_DECL of the end label of the loop. */
all conditions are. */ DEFTREECODE (LOOP_STMT, "loop_stmt", 's', 5)
DEFTREECODE (IF_STMT, "if_stmt", 's', 4)
/* A goto just points to the label: GOTO_STMT_LABEL. */ /* Conditionally exit a loop. EXIT_STMT_COND is the condition, which, if
DEFTREECODE (GOTO_STMT, "goto_stmt", 's', 1) true, will cause the loop to be exited. If no condition is specified,
the loop is unconditionally exited. EXIT_STMT_LOOP is the LOOP_STMT
corresponding to the loop to exit. */
DEFTREECODE (EXIT_STMT, "exit_stmt", 's', 2)
/* A label: LABEL_STMT_LABEL is the label. */ /* A exception region. REGION_STMT_BODY is the statement to be executed
DEFTREECODE (LABEL_STMT, "label_stmt", 's', 1) inside the region. REGION_STMT_HANDLE is a statement that represents
the exception handlers (usually a BLOCK_STMT of HANDLE_STMTs).
REGION_STMT_BLOCK is the BLOCK node for the declarative region, if any. */
DEFTREECODE (REGION_STMT, "region_stmt", 's', 3)
/* A "return". RETURN_STMT_EXPR is the value to return if non-null. */ /* An exception handler. HANDLER_STMT_ARG is the value to pass to
DEFTREECODE (RETURN_STMT, "return_stmt", 's', 1) expand_start_catch, HANDLER_STMT_LIST is the list of statements for the
handler itself, and HANDLER_STMT_BLOCK is the BLOCK node for this
binding. */
DEFTREECODE (HANDLER_STMT, "handler_stmt", 's', 3)
/* An "asm" statement. The operands are ASM_STMT_TEMPLATE, ASM_STMT_OUTPUT, /* A statement that emits a USE for its single operand. */
ASM_STMT_ORIG_OUT, ASM_STMT_INPUT, and ASM_STMT_CLOBBER. */ DEFTREECODE (USE_STMT, "use_expr", 's', 1)
DEFTREECODE (ASM_STMT, "asm_stmt", 's', 5)
/* An analog to the C "break" statement. */
DEFTREECODE (BREAK_STMT, "break_stmt", 's', 0)

92
gcc/ada/ada-tree.h
View File

@ -33,35 +33,10 @@ enum gnat_tree_code {
}; };
#undef DEFTREECODE #undef DEFTREECODE
/* A tree to hold a loop ID. */
struct tree_loop_id GTY(())
{
struct tree_common common;
struct nesting *loop_id;
};
/* The language-specific tree. */
union lang_tree_node
GTY((desc ("TREE_CODE (&%h.generic) == GNAT_LOOP_ID"),
chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
{
union tree_node GTY ((tag ("0"),
desc ("tree_node_structure (&%h)")))
generic;
struct tree_loop_id GTY ((tag ("1"))) loop_id;
};
/* Ada uses the lang_decl and lang_type fields to hold more trees. */ /* Ada uses the lang_decl and lang_type fields to hold more trees. */
struct lang_decl GTY(()) union lang_tree_node GTY((desc ("0"))) {union tree_node GTY((tag ("0"))) t; };
{ struct lang_decl GTY(()) {union lang_tree_node t; };
union lang_tree_node struct lang_type GTY(()) {union lang_tree_node t; };
GTY((desc ("TREE_CODE (&%h.generic) == GNAT_LOOP_ID"))) t;
};
struct lang_type GTY(())
{
union lang_tree_node
GTY((desc ("TREE_CODE (&%h.generic) == GNAT_LOOP_ID"))) t;
};
/* Flags added to GCC type nodes. */ /* Flags added to GCC type nodes. */
@ -164,28 +139,28 @@ struct lang_type GTY(())
by copy in copy out. It is a CONSTRUCTOR. For a full description of the by copy in copy out. It is a CONSTRUCTOR. For a full description of the
cico parameter passing mechanism refer to the routine gnat_to_gnu_entity. */ cico parameter passing mechanism refer to the routine gnat_to_gnu_entity. */
#define TYPE_CI_CO_LIST(NODE) \ #define TYPE_CI_CO_LIST(NODE) \
(&TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE))->t.generic) (&TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_CI_CO_LIST(NODE, X) \ #define SET_TYPE_CI_CO_LIST(NODE, X) \
(TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE)) = (struct lang_type *)(X)) (TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
/* For an INTEGER_TYPE with TYPE_MODULAR_P, this is the value of the /* For an INTEGER_TYPE with TYPE_MODULAR_P, this is the value of the
modulus. */ modulus. */
#define TYPE_MODULUS(NODE) \ #define TYPE_MODULUS(NODE) \
(&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic) (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_MODULUS(NODE, X) \ #define SET_TYPE_MODULUS(NODE, X) \
(TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *)(X)) (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
/* For an INTEGER_TYPE that is the TYPE_DOMAIN of some ARRAY_TYPE, points to /* For an INTEGER_TYPE that is the TYPE_DOMAIN of some ARRAY_TYPE, points to
the type corresponding to the Ada index type. */ the type corresponding to the Ada index type. */
#define TYPE_INDEX_TYPE(NODE) \ #define TYPE_INDEX_TYPE(NODE) \
(&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic) (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_INDEX_TYPE(NODE, X) \ #define SET_TYPE_INDEX_TYPE(NODE, X) \
(TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X)) (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X))
/* For an INTEGER_TYPE with TYPE_VAX_FLOATING_POINT_P, stores the /* For an INTEGER_TYPE with TYPE_VAX_FLOATING_POINT_P, stores the
Digits_Value. */ Digits_Value. */
#define TYPE_DIGITS_VALUE(NODE) \ #define TYPE_DIGITS_VALUE(NODE) \
(&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic) (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_DIGITS_VALUE(NODE, X) \ #define SET_TYPE_DIGITS_VALUE(NODE, X) \
(TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X)) (TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X))
@ -194,7 +169,7 @@ struct lang_type GTY(())
/* Likewise for ENUMERAL_TYPE. */ /* Likewise for ENUMERAL_TYPE. */
#define TYPE_RM_SIZE_ENUM(NODE) \ #define TYPE_RM_SIZE_ENUM(NODE) \
(&TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE))->t.generic) (&TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_RM_SIZE_ENUM(NODE, X) \ #define SET_TYPE_RM_SIZE_ENUM(NODE, X) \
(TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE)) = (struct lang_type *)(X)) (TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
@ -207,21 +182,21 @@ struct lang_type GTY(())
unconstrained object. Likewise for a RECORD_TYPE that is pointed unconstrained object. Likewise for a RECORD_TYPE that is pointed
to by a thin pointer. */ to by a thin pointer. */
#define TYPE_UNCONSTRAINED_ARRAY(NODE) \ #define TYPE_UNCONSTRAINED_ARRAY(NODE) \
(&TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE))->t.generic) (&TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_UNCONSTRAINED_ARRAY(NODE, X) \ #define SET_TYPE_UNCONSTRAINED_ARRAY(NODE, X) \
(TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE)) = (struct lang_type *)(X)) (TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
/* For other RECORD_TYPEs and all UNION_TYPEs and QUAL_UNION_TYPEs, the Ada /* For other RECORD_TYPEs and all UNION_TYPEs and QUAL_UNION_TYPEs, the Ada
size of the object. This differs from the GCC size in that it does not size of the object. This differs from the GCC size in that it does not
include any rounding up to the alignment of the type. */ include any rounding up to the alignment of the type. */
#define TYPE_ADA_SIZE(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.generic) #define TYPE_ADA_SIZE(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.t)
#define SET_TYPE_ADA_SIZE(NODE, X) \ #define SET_TYPE_ADA_SIZE(NODE, X) \
(TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X)) (TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X))
/* For an INTEGER_TYPE with TYPE_HAS_ACTUAL_BOUNDS_P or an ARRAY_TYPE, this is /* For an INTEGER_TYPE with TYPE_HAS_ACTUAL_BOUNDS_P or an ARRAY_TYPE, this is
the index type that should be used when the actual bounds are required for the index type that should be used when the actual bounds are required for
a template. This is used in the case of packed arrays. */ a template. This is used in the case of packed arrays. */
#define TYPE_ACTUAL_BOUNDS(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.generic) #define TYPE_ACTUAL_BOUNDS(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.t)
#define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \ #define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \
(TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X)) (TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X))
@ -238,9 +213,6 @@ struct lang_type GTY(())
discriminant. */ discriminant. */
#define DECL_STUBBED_P(NODE) DECL_LANG_FLAG_0 (FUNCTION_DECL_CHECK (NODE)) #define DECL_STUBBED_P(NODE) DECL_LANG_FLAG_0 (FUNCTION_DECL_CHECK (NODE))
/* Nonzero in a VAR_DECL if it needs to be initialized by an assignment. */
#define DECL_INIT_BY_ASSIGN_P(NODE) DECL_LANG_FLAG_0 (VAR_DECL_CHECK (NODE))
/* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF /* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF
is needed to access the object. */ is needed to access the object. */
#define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE) #define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE)
@ -270,14 +242,14 @@ struct lang_type GTY(())
memory. Used when a scalar constant is aliased or has its memory. Used when a scalar constant is aliased or has its
address taken. */ address taken. */
#define DECL_CONST_CORRESPONDING_VAR(NODE) \ #define DECL_CONST_CORRESPONDING_VAR(NODE) \
(&DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE))->t.generic) (&DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE))->t.t)
#define SET_DECL_CONST_CORRESPONDING_VAR(NODE, X) \ #define SET_DECL_CONST_CORRESPONDING_VAR(NODE, X) \
(DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE)) = (struct lang_decl *)(X)) (DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE)) = (struct lang_decl *)(X))
/* In a FIELD_DECL, points to the FIELD_DECL that was the ultimate /* In a FIELD_DECL, points to the FIELD_DECL that was the ultimate
source of the decl. */ source of the decl. */
#define DECL_ORIGINAL_FIELD(NODE) \ #define DECL_ORIGINAL_FIELD(NODE) \
(&DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE))->t.generic) (&DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE))->t.t)
#define SET_DECL_ORIGINAL_FIELD(NODE, X) \ #define SET_DECL_ORIGINAL_FIELD(NODE, X) \
(DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE)) = (struct lang_decl *)(X)) (DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE)) = (struct lang_decl *)(X))
@ -285,31 +257,25 @@ struct lang_type GTY(())
discriminant number. */ discriminant number. */
#define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE)) #define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))
/* This is the loop id for a GNAT_LOOP_ID node. */
#define TREE_LOOP_ID(NODE) \
((union lang_tree_node *) GNAT_LOOP_ID_CHECK (NODE))->loop_id.loop_id
/* Define fields and macros for statements. /* Define fields and macros for statements.
Start by defining which tree codes are used for statements. */ Start by defining which tree codes are used for statements. */
#define IS_STMT(NODE) (TREE_CODE_CLASS (TREE_CODE (NODE)) == 's') #define IS_STMT(NODE) (TREE_CODE_CLASS (TREE_CODE (NODE)) == 's')
#define IS_ADA_STMT(NODE) (IS_STMT (NODE) \
&& TREE_CODE (NODE) >= DECL_STMT)
/* We store the Sloc in statement nodes. */
#define TREE_SLOC(NODE) TREE_COMPLEXITY (STMT_CHECK (NODE))
#define EXPR_STMT_EXPR(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXPR_STMT, 0)
#define DECL_STMT_VAR(NODE) TREE_OPERAND_CHECK_CODE (NODE, DECL_STMT, 0) #define DECL_STMT_VAR(NODE) TREE_OPERAND_CHECK_CODE (NODE, DECL_STMT, 0)
#define BLOCK_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, BLOCK_STMT, 0) #define STMT_STMT_STMT(NODE) TREE_OPERAND_CHECK_CODE (NODE, STMT_STMT, 0)
#define BLOCK_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, BLOCK_STMT, 1) #define LOOP_STMT_TOP_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 0)
#define IF_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 0) #define LOOP_STMT_BOT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 1)
#define IF_STMT_TRUE(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 1) #define LOOP_STMT_UPDATE(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 2)
#define IF_STMT_ELSEIF(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 2) #define LOOP_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 3)
#define IF_STMT_ELSE(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 3) #define LOOP_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 4)
#define GOTO_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, GOTO_STMT, 0) #define EXIT_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 0)
#define LABEL_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, LABEL_STMT, 0) #define EXIT_STMT_LOOP(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 1)
#define RETURN_STMT_EXPR(NODE) TREE_OPERAND_CHECK_CODE (NODE, RETURN_STMT, 0) #define REGION_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 0)
#define ASM_STMT_TEMPLATE(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 0) #define REGION_STMT_HANDLE(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 1)
#define ASM_STMT_OUTPUT(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 1) #define REGION_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 2)
#define ASM_STMT_ORIG_OUT(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 2) #define HANDLER_STMT_ARG(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 0)
#define ASM_STMT_INPUT(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 3) #define HANDLER_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 1)
#define ASM_STMT_CLOBBER(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 4) #define HANDLER_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 2)

161
gcc/ada/decl.c
View File

@ -102,6 +102,7 @@ static void set_rm_size (Uint, tree, Entity_Id);
static tree make_type_from_size (tree, tree, int); static tree make_type_from_size (tree, tree, int);
static unsigned int validate_alignment (Uint, Entity_Id, unsigned int); static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
static void check_ok_for_atomic (tree, Entity_Id, int); static void check_ok_for_atomic (tree, Entity_Id, int);
static void annotate_decl_with_node (tree, Node_Id);
/* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a /* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a
GCC type corresponding to that entity. GNAT_ENTITY is assumed to GCC type corresponding to that entity. GNAT_ENTITY is assumed to
@ -279,9 +280,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Get the name of the entity and set up the line number and filename of /* Get the name of the entity and set up the line number and filename of
the original definition for use in any decl we make. */ the original definition for use in any decl we make. */
gnu_entity_id = get_entity_name (gnat_entity); gnu_entity_id = get_entity_name (gnat_entity);
set_lineno (gnat_entity, 0); Sloc_to_locus (Sloc (gnat_entity), &input_location);
/* If we get here, it means we have not yet done anything with this /* If we get here, it means we have not yet done anything with this
entity. If we are not defining it here, it must be external, entity. If we are not defining it here, it must be external,
@ -767,14 +767,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| (staticp (gnu_expr) || (staticp (gnu_expr)
&& ! TREE_SIDE_EFFECTS (gnu_expr)))) && ! TREE_SIDE_EFFECTS (gnu_expr))))
{ {
set_lineno (gnat_entity, ! global_bindings_p ());
gnu_decl = gnat_stabilize_reference (gnu_expr, 1); gnu_decl = gnat_stabilize_reference (gnu_expr, 1);
save_gnu_tree (gnat_entity, gnu_decl, 1); save_gnu_tree (gnat_entity, gnu_decl, 1);
saved = 1; saved = 1;
if (! global_bindings_p ())
expand_expr_stmt (build1 (CONVERT_EXPR, void_type_node,
gnu_decl));
break; break;
} }
else else
@ -955,20 +950,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_SIZE_UNIT (gnu_type)); TYPE_SIZE_UNIT (gnu_type));
tree gnu_new_var; tree gnu_new_var;
set_lineno (gnat_entity, 1);
gnu_new_var gnu_new_var
= create_var_decl (create_concat_name (gnat_entity, "ALIGN"), = create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
NULL_TREE, gnu_new_type, gnu_expr, NULL_TREE, gnu_new_type, gnu_expr,
0, 0, 0, 0, 0); 0, 0, 0, 0, 0);
annotate_decl_with_node (gnu_new_var, gnat_entity);
add_decl_stmt (gnu_new_var, gnat_entity); add_decl_stmt (gnu_new_var, gnat_entity);
if (gnu_expr != 0) if (gnu_expr != 0)
expand_expr_stmt add_stmt_with_node
(build_binary_op (build_binary_op (MODIFY_EXPR, NULL_TREE,
(MODIFY_EXPR, NULL_TREE, build_component_ref
build_component_ref (gnu_new_var, NULL_TREE, (gnu_new_var, NULL_TREE,
TYPE_FIELDS (gnu_new_type), 0), TYPE_FIELDS (gnu_new_type), 0),
gnu_expr)); gnu_expr),
gnat_entity);
gnu_type = build_reference_type (gnu_type); gnu_type = build_reference_type (gnu_type);
gnu_expr gnu_expr
@ -1024,13 +1020,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& TYPE_IS_PADDING_P (gnu_type)))) && TYPE_IS_PADDING_P (gnu_type))))
static_p = 1; static_p = 1;
set_lineno (gnat_entity, ! global_bindings_p ());
gnu_decl = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, gnu_decl = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
gnu_expr, const_flag, gnu_expr, const_flag,
Is_Public (gnat_entity), Is_Public (gnat_entity),
imported_p || !definition, imported_p || !definition,
static_p, attr_list); static_p, attr_list);
annotate_decl_with_node (gnu_decl, gnat_entity);
DECL_BY_REF_P (gnu_decl) = used_by_ref; DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag; DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
@ -1045,25 +1040,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
add_decl_stmt (gnu_decl, gnat_entity); add_decl_stmt (gnu_decl, gnat_entity);
if (definition && DECL_SIZE (gnu_decl) != 0 if (definition && DECL_SIZE (gnu_decl) != 0
&& gnu_block_stack != 0 && get_block_jmpbuf_decl ()
&& TREE_VALUE (gnu_block_stack) != 0
&& (TREE_CODE (DECL_SIZE (gnu_decl)) != INTEGER_CST && (TREE_CODE (DECL_SIZE (gnu_decl)) != INTEGER_CST
|| (flag_stack_check && ! STACK_CHECK_BUILTIN || (flag_stack_check && ! STACK_CHECK_BUILTIN
&& 0 < compare_tree_int (DECL_SIZE_UNIT (gnu_decl), && 0 < compare_tree_int (DECL_SIZE_UNIT (gnu_decl),
STACK_CHECK_MAX_VAR_SIZE)))) STACK_CHECK_MAX_VAR_SIZE))))
{ add_stmt_with_node (build_call_1_expr
tree gnu_stmt (update_setjmp_buf_decl,
= build_nt (EXPR_STMT, build_unary_op (ADDR_EXPR, NULL_TREE,
(build_call_1_expr get_block_jmpbuf_decl ())),
(update_setjmp_buf_decl, gnat_entity);
build_unary_op
(ADDR_EXPR, NULL_TREE,
TREE_VALUE (gnu_block_stack)))));
TREE_SLOC (gnu_stmt) = Sloc (gnat_entity);
TREE_TYPE (gnu_stmt) = void_type_node;
add_stmt (gnu_stmt);
}
/* If this is a public constant or we're not optimizing and we're not /* If this is a public constant or we're not optimizing and we're not
making a VAR_DECL for it, make one just for export or debugger making a VAR_DECL for it, make one just for export or debugger
@ -1527,7 +1513,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Make the FIELD_DECLs for the minimum and maximum of this /* Make the FIELD_DECLs for the minimum and maximum of this
type and then make extractions of that field from the type and then make extractions of that field from the
template. */ template. */
set_lineno (gnat_entity, 0);
sprintf (field_name, "LB%d", index); sprintf (field_name, "LB%d", index);
gnu_min_field = create_field_decl (get_identifier (field_name), gnu_min_field = create_field_decl (get_identifier (field_name),
gnu_ind_subtype, gnu_ind_subtype,
@ -1537,6 +1522,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_ind_subtype, gnu_ind_subtype,
gnu_template_type, 0, 0, 0, 0); gnu_template_type, 0, 0, 0, 0);
annotate_decl_with_node (gnu_min_field, gnat_entity);
annotate_decl_with_node (gnu_max_field, gnat_entity);
gnu_temp_fields[index] = chainon (gnu_min_field, gnu_max_field); gnu_temp_fields[index] = chainon (gnu_min_field, gnu_max_field);
/* We can't use build_component_ref here since the template /* We can't use build_component_ref here since the template
@ -2062,14 +2049,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* First finish the type we had been making so that we output /* First finish the type we had been making so that we output
debugging information for it */ debugging information for it */
gnu_type = build_qualified_type (gnu_type, gnu_type
(TYPE_QUALS (gnu_type) = build_qualified_type (gnu_type,
| (TYPE_QUAL_VOLATILE (TYPE_QUALS (gnu_type)
* Treat_As_Volatile (gnat_entity)))); | (TYPE_QUAL_VOLATILE
set_lineno (gnat_entity, 0); * Treat_As_Volatile (gnat_entity))));
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p);
annotate_decl_with_node (gnu_decl, gnat_entity);
if (! Comes_From_Source (gnat_entity)) if (! Comes_From_Source (gnat_entity))
DECL_ARTIFICIAL (gnu_decl) = 1; DECL_ARTIFICIAL (gnu_decl) = 1;
@ -2128,14 +2116,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
for (gnat_index = First_Index (gnat_entity); for (gnat_index = First_Index (gnat_entity);
Present (gnat_index); gnat_index = Next_Index (gnat_index)) Present (gnat_index); gnat_index = Next_Index (gnat_index))
SET_TYPE_ACTUAL_BOUNDS (gnu_inner_type, SET_TYPE_ACTUAL_BOUNDS
tree_cons (NULL_TREE, (gnu_inner_type,
get_unpadded_type (Etype (gnat_index)), tree_cons (NULL_TREE,
TYPE_ACTUAL_BOUNDS (gnu_inner_type))); get_unpadded_type (Etype (gnat_index)),
TYPE_ACTUAL_BOUNDS (gnu_inner_type)));
if (Convention (gnat_entity) != Convention_Fortran) if (Convention (gnat_entity) != Convention_Fortran)
SET_TYPE_ACTUAL_BOUNDS (gnu_inner_type, SET_TYPE_ACTUAL_BOUNDS
nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type))); (gnu_inner_type,
nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type)));
if (TREE_CODE (gnu_type) == RECORD_TYPE if (TREE_CODE (gnu_type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_type)) && TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_type))
@ -2295,10 +2285,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
{ {
defer_incomplete_level++; defer_incomplete_level++;
this_deferred = 1; this_deferred = 1;
set_lineno (gnat_entity, 0);
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p);
annotate_decl_with_node (gnu_decl, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0); save_gnu_tree (gnat_entity, gnu_decl, 0);
this_made_decl = saved = 1; this_made_decl = saved = 1;
} }
@ -2656,10 +2646,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
DECL_INTERNAL_P (gnu_field) DECL_INTERNAL_P (gnu_field)
= DECL_INTERNAL_P (gnu_old_field); = DECL_INTERNAL_P (gnu_old_field);
SET_DECL_ORIGINAL_FIELD (gnu_field, SET_DECL_ORIGINAL_FIELD
(DECL_ORIGINAL_FIELD (gnu_old_field) != 0 (gnu_field, (DECL_ORIGINAL_FIELD (gnu_old_field) != 0
? DECL_ORIGINAL_FIELD (gnu_old_field) ? DECL_ORIGINAL_FIELD (gnu_old_field)
: gnu_old_field)); : gnu_old_field));
DECL_DISCRIMINANT_NUMBER (gnu_field) DECL_DISCRIMINANT_NUMBER (gnu_field)
= DECL_DISCRIMINANT_NUMBER (gnu_old_field); = DECL_DISCRIMINANT_NUMBER (gnu_old_field);
TREE_THIS_VOLATILE (gnu_field) TREE_THIS_VOLATILE (gnu_field)
@ -2700,10 +2690,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type))) && CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type)))
for (gnu_temp = gnu_subst_list; for (gnu_temp = gnu_subst_list;
gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp)) gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
SET_TYPE_ADA_SIZE (gnu_type, SET_TYPE_ADA_SIZE
substitute_in_expr (TYPE_ADA_SIZE (gnu_type), (gnu_type, substitute_in_expr (TYPE_ADA_SIZE (gnu_type),
TREE_PURPOSE (gnu_temp), TREE_PURPOSE (gnu_temp),
TREE_VALUE (gnu_temp))); TREE_VALUE (gnu_temp)));
/* Recompute the mode of this record type now that we know its /* Recompute the mode of this record type now that we know its
actual size. */ actual size. */
@ -2901,7 +2891,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old); SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old);
TYPE_POINTER_TO (gnu_old) = gnu_type; TYPE_POINTER_TO (gnu_old) = gnu_type;
set_lineno (gnat_entity, 0); Sloc_to_locus (Sloc (gnat_entity), &input_location);
fields fields
= chainon (chainon (NULL_TREE, = chainon (chainon (NULL_TREE,
create_field_decl create_field_decl
@ -3492,7 +3482,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_param = 0; gnu_param = 0;
else else
{ {
set_lineno (gnat_param, 0);
gnu_param gnu_param
= create_param_decl = create_param_decl
(gnu_param_name, gnu_param_type, (gnu_param_name, gnu_param_type,
@ -3505,6 +3494,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
DECL_POINTS_TO_READONLY_P (gnu_param) DECL_POINTS_TO_READONLY_P (gnu_param)
= (Ekind (gnat_param) == E_In_Parameter = (Ekind (gnat_param) == E_In_Parameter
&& (by_ref_p || by_component_ptr_p)); && (by_ref_p || by_component_ptr_p));
annotate_decl_with_node (gnu_param, gnat_param);
save_gnu_tree (gnat_param, gnu_param, 0); save_gnu_tree (gnat_param, gnu_param, 0);
gnu_param_list = chainon (gnu_param, gnu_param_list); gnu_param_list = chainon (gnu_param, gnu_param_list);
@ -3530,9 +3520,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
has_copy_in_out = 1; has_copy_in_out = 1;
} }
set_lineno (gnat_param, 0);
gnu_field = create_field_decl (gnu_param_name, gnu_param_type, gnu_field = create_field_decl (gnu_param_name, gnu_param_type,
gnu_return_type, 0, 0, 0, 0); gnu_return_type, 0, 0, 0, 0);
annotate_decl_with_node (gnu_field, gnat_param);
TREE_CHAIN (gnu_field) = gnu_field_list; TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field; gnu_field_list = gnu_field;
gnu_return_list = tree_cons (gnu_field, gnu_param, gnu_return_list = tree_cons (gnu_field, gnu_param,
@ -3595,7 +3585,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
| (TYPE_QUAL_CONST * pure_flag) | (TYPE_QUAL_CONST * pure_flag)
| (TYPE_QUAL_VOLATILE * volatile_flag))); | (TYPE_QUAL_VOLATILE * volatile_flag)));
set_lineno (gnat_entity, 0); Sloc_to_locus (Sloc (gnat_entity), &input_location);
/* If there was no specified Interface_Name and the external and /* If there was no specified Interface_Name and the external and
internal names of the subprogram are the same, only use the internal names of the subprogram are the same, only use the
@ -3702,10 +3692,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Save this type as the full declaration's type so we can do any needed /* Save this type as the full declaration's type so we can do any needed
updates when we see it. */ updates when we see it. */
set_lineno (gnat_entity, 0);
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p);
annotate_decl_with_node (gnu_decl, gnat_entity);
save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0); save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0);
break; break;
@ -3867,12 +3857,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
size_int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT)); size_int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
if (TREE_CODE (gnu_type) == RECORD_TYPE) if (TREE_CODE (gnu_type) == RECORD_TYPE)
SET_TYPE_ADA_SIZE (gnu_type, SET_TYPE_ADA_SIZE
elaborate_expression_1 (gnat_entity, gnat_entity, (gnu_type,
TYPE_ADA_SIZE (gnu_type), elaborate_expression_1 (gnat_entity,
get_identifier ("RM_SIZE"), gnat_entity,
definition, 0)); TYPE_ADA_SIZE (gnu_type),
} get_identifier ("RM_SIZE"),
definition, 0));
}
} }
/* If this is a record type or subtype, call elaborate_expression_1 on /* If this is a record type or subtype, call elaborate_expression_1 on
@ -3919,10 +3911,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (gnu_decl == 0) if (gnu_decl == 0)
{ {
set_lineno (gnat_entity, 0);
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity), ! Comes_From_Source (gnat_entity),
debug_info_p); debug_info_p);
annotate_decl_with_node (gnu_decl, gnat_entity);
} }
else else
TREE_TYPE (gnu_decl) = gnu_type; TREE_TYPE (gnu_decl) = gnu_type;
@ -4171,8 +4163,8 @@ mark_out_of_scope (Entity_Id gnat_entity)
for (gnat_sub_entity = First_Entity (gnat_entity); for (gnat_sub_entity = First_Entity (gnat_entity);
Present (gnat_sub_entity); Present (gnat_sub_entity);
gnat_sub_entity = Next_Entity (gnat_sub_entity)) gnat_sub_entity = Next_Entity (gnat_sub_entity))
if (Scope (gnat_sub_entity) == gnat_entity if (Scope (gnat_sub_entity) == gnat_entity
&& gnat_sub_entity != gnat_entity) && gnat_sub_entity != gnat_entity)
mark_out_of_scope (gnat_sub_entity); mark_out_of_scope (gnat_sub_entity);
/* Now clear this if it has been defined, but only do so if it isn't /* Now clear this if it has been defined, but only do so if it isn't
@ -4427,18 +4419,13 @@ get_unpadded_type (Entity_Id gnat_entity)
/* Called when we need to protect a variable object using a save_expr. */ /* Called when we need to protect a variable object using a save_expr. */
tree tree
maybe_variable (tree gnu_operand, Node_Id gnat_node) maybe_variable (tree gnu_operand)
{ {
if (TREE_CONSTANT (gnu_operand) || TREE_READONLY (gnu_operand) if (TREE_CONSTANT (gnu_operand) || TREE_READONLY (gnu_operand)
|| TREE_CODE (gnu_operand) == SAVE_EXPR || TREE_CODE (gnu_operand) == SAVE_EXPR
|| TREE_CODE (gnu_operand) == NULL_EXPR) || TREE_CODE (gnu_operand) == NULL_EXPR)
return gnu_operand; return gnu_operand;
/* If we will be generating code, make sure we are at the proper
line number. */
if (! global_bindings_p () && ! CONTAINS_PLACEHOLDER_P (gnu_operand))
set_lineno (gnat_node, 1);
if (TREE_CODE (gnu_operand) == UNCONSTRAINED_ARRAY_REF) if (TREE_CODE (gnu_operand) == UNCONSTRAINED_ARRAY_REF)
{ {
tree gnu_result = build1 (UNCONSTRAINED_ARRAY_REF, tree gnu_result = build1 (UNCONSTRAINED_ARRAY_REF,
@ -4554,12 +4541,12 @@ elaborate_expression_1 (Node_Id gnat_expr,
/* Now create the variable if we need it. */ /* Now create the variable if we need it. */
if (need_debug || (expr_variable && expr_global)) if (need_debug || (expr_variable && expr_global))
{ {
set_lineno (gnat_entity, ! global_bindings_p ());
gnu_decl gnu_decl
= create_var_decl (create_concat_name (gnat_entity, = create_var_decl (create_concat_name (gnat_entity,
IDENTIFIER_POINTER (gnu_name)), IDENTIFIER_POINTER (gnu_name)),
NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1, NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1,
Is_Public (gnat_entity), ! definition, 0, 0); Is_Public (gnat_entity), ! definition, 0, 0);
annotate_decl_with_node (gnu_decl, gnat_entity);
add_decl_stmt (gnu_decl, gnat_entity); add_decl_stmt (gnu_decl, gnat_entity);
} }
@ -4570,7 +4557,7 @@ elaborate_expression_1 (Node_Id gnat_expr,
else if (! expr_variable) else if (! expr_variable)
return gnu_expr; return gnu_expr;
else else
return maybe_variable (gnu_expr, gnat_expr); return maybe_variable (gnu_expr);
} }
/* Create a record type that contains a field of TYPE with a starting bit /* Create a record type that contains a field of TYPE with a starting bit
@ -4675,9 +4662,9 @@ make_packable_type (tree type)
! DECL_NONADDRESSABLE_P (old_field)); ! DECL_NONADDRESSABLE_P (old_field));
DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field); DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
SET_DECL_ORIGINAL_FIELD (new_field, SET_DECL_ORIGINAL_FIELD
(DECL_ORIGINAL_FIELD (old_field) != 0 (new_field, (DECL_ORIGINAL_FIELD (old_field) != 0
? DECL_ORIGINAL_FIELD (old_field) : old_field)); ? DECL_ORIGINAL_FIELD (old_field) : old_field));
if (TREE_CODE (new_type) == QUAL_UNION_TYPE) if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field); DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field);
@ -5193,11 +5180,10 @@ gnat_to_gnu_field (Entity_Id gnat_field,
gigi_abort (118); gigi_abort (118);
/* Now create the decl for the field. */ /* Now create the decl for the field. */
set_lineno (gnat_field, 0);
gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type, gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
packed, gnu_size, gnu_pos, packed, gnu_size, gnu_pos,
Is_Aliased (gnat_field)); Is_Aliased (gnat_field));
annotate_decl_with_node (gnu_field, gnat_field);
TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field); TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field);
if (Ekind (gnat_field) == E_Discriminant) if (Ekind (gnat_field) == E_Discriminant)
@ -6201,6 +6187,15 @@ check_ok_for_atomic (tree object, Entity_Id gnat_entity, int comp_p)
gnat_error_point, gnat_entity); gnat_error_point, gnat_entity);
} }
/* Set the DECL_SOURCE_LOCATION of GNU_DECL to the location of
GNAT_NODE. */
static void
annotate_decl_with_node (tree gnu_decl, Node_Id gnat_node)
{
Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (gnu_decl));
}
/* Given a type T, a FIELD_DECL F, and a replacement value R, /* Given a type T, a FIELD_DECL F, and a replacement value R,
return a new type with all size expressions that contain F return a new type with all size expressions that contain F
updated by replacing F with R. This is identical to GCC's updated by replacing F with R. This is identical to GCC's
@ -6231,8 +6226,8 @@ gnat_substitute_in_type (tree t, tree f, tree r)
new = build_range_type (TREE_TYPE (t), low, high); new = build_range_type (TREE_TYPE (t), low, high);
if (TYPE_INDEX_TYPE (t)) if (TYPE_INDEX_TYPE (t))
SET_TYPE_INDEX_TYPE (new, SET_TYPE_INDEX_TYPE
gnat_substitute_in_type (TYPE_INDEX_TYPE (t), f, r)); (new, gnat_substitute_in_type (TYPE_INDEX_TYPE (t), f, r));
return new; return new;
} }
@ -6351,8 +6346,8 @@ gnat_substitute_in_type (tree t, tree f, tree r)
DECL_CONTEXT (new_field) = new; DECL_CONTEXT (new_field) = new;
SET_DECL_ORIGINAL_FIELD (new_field, SET_DECL_ORIGINAL_FIELD (new_field,
(DECL_ORIGINAL_FIELD (field) != 0 (DECL_ORIGINAL_FIELD (field) != 0
? DECL_ORIGINAL_FIELD (field) : field)); ? DECL_ORIGINAL_FIELD (field) : field));
/* If the size of the old field was set at a constant, /* If the size of the old field was set at a constant,
propagate the size in case the type's size was variable. propagate the size in case the type's size was variable.

70
gcc/ada/gigi.h
View File

@ -36,12 +36,6 @@ extern unsigned int largest_move_alignment;
/* Declare all functions and types used by gigi. */ /* Declare all functions and types used by gigi. */
/* Record the current code position in GNAT_NODE. */
extern void record_code_position (Node_Id);
/* Insert the code for GNAT_NODE at the position saved for that node. */
extern void insert_code_for (Node_Id);
/* Compute the alignment of the largest mode that can be used for copying /* Compute the alignment of the largest mode that can be used for copying
objects. */ objects. */
extern void gnat_compute_largest_alignment (void); extern void gnat_compute_largest_alignment (void);
@ -50,9 +44,6 @@ extern void gnat_compute_largest_alignment (void);
expression that contains the last address on the stack to check. */ expression that contains the last address on the stack to check. */
extern tree emit_stack_check (tree); extern tree emit_stack_check (tree);
/* Make a TRANSFORM_EXPR to later expand GNAT_NODE into code. */
extern tree make_transform_expr (Node_Id);
/* GNU_TYPE is a type. Determine if it should be passed by reference by /* GNU_TYPE is a type. Determine if it should be passed by reference by
default. */ default. */
extern int default_pass_by_ref (tree); extern int default_pass_by_ref (tree);
@ -92,6 +83,12 @@ extern tree gnat_to_gnu_type (Entity_Id);
/* Add GNU_STMT to the current BLOCK_STMT node. */ /* Add GNU_STMT to the current BLOCK_STMT node. */
extern void add_stmt (tree); extern void add_stmt (tree);
/* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */
extern void add_stmt_with_node (tree, Node_Id);
/* Set the BLOCK node corresponding to the current code group to GNU_BLOCK. */
extern void set_block_for_group (tree);
/* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node. /* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node.
Get SLOC from Entity_Id. */ Get SLOC from Entity_Id. */
extern void add_decl_stmt (tree, Entity_Id); extern void add_decl_stmt (tree, Entity_Id);
@ -111,7 +108,7 @@ extern tree make_dummy_type (Entity_Id);
extern tree get_unpadded_type (Entity_Id); extern tree get_unpadded_type (Entity_Id);
/* Called when we need to protect a variable object using a save_expr. */ /* Called when we need to protect a variable object using a save_expr. */
extern tree maybe_variable (tree, Node_Id); extern tree maybe_variable (tree);
/* Create a record type that contains a field of TYPE with a starting bit /* Create a record type that contains a field of TYPE with a starting bit
position so that it is aligned to ALIGN bits. */ position so that it is aligned to ALIGN bits. */
@ -147,22 +144,14 @@ extern tree get_entity_name (Entity_Id);
SUFFIX. */ SUFFIX. */
extern tree create_concat_name (Entity_Id, const char *); extern tree create_concat_name (Entity_Id, const char *);
/* Flag indicating whether file names are discarded in exception messages */ /* If true, then gigi is being called on an analyzed but unexpanded tree, and
extern int discard_file_names; the only purpose of the call is to properly annotate types with
representation information. */
/* If true, then gigi is being called on an analyzed but unexpanded
tree, and the only purpose of the call is to properly annotate
types with representation information */
extern int type_annotate_only; extern int type_annotate_only;
/* Current file name without path */ /* Current file name without path */
extern const char *ref_filename; extern const char *ref_filename;
/* List of TREE_LIST nodes representing a block stack. TREE_VALUE
of each gives the variable used for the setjmp buffer in the current
block, if any. */
extern GTY(()) tree gnu_block_stack;
/* This is the main program of the back-end. It sets up all the table /* This is the main program of the back-end. It sets up all the table
structures and then generates code. */ structures and then generates code. */
@ -171,11 +160,6 @@ extern void gigi (Node_Id, int, int, struct Node *, Node_Id *, Node_Id *,
struct String_Entry *, Char_Code *, struct List_Header *, struct String_Entry *, Char_Code *, struct List_Header *,
Int, char *, Entity_Id, Entity_Id, Entity_Id, Int); Int, char *, Entity_Id, Entity_Id, Entity_Id, Int);
/* This function is the driver of the GNAT to GCC tree transformation process.
GNAT_NODE is the root of some gnat tree. It generates code for that
part of the tree. */
extern void gnat_to_code (Node_Id);
/* GNAT_NODE is the root of some GNAT tree. Return the root of the /* GNAT_NODE is the root of some GNAT tree. Return the root of the
GCC tree corresponding to that GNAT tree. Normally, no code is generated; GCC tree corresponding to that GNAT tree. Normally, no code is generated;
we just return an equivalent tree which is used elsewhere to generate we just return an equivalent tree which is used elsewhere to generate
@ -185,19 +169,23 @@ extern tree gnat_to_gnu (Node_Id);
/* GNU_STMT is a statement. We generate code for that statement. */ /* GNU_STMT is a statement. We generate code for that statement. */
extern void gnat_expand_stmt (tree); extern void gnat_expand_stmt (tree);
extern int gnat_gimplify_expr (tree *, tree *, tree *);
/* Expand the body of GNU_DECL, which is not a nested function. */
extern void gnat_expand_body (tree);
/* Do the processing for the declaration of a GNAT_ENTITY, a type. If /* Do the processing for the declaration of a GNAT_ENTITY, a type. If
a separate Freeze node exists, delay the bulk of the processing. Otherwise a separate Freeze node exists, delay the bulk of the processing. Otherwise
make a GCC type for GNAT_ENTITY and set up the correspondance. */ make a GCC type for GNAT_ENTITY and set up the correspondance. */
extern void process_type (Entity_Id); extern void process_type (Entity_Id);
/* Determine the input_filename and the input_line from the source location /* Convert Sloc into *LOCUS (a location_t). Return true if this Sloc
(Sloc) of GNAT_NODE node. Set the global variable input_filename and corresponds to a source code location and false if it doesn't. In the
input_line. If WRITE_NOTE_P is true, emit a line number note. */ latter case, we don't update *LOCUS. We also set the Gigi global variable
extern void set_lineno (Node_Id, int); REF_FILENAME to the reference file name as given by sinput (i.e no
directory). */
/* Likewise, but passed a Sloc. */ extern bool Sloc_to_locus (Source_Ptr, location_t *);
extern void set_lineno_from_sloc (Source_Ptr, int);
/* Post an error message. MSG is the error message, properly annotated. /* Post an error message. MSG is the error message, properly annotated.
NODE is the node at which to post the error and the node to use for the NODE is the node at which to post the error and the node to use for the
@ -383,10 +371,15 @@ extern int global_bindings_p (void);
is in reverse order (it has to be so for back-end compatibility). */ is in reverse order (it has to be so for back-end compatibility). */
extern tree getdecls (void); extern tree getdecls (void);
/* Enter and exit a new binding level. We return the BLOCK node, if any /* Enter and exit a new binding level. */
when we exit a binding level. */
extern void gnat_pushlevel (void); extern void gnat_pushlevel (void);
extern tree gnat_poplevel (void); extern void gnat_poplevel (void);
/* Set the jmpbuf_decl for the current binding level to DECL. */
extern void set_block_jmpbuf_decl (tree);
/* Get the setjmp_decl, if any, for the current binding level. */
extern tree get_block_jmpbuf_decl (void);
/* Insert BLOCK at the end of the list of subblocks of the /* Insert BLOCK at the end of the list of subblocks of the
current binding level. This is used when a BIND_EXPR is expanded, current binding level. This is used when a BIND_EXPR is expanded,
@ -563,8 +556,9 @@ extern tree create_label_decl (tree);
extern void begin_subprog_body (tree); extern void begin_subprog_body (tree);
/* Finish the definition of the current subprogram and compile it all the way /* Finish the definition of the current subprogram and compile it all the way
to assembler language output. */ to assembler language output. BODY is the tree corresponding to
extern void end_subprog_body (void); the subprogram. */
extern void end_subprog_body (tree);
/* Build a template of type TEMPLATE_TYPE from the array bounds of ARRAY_TYPE. /* Build a template of type TEMPLATE_TYPE from the array bounds of ARRAY_TYPE.
EXPR is an expression that we can use to locate any PLACEHOLDER_EXPRs. EXPR is an expression that we can use to locate any PLACEHOLDER_EXPRs.

155
gcc/ada/misc.c
View File

@ -48,6 +48,8 @@
#include "ggc.h" #include "ggc.h"
#include "flags.h" #include "flags.h"
#include "debug.h" #include "debug.h"
#include "cgraph.h"
#include "tree-inline.h"
#include "insn-codes.h" #include "insn-codes.h"
#include "insn-flags.h" #include "insn-flags.h"
#include "insn-config.h" #include "insn-config.h"
@ -84,11 +86,11 @@ extern FILE *asm_out_file;
move instruction. */ move instruction. */
unsigned int largest_move_alignment; unsigned int largest_move_alignment;
static size_t gnat_tree_size (enum tree_code);
static bool gnat_init (void); static bool gnat_init (void);
static void gnat_finish_incomplete_decl (tree); static void gnat_finish_incomplete_decl (tree);
static unsigned int gnat_init_options (unsigned int, const char **); static unsigned int gnat_init_options (unsigned int, const char **);
static int gnat_handle_option (size_t, const char *, int); static int gnat_handle_option (size_t, const char *, int);
static bool gnat_post_options (const char **);
static HOST_WIDE_INT gnat_get_alias_set (tree); static HOST_WIDE_INT gnat_get_alias_set (tree);
static void gnat_print_decl (FILE *, tree, int); static void gnat_print_decl (FILE *, tree, int);
static void gnat_print_type (FILE *, tree, int); static void gnat_print_type (FILE *, tree, int);
@ -107,14 +109,14 @@ static void gnat_adjust_rli (record_layout_info);
#define LANG_HOOKS_NAME "GNU Ada" #define LANG_HOOKS_NAME "GNU Ada"
#undef LANG_HOOKS_IDENTIFIER_SIZE #undef LANG_HOOKS_IDENTIFIER_SIZE
#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier) #define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
#undef LANG_HOOKS_TREE_SIZE
#define LANG_HOOKS_TREE_SIZE gnat_tree_size
#undef LANG_HOOKS_INIT #undef LANG_HOOKS_INIT
#define LANG_HOOKS_INIT gnat_init #define LANG_HOOKS_INIT gnat_init
#undef LANG_HOOKS_INIT_OPTIONS #undef LANG_HOOKS_INIT_OPTIONS
#define LANG_HOOKS_INIT_OPTIONS gnat_init_options #define LANG_HOOKS_INIT_OPTIONS gnat_init_options
#undef LANG_HOOKS_HANDLE_OPTION #undef LANG_HOOKS_HANDLE_OPTION
#define LANG_HOOKS_HANDLE_OPTION gnat_handle_option #define LANG_HOOKS_HANDLE_OPTION gnat_handle_option
#undef LANG_HOOKS_POST_OPTIONS
#define LANG_HOOKS_POST_OPTIONS gnat_post_options
#undef LANG_HOOKS_PARSE_FILE #undef LANG_HOOKS_PARSE_FILE
#define LANG_HOOKS_PARSE_FILE gnat_parse_file #define LANG_HOOKS_PARSE_FILE gnat_parse_file
#undef LANG_HOOKS_HONOR_READONLY #undef LANG_HOOKS_HONOR_READONLY
@ -143,6 +145,13 @@ static void gnat_adjust_rli (record_layout_info);
#define LANG_HOOKS_PRINT_TYPE gnat_print_type #define LANG_HOOKS_PRINT_TYPE gnat_print_type
#undef LANG_HOOKS_DECL_PRINTABLE_NAME #undef LANG_HOOKS_DECL_PRINTABLE_NAME
#define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name #define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name
#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gnat_expand_body
#undef LANG_HOOKS_RTL_EXPAND_STMT
#define LANG_HOOKS_RTL_EXPAND_STMT gnat_expand_stmt
#undef LANG_HOOKS_GIMPLIFY_EXPR
#define LANG_HOOKS_GIMPLIFY_EXPR gnat_gimplify_expr
#undef LANG_HOOKS_TYPE_FOR_MODE #undef LANG_HOOKS_TYPE_FOR_MODE
#define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode #define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode
#undef LANG_HOOKS_TYPE_FOR_SIZE #undef LANG_HOOKS_TYPE_FOR_SIZE
@ -224,10 +233,11 @@ gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
/* Call the front-end elaboration procedures */ /* Call the front-end elaboration procedures */
adainit (); adainit ();
immediate_size_expand = 1;
/* Call the front end */ /* Call the front end */
_ada_gnat1drv (); _ada_gnat1drv ();
cgraph_finalize_compilation_unit ();
cgraph_optimize ();
} }
/* Decode all the language specific options that cannot be decoded by GCC. /* Decode all the language specific options that cannot be decoded by GCC.
@ -332,6 +342,24 @@ gnat_init_options (unsigned int argc, const char **argv)
return CL_Ada; return CL_Ada;
} }
/* Post-switch processing. */
bool
gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
{
flag_inline_trees = 1;
if (!flag_no_inline)
flag_no_inline = 1;
if (flag_inline_functions)
{
flag_inline_trees = 2;
flag_inline_functions = 0;
}
return false;
}
/* Here is the function to handle the compiler error processing in GCC. */ /* Here is the function to handle the compiler error processing in GCC. */
static void static void
@ -359,21 +387,6 @@ internal_error_function (const char *msgid, va_list *ap)
Compiler_Abort (fp, -1); Compiler_Abort (fp, -1);
} }
/* Langhook for tree_size: Determine size of our 'x' and 'c' nodes. */
static size_t
gnat_tree_size (enum tree_code code)
{
switch (code)
{
case GNAT_LOOP_ID:
return sizeof (struct tree_loop_id);
default:
abort ();
}
/* NOTREACHED */
}
/* Perform all the initialization steps that are language-specific. */ /* Perform all the initialization steps that are language-specific. */
static bool static bool
@ -559,7 +572,7 @@ gnat_printable_name (tree decl, int verbosity)
} }
/* Expands GNAT-specific GCC tree nodes. The only ones we support /* Expands GNAT-specific GCC tree nodes. The only ones we support
here are TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR and NULL_EXPR. */ here are and NULL_EXPR. */
static rtx static rtx
gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode, gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode,
@ -567,7 +580,6 @@ gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode,
{ {
tree type = TREE_TYPE (exp); tree type = TREE_TYPE (exp);
tree new; tree new;
rtx result;
/* If this is a statement, call the expansion routine for statements. */ /* If this is a statement, call the expansion routine for statements. */
if (IS_STMT (exp)) if (IS_STMT (exp))
@ -579,48 +591,14 @@ gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode,
/* Update EXP to be the new expression to expand. */ /* Update EXP to be the new expression to expand. */
switch (TREE_CODE (exp)) switch (TREE_CODE (exp))
{ {
case TRANSFORM_EXPR: #if 0
gnat_to_code (TREE_COMPLEXITY (exp));
return const0_rtx;
break;
case NULL_EXPR:
expand_expr (TREE_OPERAND (exp, 0), const0_rtx, VOIDmode, 0);
/* We aren't going to be doing anything with this memory, but allocate
it anyway. If it's variable size, make a bogus address. */
if (! host_integerp (TYPE_SIZE_UNIT (type), 1))
result = gen_rtx_MEM (BLKmode, virtual_stack_vars_rtx);
else
result = assign_temp (type, 0, TREE_ADDRESSABLE (exp), 1);
return result;
case ALLOCATE_EXPR: case ALLOCATE_EXPR:
return return
allocate_dynamic_stack_space allocate_dynamic_stack_space
(expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype), (expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype),
EXPAND_NORMAL), EXPAND_NORMAL),
NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1)); NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
#endif
case USE_EXPR:
if (target != const0_rtx)
gigi_abort (203);
/* First write a volatile ASM_INPUT to prevent anything from being
moved. */
result = gen_rtx_ASM_INPUT (VOIDmode, "");
MEM_VOLATILE_P (result) = 1;
emit_insn (result);
result = expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, VOIDmode,
modifier);
emit_insn (gen_rtx_USE (VOIDmode, result));
return target;
case GNAT_NOP_EXPR:
return expand_expr_real (build1 (NOP_EXPR, type, TREE_OPERAND (exp, 0)),
target, tmode, modifier, alt_rtl);
case UNCONSTRAINED_ARRAY_REF: case UNCONSTRAINED_ARRAY_REF:
/* If we are evaluating just for side-effects, just evaluate our /* If we are evaluating just for side-effects, just evaluate our
@ -667,18 +645,6 @@ gnat_adjust_rli (record_layout_info rli ATTRIBUTE_UNUSED)
rli->record_align = record_align; rli->record_align = record_align;
#endif #endif
} }
/* Make a TRANSFORM_EXPR to later expand GNAT_NODE into code. */
tree
make_transform_expr (Node_Id gnat_node)
{
tree gnu_result = build (TRANSFORM_EXPR, void_type_node);
TREE_SIDE_EFFECTS (gnu_result) = 1;
TREE_COMPLEXITY (gnu_result) = gnat_node;
return gnu_result;
}
/* These routines are used in conjunction with GCC exception handling. */ /* These routines are used in conjunction with GCC exception handling. */
@ -704,55 +670,6 @@ gnat_eh_type_covers (tree a, tree b)
return (a == b || a == integer_zero_node); return (a == b || a == integer_zero_node);
} }
/* Record the current code position in GNAT_NODE. */
void
record_code_position (Node_Id gnat_node)
{
if (global_bindings_p ())
{
/* Make a dummy entry so multiple things at the same location don't
end up in the same place. */
add_pending_elaborations (NULL_TREE, NULL_TREE);
save_gnu_tree (gnat_node, get_elaboration_location (), 1);
}
else
/* Always emit another insn in case marking the last insn
addressable needs some fixups and also for above reason. */
save_gnu_tree (gnat_node,
build (RTL_EXPR, void_type_node, NULL_TREE,
(tree) emit_note (NOTE_INSN_DELETED), NULL_TREE),
1);
}
/* Insert the code for GNAT_NODE at the position saved for that node. */
void
insert_code_for (Node_Id gnat_node)
{
if (global_bindings_p ())
{
push_pending_elaborations ();
gnat_to_code (gnat_node);
Check_Elaboration_Code_Allowed (gnat_node);
insert_elaboration_list (get_gnu_tree (gnat_node));
pop_pending_elaborations ();
}
else
{
rtx insns;
do_pending_stack_adjust ();
start_sequence ();
mark_all_temps_used ();
gnat_to_code (gnat_node);
do_pending_stack_adjust ();
insns = get_insns ();
end_sequence ();
emit_insn_after (insns, RTL_EXPR_RTL (get_gnu_tree (gnat_node)));
}
}
/* Get the alias set corresponding to a type or expression. */ /* Get the alias set corresponding to a type or expression. */
static HOST_WIDE_INT static HOST_WIDE_INT

2085
gcc/ada/trans.c
View File

File diff suppressed because it is too large Load Diff

323
gcc/ada/utils.c
View File

@ -38,6 +38,10 @@
#include "convert.h" #include "convert.h"
#include "target.h" #include "target.h"
#include "function.h" #include "function.h"
#include "cgraph.h"
#include "tree-inline.h"
#include "tree-gimple.h"
#include "tree-dump.h"
#include "ada.h" #include "ada.h"
#include "types.h" #include "types.h"
@ -101,14 +105,8 @@ static GTY(()) tree signed_and_unsigned_types[2 * MAX_BITS_PER_WORD + 1][2];
/* Likewise for float types, but record these by mode. */ /* Likewise for float types, but record these by mode. */
static GTY(()) tree float_types[NUM_MACHINE_MODES]; static GTY(()) tree float_types[NUM_MACHINE_MODES];
/* For each binding contour we allocate a binding_level structure which records /* For each binding contour we allocate a binding_level structure to indicate
the entities defined or declared in that contour. Contours include: the binding depth. */
the global one
one for each subprogram definition
one for each compound statement (declare block)
Binding contours are used to create GCC tree BLOCK nodes. */
struct ada_binding_level GTY((chain_next ("%h.chain"))) struct ada_binding_level GTY((chain_next ("%h.chain")))
{ {
@ -116,6 +114,9 @@ struct ada_binding_level GTY((chain_next ("%h.chain")))
struct ada_binding_level *chain; struct ada_binding_level *chain;
/* The BLOCK node for this level. */ /* The BLOCK node for this level. */
tree block; tree block;
/* If nonzero, the setjmp buffer that needs to be updated for any
variable-sized definition within this context. */
tree jmpbuf_decl;
}; };
/* The binding level currently in effect. */ /* The binding level currently in effect. */
@ -132,10 +133,14 @@ struct language_function GTY(())
int unused; int unused;
}; };
static void gnat_define_builtin (const char *, tree, int, const char *, bool);
static void gnat_install_builtins (void);
static tree merge_sizes (tree, tree, tree, int, int); static tree merge_sizes (tree, tree, tree, int, int);
static tree compute_related_constant (tree, tree); static tree compute_related_constant (tree, tree);
static tree split_plus (tree, tree *); static tree split_plus (tree, tree *);
static int value_zerop (tree); static int value_zerop (tree);
static void gnat_gimplify_function (tree);
static void gnat_finalize (tree);
static tree float_type_for_precision (int, enum machine_mode); static tree float_type_for_precision (int, enum machine_mode);
static tree convert_to_fat_pointer (tree, tree); static tree convert_to_fat_pointer (tree, tree);
static tree convert_to_thin_pointer (tree, tree); static tree convert_to_thin_pointer (tree, tree);
@ -254,36 +259,37 @@ gnat_pushlevel ()
/* Add this level to the front of the chain (stack) of levels that are /* Add this level to the front of the chain (stack) of levels that are
active. */ active. */
newlevel->chain = current_binding_level; newlevel->chain = current_binding_level;
newlevel->jmpbuf_decl = NULL_TREE;
current_binding_level = newlevel; current_binding_level = newlevel;
} }
/* Exit a binding level. Return the BLOCK node, if any. */ /* Set the jmpbuf_decl for the current binding level to DECL. */
void
set_block_jmpbuf_decl (tree decl)
{
current_binding_level->jmpbuf_decl = decl;
}
/* Get the jmpbuf_decl, if any, for the current binding level. */
tree tree
get_block_jmpbuf_decl ()
{
return current_binding_level->jmpbuf_decl;
}
/* Exit a binding level. Set any BLOCK into the current code group. */
void
gnat_poplevel () gnat_poplevel ()
{ {
struct ada_binding_level *level = current_binding_level; struct ada_binding_level *level = current_binding_level;
tree block = level->block; tree block = level->block;
tree decl;
BLOCK_VARS (block) = nreverse (BLOCK_VARS (block)); BLOCK_VARS (block) = nreverse (BLOCK_VARS (block));
BLOCK_SUBBLOCKS (block) = nreverse (BLOCK_SUBBLOCKS (block)); BLOCK_SUBBLOCKS (block) = nreverse (BLOCK_SUBBLOCKS (block));
/* Output any nested inline functions within this block which must be
compiled because their address is needed. */
for (decl = BLOCK_VARS (block); decl; decl = TREE_CHAIN (decl))
if (TREE_CODE (decl) == FUNCTION_DECL
&& ! TREE_ASM_WRITTEN (decl) && TREE_ADDRESSABLE (decl)
&& DECL_INITIAL (decl) != 0)
{
push_function_context ();
/* ??? This is temporary. */
ggc_push_context ();
output_inline_function (decl);
ggc_pop_context ();
pop_function_context ();
}
/* If this is a function-level BLOCK don't do anything. Otherwise, if there /* If this is a function-level BLOCK don't do anything. Otherwise, if there
are no variables free the block and merge its subblocks into those of its are no variables free the block and merge its subblocks into those of its
parent block. Otherwise, add it to the list of its parent. */ parent block. Otherwise, add it to the list of its parent. */
@ -296,20 +302,19 @@ gnat_poplevel ()
BLOCK_SUBBLOCKS (level->chain->block)); BLOCK_SUBBLOCKS (level->chain->block));
TREE_CHAIN (block) = free_block_chain; TREE_CHAIN (block) = free_block_chain;
free_block_chain = block; free_block_chain = block;
block = NULL_TREE;
} }
else else
{ {
TREE_CHAIN (block) = BLOCK_SUBBLOCKS (level->chain->block); TREE_CHAIN (block) = BLOCK_SUBBLOCKS (level->chain->block);
BLOCK_SUBBLOCKS (level->chain->block) = block; BLOCK_SUBBLOCKS (level->chain->block) = block;
TREE_USED (block) = 1; TREE_USED (block) = 1;
set_block_for_group (block);
} }
/* Free this binding structure. */ /* Free this binding structure. */
current_binding_level = level->chain; current_binding_level = level->chain;
level->chain = free_binding_level; level->chain = free_binding_level;
free_binding_level = level; free_binding_level = level;
return block;
} }
/* Insert BLOCK at the end of the list of subblocks of the /* Insert BLOCK at the end of the list of subblocks of the
@ -400,7 +405,8 @@ gnat_init_decl_processing (void)
Pmode differ, C will use the width of ptr_mode as sizetype. But we get Pmode differ, C will use the width of ptr_mode as sizetype. But we get
far better code using the width of Pmode. Make this here since we need far better code using the width of Pmode. Make this here since we need
this before we can expand the GNAT types. */ this before we can expand the GNAT types. */
set_sizetype (gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0)); size_type_node = gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0);
set_sizetype (size_type_node);
build_common_tree_nodes_2 (0); build_common_tree_nodes_2 (0);
pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype)); pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype));
@ -414,8 +420,96 @@ gnat_init_decl_processing (void)
ptr_void_type_node = build_pointer_type (void_type_node); ptr_void_type_node = build_pointer_type (void_type_node);
gnat_install_builtins ();
} }
/* Define a builtin function. This is temporary and is just being done
to initialize implicit_built_in_decls for the middle-end. We'll want
to do full builtin processing soon. */
static void
gnat_define_builtin (const char *name, tree type,
int function_code, const char *library_name, bool const_p)
{
tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
DECL_EXTERNAL (decl) = 1;
TREE_PUBLIC (decl) = 1;
if (library_name)
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
make_decl_rtl (decl, NULL);
pushdecl (decl);
DECL_BUILT_IN_CLASS (decl) = BUILT_IN_NORMAL;
DECL_FUNCTION_CODE (decl) = function_code;
TREE_READONLY (decl) = const_p;
implicit_built_in_decls[function_code] = decl;
}
/* Install the builtin functions the middle-end needs. */
static void
gnat_install_builtins ()
{
tree ftype;
tree tmp;
tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
ftype = build_function_type (long_integer_type_node, tmp);
gnat_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
"__builtin_expect", true);
tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
ftype = build_function_type (ptr_void_type_node, tmp);
gnat_define_builtin ("__builtin_memcpy", ftype, BUILT_IN_MEMCPY,
"memcpy", false);
tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
ftype = build_function_type (integer_type_node, tmp);
gnat_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, "clz", true);
tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
ftype = build_function_type (integer_type_node, tmp);
gnat_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL, "clzl", true);
tmp = tree_cons (NULL_TREE, long_long_integer_type_node, void_list_node);
ftype = build_function_type (integer_type_node, tmp);
gnat_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL, "clzll",
true);
tmp = tree_cons (NULL_TREE, ptr_void_type_node, void_list_node);
tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
ftype = build_function_type (void_type_node, tmp);
gnat_define_builtin ("__builtin_init_trampoline", ftype,
BUILT_IN_INIT_TRAMPOLINE, "init_trampoline", false);
tmp = tree_cons (NULL_TREE, ptr_void_type_node, void_list_node);
ftype = build_function_type (ptr_void_type_node, tmp);
gnat_define_builtin ("__builtin_adjust_trampoline", ftype,
BUILT_IN_ADJUST_TRAMPOLINE, "adjust_trampoline", true);
tmp = tree_cons (NULL_TREE, ptr_void_type_node, void_list_node);
tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
ftype = build_function_type (ptr_void_type_node, tmp);
gnat_define_builtin ("__builtin_stack_alloc", ftype, BUILT_IN_STACK_ALLOC,
"stack_alloc", false);
/* The stack_save and stack_restore builtins aren't used directly. They
are inserted during gimplification to implement stack_alloc calls. */
ftype = build_function_type (ptr_void_type_node, void_list_node);
gnat_define_builtin ("__builtin_stack_save", ftype, BUILT_IN_STACK_SAVE,
"stack_save", false);
tmp = tree_cons (NULL_TREE, ptr_void_type_node, void_list_node);
ftype = build_function_type (void_type_node, tmp);
gnat_define_builtin ("__builtin_stack_restore", ftype,
BUILT_IN_STACK_RESTORE, "stack_restore", false);
}
/* Create the predefined scalar types such as `integer_type_node' needed /* Create the predefined scalar types such as `integer_type_node' needed
in the gcc back-end and initialize the global binding level. */ in the gcc back-end and initialize the global binding level. */
@ -1229,13 +1323,11 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
? CONST_DECL : VAR_DECL, var_name, type); ? CONST_DECL : VAR_DECL, var_name, type);
/* If this is external, throw away any initializations unless this is a /* If this is external, throw away any initializations unless this is a
CONST_DECL (meaning we have a constant); they will be done elsewhere. If CONST_DECL (meaning we have a constant); they will be done elsewhere.
we are defining a global here, leave a constant initialization and save If we are defining a global here, leave a constant initialization and
any variable elaborations for the elaboration routine. Otherwise, if save any variable elaborations for the elaboration routine. If we are
the initializing expression is not the same as TYPE, generate the just annotating types, throw away the initialization if it isn't a
initialization with an assignment statement, since it knows how constant. */
to do the required adjustents. If we are just annotating types,
throw away the initialization if it isn't a constant. */
if ((extern_flag && TREE_CODE (var_decl) != CONST_DECL) if ((extern_flag && TREE_CODE (var_decl) != CONST_DECL)
|| (type_annotate_only && var_init != 0 && ! TREE_CONSTANT (var_init))) || (type_annotate_only && var_init != 0 && ! TREE_CONSTANT (var_init)))
@ -1247,12 +1339,6 @@ create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
var_init = 0; var_init = 0;
} }
else if (var_init != 0
&& ((TYPE_MAIN_VARIANT (TREE_TYPE (var_init))
!= TYPE_MAIN_VARIANT (type))
|| (static_flag && ! init_const)))
DECL_INIT_BY_ASSIGN_P (var_decl) = 1;
DECL_INITIAL (var_decl) = var_init; DECL_INITIAL (var_decl) = var_init;
TREE_READONLY (var_decl) = const_flag; TREE_READONLY (var_decl) = const_flag;
DECL_EXTERNAL (var_decl) = extern_flag; DECL_EXTERNAL (var_decl) = extern_flag;
@ -1703,13 +1789,16 @@ create_subprog_decl (tree subprog_name,
DECL_EXTERNAL (subprog_decl) = extern_flag; DECL_EXTERNAL (subprog_decl) = extern_flag;
TREE_PUBLIC (subprog_decl) = public_flag; TREE_PUBLIC (subprog_decl) = public_flag;
DECL_INLINE (subprog_decl) = inline_flag; TREE_STATIC (subprog_decl) = 1;
TREE_READONLY (subprog_decl) = TYPE_READONLY (subprog_type); TREE_READONLY (subprog_decl) = TYPE_READONLY (subprog_type);
TREE_THIS_VOLATILE (subprog_decl) = TYPE_VOLATILE (subprog_type); TREE_THIS_VOLATILE (subprog_decl) = TYPE_VOLATILE (subprog_type);
TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (subprog_type); TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (subprog_type);
DECL_ARGUMENTS (subprog_decl) = param_decl_list; DECL_ARGUMENTS (subprog_decl) = param_decl_list;
DECL_RESULT (subprog_decl) = build_decl (RESULT_DECL, 0, return_type); DECL_RESULT (subprog_decl) = build_decl (RESULT_DECL, 0, return_type);
if (inline_flag)
DECL_DECLARED_INLINE_P (subprog_decl) = 1;
if (asm_name != 0) if (asm_name != 0)
SET_DECL_ASSEMBLER_NAME (subprog_decl, asm_name); SET_DECL_ASSEMBLER_NAME (subprog_decl, asm_name);
@ -1763,95 +1852,93 @@ begin_subprog_body (tree subprog_decl)
init_function_start (subprog_decl); init_function_start (subprog_decl);
expand_function_start (subprog_decl, 0); expand_function_start (subprog_decl, 0);
/* If this function is `main', emit a call to `__main'
to run global initializers, etc. */
if (DECL_ASSEMBLER_NAME (subprog_decl) != 0
&& MAIN_NAME_P (DECL_ASSEMBLER_NAME (subprog_decl))
&& DECL_CONTEXT (subprog_decl) == NULL_TREE)
expand_main_function ();
} }
/* Finish the definition of the current subprogram and compile it all the way /* Finish the definition of the current subprogram and compile it all the way
to assembler language output. */ to assembler language output. BODY is the tree corresponding to
the subprogram. */
void void
end_subprog_body (void) end_subprog_body (tree body)
{ {
tree decl; tree fndecl = current_function_decl;
tree cico_list;
/* Mark the BLOCK for this level as being for this function and pop the /* Mark the BLOCK for this level as being for this function and pop the
level. Since the vars in it are the parameters, clear them. */ level. Since the vars in it are the parameters, clear them. */
BLOCK_VARS (current_binding_level->block) = 0; BLOCK_VARS (current_binding_level->block) = 0;
BLOCK_SUPERCONTEXT (current_binding_level->block) = current_function_decl; BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
DECL_INITIAL (current_function_decl) = current_binding_level->block; DECL_INITIAL (fndecl) = current_binding_level->block;
gnat_poplevel (); gnat_poplevel ();
/* Deal with inline. If declared inline or we should default to inline,
set the flag in the decl. */
DECL_INLINE (fndecl)
= DECL_DECLARED_INLINE_P (fndecl) || flag_inline_trees == 2;
/* Initialize the RTL code for the function. */
allocate_struct_function (fndecl);
/* We handle pending sizes via the elaboration of types, so we don't
need to save them. */
get_pending_sizes ();
/* Mark the RESULT_DECL as being in this subprogram. */ /* Mark the RESULT_DECL as being in this subprogram. */
DECL_CONTEXT (DECL_RESULT (current_function_decl)) = current_function_decl; DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
expand_function_end (); DECL_SAVED_TREE (fndecl) = body;
/* If this is a nested function, push a new GC context. That will keep current_function_decl = DECL_CONTEXT (fndecl);
local variables on the stack from being collected while we're doing
the compilation of this function. */
if (function_nesting_depth > 1)
ggc_push_context ();
/* If we're only annotating types, don't actually compile this /* If we're only annotating types, don't actually compile this function. */
function. */ if (type_annotate_only)
if (!type_annotate_only) return;
/* We do different things for nested and non-nested functions.
??? This should be in cgraph. */
if (!DECL_CONTEXT (fndecl))
{ {
rest_of_compilation (current_function_decl); gnat_gimplify_function (fndecl);
if (! DECL_DEFER_OUTPUT (current_function_decl)) lower_nested_functions (fndecl);
{ gnat_finalize (fndecl);
free_after_compilation (cfun);
DECL_STRUCT_FUNCTION (current_function_decl) = 0;
}
cfun = 0;
} }
if (function_nesting_depth > 1)
ggc_pop_context ();
/* Throw away any VAR_DECLs we made for OUT parameters; they must
not be seen when we call this function and will be in
unallocated memory anyway. */
for (cico_list = TYPE_CI_CO_LIST (TREE_TYPE (current_function_decl));
cico_list != 0; cico_list = TREE_CHAIN (cico_list))
TREE_VALUE (cico_list) = 0;
if (DECL_STRUCT_FUNCTION (current_function_decl) == 0)
{
/* Throw away DECL_RTL in any PARM_DECLs unless this function
was saved for inline, in which case the DECL_RTLs are in
preserved memory. */
for (decl = DECL_ARGUMENTS (current_function_decl);
decl != 0; decl = TREE_CHAIN (decl))
{
SET_DECL_RTL (decl, 0);
DECL_INCOMING_RTL (decl) = 0;
}
/* Similarly, discard DECL_RTL of the return value. */
SET_DECL_RTL (DECL_RESULT (current_function_decl), 0);
/* But DECL_INITIAL must remain nonzero so we know this
was an actual function definition unless toplev.c decided not
to inline it. */
if (DECL_INITIAL (current_function_decl) != 0)
DECL_INITIAL (current_function_decl) = error_mark_node;
DECL_ARGUMENTS (current_function_decl) = 0;
}
/* If we are not at the bottom of the function nesting stack, pop up to
the containing function. Otherwise show we aren't in any function. */
if (--function_nesting_depth != 0)
pop_function_context ();
else else
current_function_decl = 0; /* Register this function with cgraph just far enough to get it
added to our parent's nested function list. */
(void) cgraph_node (fndecl);
}
/* Convert FNDECL's code to GIMPLE and handle any nested functions. */
static void
gnat_gimplify_function (tree fndecl)
{
struct cgraph_node *cgn;
dump_function (TDI_original, fndecl);
gimplify_function_tree (fndecl);
dump_function (TDI_generic, fndecl);
/* Convert all nested functions to GIMPLE now. We do things in this order
so that items like VLA sizes are expanded properly in the context of the
correct function. */
cgn = cgraph_node (fndecl);
for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested)
gnat_gimplify_function (cgn->decl);
}
/* Give FNDECL and all its nested functions to cgraph for compilation. */
static void
gnat_finalize (tree fndecl)
{
struct cgraph_node *cgn;
/* Finalize all nested functions now. */
cgn = cgraph_node (fndecl);
for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested)
gnat_finalize (cgn->decl);
cgraph_finalize_function (fndecl, false);
} }
/* Return a definition for a builtin function named NAME and whose data type /* Return a definition for a builtin function named NAME and whose data type
@ -2824,7 +2911,7 @@ convert (tree type, tree expr)
/* If the input is a biased type, adjust first. */ /* If the input is a biased type, adjust first. */
if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype)) if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype))
return convert (type, fold (build (PLUS_EXPR, TREE_TYPE (etype), return convert (type, fold (build (PLUS_EXPR, TREE_TYPE (etype),
fold (build1 (GNAT_NOP_EXPR, fold (build1 (NOP_EXPR,
TREE_TYPE (etype), expr)), TREE_TYPE (etype), expr)),
TYPE_MIN_VALUE (etype)))); TYPE_MIN_VALUE (etype))));
@ -2864,7 +2951,6 @@ convert (tree type, tree expr)
case ERROR_MARK: case ERROR_MARK:
return expr; return expr;
case TRANSFORM_EXPR:
case NULL_EXPR: case NULL_EXPR:
/* Just set its type here. For TRANSFORM_EXPR, we will do the actual /* Just set its type here. For TRANSFORM_EXPR, we will do the actual
conversion in gnat_expand_expr. NULL_EXPR does not represent conversion in gnat_expand_expr. NULL_EXPR does not represent
@ -2959,6 +3045,9 @@ convert (tree type, tree expr)
case VOID_TYPE: case VOID_TYPE:
return build1 (CONVERT_EXPR, type, expr); return build1 (CONVERT_EXPR, type, expr);
case BOOLEAN_TYPE:
return fold (build1 (NOP_EXPR, type, gnat_truthvalue_conversion (expr)));
case INTEGER_TYPE: case INTEGER_TYPE:
if (TYPE_HAS_ACTUAL_BOUNDS_P (type) if (TYPE_HAS_ACTUAL_BOUNDS_P (type)
&& (ecode == ARRAY_TYPE || ecode == UNCONSTRAINED_ARRAY_TYPE && (ecode == ARRAY_TYPE || ecode == UNCONSTRAINED_ARRAY_TYPE
@ -3106,7 +3195,7 @@ remove_conversions (tree exp, int true_address)
break; break;
case VIEW_CONVERT_EXPR: case NON_LVALUE_EXPR: case VIEW_CONVERT_EXPR: case NON_LVALUE_EXPR:
case NOP_EXPR: case CONVERT_EXPR: case GNAT_NOP_EXPR: case NOP_EXPR: case CONVERT_EXPR:
return remove_conversions (TREE_OPERAND (exp, 0), true_address); return remove_conversions (TREE_OPERAND (exp, 0), true_address);
default: default:
@ -3209,7 +3298,7 @@ unchecked_convert (tree type, tree expr, int notrunc_p)
TYPE_BIASED_REPRESENTATION_P (ntype) = 0; TYPE_BIASED_REPRESENTATION_P (ntype) = 0;
TYPE_MAIN_VARIANT (ntype) = ntype; TYPE_MAIN_VARIANT (ntype) = ntype;
expr = build1 (GNAT_NOP_EXPR, ntype, expr); expr = build1 (NOP_EXPR, ntype, expr);
} }
if (TREE_CODE (type) == INTEGER_TYPE if (TREE_CODE (type) == INTEGER_TYPE
@ -3222,7 +3311,7 @@ unchecked_convert (tree type, tree expr, int notrunc_p)
expr = convert (rtype, expr); expr = convert (rtype, expr);
if (type != rtype) if (type != rtype)
expr = build1 (GNAT_NOP_EXPR, type, expr); expr = build1 (NOP_EXPR, type, expr);
} }
/* If we are converting TO an integral type whose precision is not the /* If we are converting TO an integral type whose precision is not the

38
gcc/ada/utils2.c
View File

@ -29,6 +29,7 @@
#include "coretypes.h" #include "coretypes.h"
#include "tm.h" #include "tm.h"
#include "tree.h" #include "tree.h"
#include "rtl.h"
#include "flags.h" #include "flags.h"
#include "output.h" #include "output.h"
#include "ada.h" #include "ada.h"
@ -1345,23 +1346,20 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
/* Similar, but for COND_EXPR. */ /* Similar, but for COND_EXPR. */
tree tree
build_cond_expr (tree result_type, build_cond_expr (tree result_type, tree condition_operand,
tree condition_operand, tree true_operand, tree false_operand)
tree true_operand,
tree false_operand)
{ {
tree result; tree result;
int addr_p = 0; int addr_p = 0;
/* Front-end verifies that result, true and false operands have same base /* The front-end verifies that result, true and false operands have same base
type. Convert everything to the result type. */ type. Convert everything to the result type. */
true_operand = convert (result_type, true_operand); true_operand = convert (result_type, true_operand);
false_operand = convert (result_type, false_operand); false_operand = convert (result_type, false_operand);
/* If the result type is unconstrained, take the address of /* If the result type is unconstrained, take the address of
the operands and then dereference our result. */ the operands and then dereference our result. */
if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE
|| CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type))) || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type)))
{ {
@ -1450,7 +1448,7 @@ tree
build_call_raise (int msg) build_call_raise (int msg)
{ {
tree fndecl = gnat_raise_decls[msg]; tree fndecl = gnat_raise_decls[msg];
const char *str = discard_file_names ? "" : ref_filename; const char *str = Debug_Flag_NN ? "" : ref_filename;
int len = strlen (str) + 1; int len = strlen (str) + 1;
tree filename = build_string (len, str); tree filename = build_string (len, str);
@ -1743,7 +1741,11 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align,
else if (gnu_obj) else if (gnu_obj)
return build_call_1_expr (free_decl, gnu_obj); return build_call_1_expr (free_decl, gnu_obj);
else if (gnat_pool == -1)
/* ??? For now, disable variable-sized allocators in the stack since
we can't yet gimplify an ALLOCATE_EXPR. */
else if (gnat_pool == -1
&& TREE_CODE (gnu_size) == INTEGER_CST && !flag_stack_check)
{ {
/* If the size is a constant, we can put it in the fixed portion of /* If the size is a constant, we can put it in the fixed portion of
the stack frame to avoid the need to adjust the stack pointer. */ the stack frame to avoid the need to adjust the stack pointer. */
@ -1760,7 +1762,10 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align,
build_unary_op (ADDR_EXPR, NULL_TREE, gnu_decl)); build_unary_op (ADDR_EXPR, NULL_TREE, gnu_decl));
} }
else else
abort ();
#if 0
return build (ALLOCATE_EXPR, ptr_void_type_node, gnu_size, gnu_align); return build (ALLOCATE_EXPR, ptr_void_type_node, gnu_size, gnu_align);
#endif
} }
else else
{ {
@ -1977,7 +1982,6 @@ gnat_mark_addressable (tree expr_node)
case VIEW_CONVERT_EXPR: case VIEW_CONVERT_EXPR:
case CONVERT_EXPR: case CONVERT_EXPR:
case NON_LVALUE_EXPR: case NON_LVALUE_EXPR:
case GNAT_NOP_EXPR:
case NOP_EXPR: case NOP_EXPR:
expr_node = TREE_OPERAND (expr_node, 0); expr_node = TREE_OPERAND (expr_node, 0);
break; break;
@ -1989,7 +1993,19 @@ gnat_mark_addressable (tree expr_node)
case VAR_DECL: case VAR_DECL:
case PARM_DECL: case PARM_DECL:
case RESULT_DECL: case RESULT_DECL:
put_var_into_stack (expr_node, true); /* If we have already made a REG for this decl, we must put it
directly into the stack. Likewise for a MEM whose address is a
pseudo. Otherwise, set a flag to mark us to do it later. */
if (DECL_RTL_SET_P (expr_node)
&& (GET_CODE (DECL_RTL (expr_node)) == REG
|| (GET_CODE (DECL_RTL (expr_node)) == MEM
&& GET_CODE (XEXP (DECL_RTL (expr_node), 0)) == REG
&& (REGNO (XEXP (DECL_RTL (expr_node), 0))
> LAST_VIRTUAL_REGISTER))))
put_var_into_stack (expr_node, 1);
else
TREE_ADDRESSABLE (expr_node) = 1;
return true; return true;
case FUNCTION_DECL: case FUNCTION_DECL: