This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
First cut for tree-ssa for Ada
- From: kenner at vlsi1 dot ultra dot nyu dot edu (Richard Kenner)
- To: gcc-patches at gcc dot gnu dot org
- Date: Mon, 7 Jun 04 17:09:26 EDT
- Subject: First cut for tree-ssa for Ada
This patch is not only NOT TESTED, but DOESN'T WORK. However since the
Ada compiler didn't previously even BUILD, but now does, it's a major
improvement.
I'm checking it in now to get these changes out of my tree, to let people
see how this conversion has been going, and to allow tree-ssa folks to be able
to look at the various problems that have been coming up.
The following is NOT working:
(1) Library-level variables are dubious, but elaboration routines
have been disabled.
(2) Anything of variable size will probably ICE due to the problems
that have been discussed.
(3) No code has been executed. I've spot-checked assembly output to
the extent that it looks right to me, but that's all.
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.
*** ada-tree.def 27 May 2004 22:40:52 -0000 1.3.6.12
--- ada-tree.def 7 Jun 2004 14:46:55 -0000
***************
*** 25,43 ****
****************************************************************************/
- /* 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
to GCC. TREE_TYPE is the type of the fat pointer and TYPE_OBJECT_RECORD_TYPE
--- 25,28 ----
*************** DEFTREECODE (UNCONSTRAINED_ARRAY_REF, "u
*** 55,65 ****
/* An expression that returns an RTL suitable for its type. Operand 0
is an expression to be evaluated for side effects only. */
-
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,
return the address of the byte containing the bit. This is used
--- 40,45 ----
*************** DEFTREECODE (USE_EXPR, "use_expr", 'e',
*** 67,123 ****
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
! must be at the end of this file to allow IS_STMT to work.
!
! We start with an expression statement, whose only operand is an
! 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)
! /* This represents a list of statements. BLOCK_STMT_LIST is a list
! statement tree, chained via TREE_CHAIN. BLOCK_STMT_BLOCK, if nonzero,
! is the BLOCK node for these statements. */
! DEFTREECODE (BLOCK_STMT, "block_stmt", 's', 2)
!
! /* This is an IF statement. IF_STMT_COND is the condition being tested,
! IF_STMT_TRUE is the statement to be executed if the condition is
! true; IF_STMT_ELSEIF, if non-null, is a list of more IF_STMT nodes (where
! we only look at IF_STMT_COND and IF_STMT_TRUE) that correspond to
! any "else if" parts; and IF_STMT_ELSE is the statement to be executed if
! all conditions are. */
! DEFTREECODE (IF_STMT, "if_stmt", 's', 4)
!
! /* A goto just points to the label: GOTO_STMT_LABEL. */
! DEFTREECODE (GOTO_STMT, "goto_stmt", 's', 1)
!
! /* A label: LABEL_STMT_LABEL is the label. */
! DEFTREECODE (LABEL_STMT, "label_stmt", 's', 1)
!
! /* A "return". RETURN_STMT_EXPR is the value to return if non-null. */
! DEFTREECODE (RETURN_STMT, "return_stmt", 's', 1)
!
! /* An "asm" statement. The operands are ASM_STMT_TEMPLATE, ASM_STMT_OUTPUT,
! ASM_STMT_ORIG_OUT, ASM_STMT_INPUT, and ASM_STMT_CLOBBER. */
! DEFTREECODE (ASM_STMT, "asm_stmt", 's', 5)
- /* An analog to the C "break" statement. */
- DEFTREECODE (BREAK_STMT, "break_stmt", 's', 0)
--- 47,88 ----
DEFTREECODE (ATTR_ADDR_EXPR, "attr_addr_expr", 'r', 1)
/* Here are the tree codes for the statement types known to Ada. These
! must be at the end of this file to allow IS_ADA_STMT to work. */
! /* This defines the variable in DECL_STMT_VAR. */
DEFTREECODE (DECL_STMT, "decl_stmt", 's', 1)
! /* This is how record_code_position and insert_code_for work. The former
! makes this tree node, whose operand is a statement. The latter inserts
! the actual statements into this node. Gimplification consists of
! just returning the inner statement. */
! DEFTREECODE (STMT_STMT, "stmt_stmt", 's', 1)
!
! /* A loop. LOOP_STMT_TOP_COND and LOOP_STMT_BOT_COND are the tests to exit a
! loop at the top and bottom, respectively. LOOP_STMT_UPDATE is the statement
! to update the loop iterator at the continue point. LOOP_STMT_BODY are the
! statements in the body of the loop. LOOP_STMT_LABEL is used during
! gimplification to point to the LABEL_DECL of the end label of the loop. */
! DEFTREECODE (LOOP_STMT, "loop_stmt", 's', 5)
!
! /* Conditionally exit a loop. EXIT_STMT_COND is the condition, which, if
! 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 exception region. REGION_STMT_BODY is the statement to be executed
! 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)
!
! /* An exception handler. HANDLER_STMT_ARG is the value to pass to
! 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)
!
! /* A statement that emits a USE for its single operand. */
! DEFTREECODE (USE_STMT, "use_expr", 's', 1)
*** ada-tree.h 27 May 2004 22:41:48 -0000 1.3.4.12
--- ada-tree.h 7 Jun 2004 14:47:00 -0000
*************** enum gnat_tree_code {
*** 34,66 ****
#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. */
! struct lang_decl GTY(())
! {
! union lang_tree_node
! 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. */
--- 34,41 ----
#undef DEFTREECODE
/* Ada uses the lang_decl and lang_type fields to hold more trees. */
! union lang_tree_node GTY((desc ("0"))) {union tree_node GTY((tag ("0"))) t; };
! struct lang_decl GTY(()) {union lang_tree_node t; };
! struct lang_type GTY(()) {union lang_tree_node t; };
/* Flags added to GCC type nodes. */
*************** struct lang_type GTY(())
*** 165,169 ****
cico parameter passing mechanism refer to the routine gnat_to_gnu_entity. */
#define TYPE_CI_CO_LIST(NODE) \
! (&TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE))->t.generic)
#define SET_TYPE_CI_CO_LIST(NODE, X) \
(TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
--- 140,144 ----
cico parameter passing mechanism refer to the routine gnat_to_gnu_entity. */
#define TYPE_CI_CO_LIST(NODE) \
! (&TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_CI_CO_LIST(NODE, X) \
(TYPE_LANG_SPECIFIC (FUNCTION_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
*************** struct lang_type GTY(())
*** 172,176 ****
modulus. */
#define TYPE_MODULUS(NODE) \
! (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic)
#define SET_TYPE_MODULUS(NODE, X) \
(TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
--- 147,151 ----
modulus. */
#define TYPE_MODULUS(NODE) \
! (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_MODULUS(NODE, X) \
(TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
*************** struct lang_type GTY(())
*** 179,183 ****
the type corresponding to the Ada index type. */
#define TYPE_INDEX_TYPE(NODE) \
! (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic)
#define SET_TYPE_INDEX_TYPE(NODE, X) \
(TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X))
--- 154,158 ----
the type corresponding to the Ada index type. */
#define TYPE_INDEX_TYPE(NODE) \
! (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_INDEX_TYPE(NODE, X) \
(TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X))
*************** struct lang_type GTY(())
*** 186,190 ****
Digits_Value. */
#define TYPE_DIGITS_VALUE(NODE) \
! (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.generic)
#define SET_TYPE_DIGITS_VALUE(NODE, X) \
(TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X))
--- 161,165 ----
Digits_Value. */
#define TYPE_DIGITS_VALUE(NODE) \
! (&TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_DIGITS_VALUE(NODE, X) \
(TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE)) = (struct lang_type *) (X))
*************** struct lang_type GTY(())
*** 195,199 ****
/* Likewise for ENUMERAL_TYPE. */
#define TYPE_RM_SIZE_ENUM(NODE) \
! (&TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE))->t.generic)
#define SET_TYPE_RM_SIZE_ENUM(NODE, X) \
(TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
--- 170,174 ----
/* Likewise for ENUMERAL_TYPE. */
#define TYPE_RM_SIZE_ENUM(NODE) \
! (&TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_RM_SIZE_ENUM(NODE, X) \
(TYPE_LANG_SPECIFIC (ENUMERAL_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
*************** struct lang_type GTY(())
*** 208,212 ****
to by a thin pointer. */
#define TYPE_UNCONSTRAINED_ARRAY(NODE) \
! (&TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE))->t.generic)
#define SET_TYPE_UNCONSTRAINED_ARRAY(NODE, X) \
(TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
--- 183,187 ----
to by a thin pointer. */
#define TYPE_UNCONSTRAINED_ARRAY(NODE) \
! (&TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE))->t.t)
#define SET_TYPE_UNCONSTRAINED_ARRAY(NODE, X) \
(TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE)) = (struct lang_type *)(X))
*************** struct lang_type GTY(())
*** 215,219 ****
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. */
! #define TYPE_ADA_SIZE(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.generic)
#define SET_TYPE_ADA_SIZE(NODE, X) \
(TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X))
--- 190,194 ----
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. */
! #define TYPE_ADA_SIZE(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.t)
#define SET_TYPE_ADA_SIZE(NODE, X) \
(TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X))
*************** struct lang_type GTY(())
*** 222,226 ****
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. */
! #define TYPE_ACTUAL_BOUNDS(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.generic)
#define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \
(TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X))
--- 197,201 ----
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. */
! #define TYPE_ACTUAL_BOUNDS(NODE) (&TYPE_LANG_SPECIFIC (NODE)->t.t)
#define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \
(TYPE_LANG_SPECIFIC (NODE) = (struct lang_type *)(X))
*************** struct lang_type GTY(())
*** 239,245 ****
#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
is needed to access the object. */
--- 214,217 ----
*************** struct lang_type GTY(())
*** 271,275 ****
address taken. */
#define DECL_CONST_CORRESPONDING_VAR(NODE) \
! (&DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE))->t.generic)
#define SET_DECL_CONST_CORRESPONDING_VAR(NODE, X) \
(DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE)) = (struct lang_decl *)(X))
--- 243,247 ----
address taken. */
#define DECL_CONST_CORRESPONDING_VAR(NODE) \
! (&DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE))->t.t)
#define SET_DECL_CONST_CORRESPONDING_VAR(NODE, X) \
(DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE)) = (struct lang_decl *)(X))
*************** struct lang_type GTY(())
*** 278,282 ****
source of the decl. */
#define DECL_ORIGINAL_FIELD(NODE) \
! (&DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE))->t.generic)
#define SET_DECL_ORIGINAL_FIELD(NODE, X) \
(DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE)) = (struct lang_decl *)(X))
--- 250,254 ----
source of the decl. */
#define DECL_ORIGINAL_FIELD(NODE) \
! (&DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE))->t.t)
#define SET_DECL_ORIGINAL_FIELD(NODE, X) \
(DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE)) = (struct lang_decl *)(X))
*************** struct lang_type GTY(())
*** 286,315 ****
#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.
Start by defining which tree codes are used for statements. */
#define IS_STMT(NODE) (TREE_CODE_CLASS (TREE_CODE (NODE)) == 's')
- /* 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 BLOCK_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, BLOCK_STMT, 0)
! #define BLOCK_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, BLOCK_STMT, 1)
! #define IF_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 0)
! #define IF_STMT_TRUE(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 1)
! #define IF_STMT_ELSEIF(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 2)
! #define IF_STMT_ELSE(NODE) TREE_OPERAND_CHECK_CODE (NODE, IF_STMT, 3)
! #define GOTO_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, GOTO_STMT, 0)
! #define LABEL_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, LABEL_STMT, 0)
! #define RETURN_STMT_EXPR(NODE) TREE_OPERAND_CHECK_CODE (NODE, RETURN_STMT, 0)
! #define ASM_STMT_TEMPLATE(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 0)
! #define ASM_STMT_OUTPUT(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 1)
! #define ASM_STMT_ORIG_OUT(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 2)
! #define ASM_STMT_INPUT(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 3)
! #define ASM_STMT_CLOBBER(NODE) TREE_OPERAND_CHECK_CODE (NODE, ASM_STMT, 4)
--- 258,281 ----
#define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))
/* Define fields and macros 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_ADA_STMT(NODE) (IS_STMT (NODE) \
+ && TREE_CODE (NODE) >= DECL_STMT)
#define DECL_STMT_VAR(NODE) TREE_OPERAND_CHECK_CODE (NODE, DECL_STMT, 0)
! #define STMT_STMT_STMT(NODE) TREE_OPERAND_CHECK_CODE (NODE, STMT_STMT, 0)
! #define LOOP_STMT_TOP_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 0)
! #define LOOP_STMT_BOT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 1)
! #define LOOP_STMT_UPDATE(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 2)
! #define LOOP_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 3)
! #define LOOP_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 4)
! #define EXIT_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 0)
! #define EXIT_STMT_LOOP(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 1)
! #define REGION_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 0)
! #define REGION_STMT_HANDLE(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 1)
! #define REGION_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 2)
! #define HANDLER_STMT_ARG(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 0)
! #define HANDLER_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 1)
! #define HANDLER_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 2)
--- decl.c 7 Jun 2004 14:47:06 -0000
*************** static tree make_type_from_size (tree, t
*** 103,106 ****
--- 103,107 ----
static unsigned int validate_alignment (Uint, Entity_Id, unsigned 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
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 280,286 ****
/* 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. */
-
gnu_entity_id = get_entity_name (gnat_entity);
! set_lineno (gnat_entity, 0);
/* If we get here, it means we have not yet done anything with this
--- 281,286 ----
/* 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. */
gnu_entity_id = get_entity_name (gnat_entity);
! Sloc_to_locus (Sloc (gnat_entity), &input_location);
/* If we get here, it means we have not yet done anything with this
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 768,779 ****
&& ! TREE_SIDE_EFFECTS (gnu_expr))))
{
- set_lineno (gnat_entity, ! global_bindings_p ());
gnu_decl = gnat_stabilize_reference (gnu_expr, 1);
save_gnu_tree (gnat_entity, gnu_decl, 1);
saved = 1;
-
- if (! global_bindings_p ())
- expand_expr_stmt (build1 (CONVERT_EXPR, void_type_node,
- gnu_decl));
break;
}
--- 768,774 ----
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 956,973 ****
tree gnu_new_var;
- set_lineno (gnat_entity, 1);
gnu_new_var
= create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
NULL_TREE, gnu_new_type, gnu_expr,
0, 0, 0, 0, 0);
add_decl_stmt (gnu_new_var, gnat_entity);
if (gnu_expr != 0)
! expand_expr_stmt
! (build_binary_op
! (MODIFY_EXPR, NULL_TREE,
! build_component_ref (gnu_new_var, NULL_TREE,
! TYPE_FIELDS (gnu_new_type), 0),
! gnu_expr));
gnu_type = build_reference_type (gnu_type);
--- 951,969 ----
tree gnu_new_var;
gnu_new_var
= create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
NULL_TREE, gnu_new_type, gnu_expr,
0, 0, 0, 0, 0);
+ annotate_decl_with_node (gnu_new_var, gnat_entity);
add_decl_stmt (gnu_new_var, gnat_entity);
if (gnu_expr != 0)
! add_stmt_with_node
! (build_binary_op (MODIFY_EXPR, NULL_TREE,
! build_component_ref
! (gnu_new_var, NULL_TREE,
! TYPE_FIELDS (gnu_new_type), 0),
! gnu_expr),
! gnat_entity);
gnu_type = build_reference_type (gnu_type);
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1025,1029 ****
static_p = 1;
- set_lineno (gnat_entity, ! global_bindings_p ());
gnu_decl = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
gnu_expr, const_flag,
--- 1021,1024 ----
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1031,1035 ****
imported_p || !definition,
static_p, attr_list);
!
DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
--- 1026,1030 ----
imported_p || !definition,
static_p, attr_list);
! annotate_decl_with_node (gnu_decl, gnat_entity);
DECL_BY_REF_P (gnu_decl) = used_by_ref;
DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1046,1068 ****
if (definition && DECL_SIZE (gnu_decl) != 0
! && gnu_block_stack != 0
! && TREE_VALUE (gnu_block_stack) != 0
&& (TREE_CODE (DECL_SIZE (gnu_decl)) != INTEGER_CST
|| (flag_stack_check && ! STACK_CHECK_BUILTIN
&& 0 < compare_tree_int (DECL_SIZE_UNIT (gnu_decl),
STACK_CHECK_MAX_VAR_SIZE))))
! {
! tree gnu_stmt
! = build_nt (EXPR_STMT,
! (build_call_1_expr
! (update_setjmp_buf_decl,
! 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
--- 1041,1054 ----
if (definition && DECL_SIZE (gnu_decl) != 0
! && get_block_jmpbuf_decl ()
&& (TREE_CODE (DECL_SIZE (gnu_decl)) != INTEGER_CST
|| (flag_stack_check && ! STACK_CHECK_BUILTIN
&& 0 < compare_tree_int (DECL_SIZE_UNIT (gnu_decl),
STACK_CHECK_MAX_VAR_SIZE))))
! add_stmt_with_node (build_call_1_expr
! (update_setjmp_buf_decl,
! build_unary_op (ADDR_EXPR, NULL_TREE,
! get_block_jmpbuf_decl ())),
! gnat_entity);
/* If this is a public constant or we're not optimizing and we're not
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1528,1532 ****
type and then make extractions of that field from the
template. */
- set_lineno (gnat_entity, 0);
sprintf (field_name, "LB%d", index);
gnu_min_field = create_field_decl (get_identifier (field_name),
--- 1514,1517 ----
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1538,1541 ****
--- 1523,1528 ----
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);
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2063,2074 ****
/* First finish the type we had been making so that we output
debugging information for it */
! gnu_type = build_qualified_type (gnu_type,
! (TYPE_QUALS (gnu_type)
! | (TYPE_QUAL_VOLATILE
! * Treat_As_Volatile (gnat_entity))));
! set_lineno (gnat_entity, 0);
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
debug_info_p);
if (! Comes_From_Source (gnat_entity))
DECL_ARTIFICIAL (gnu_decl) = 1;
--- 2050,2062 ----
/* First finish the type we had been making so that we output
debugging information for it */
! gnu_type
! = build_qualified_type (gnu_type,
! (TYPE_QUALS (gnu_type)
! | (TYPE_QUAL_VOLATILE
! * Treat_As_Volatile (gnat_entity))));
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
debug_info_p);
+ annotate_decl_with_node (gnu_decl, gnat_entity);
if (! Comes_From_Source (gnat_entity))
DECL_ARTIFICIAL (gnu_decl) = 1;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2129,2140 ****
for (gnat_index = First_Index (gnat_entity);
Present (gnat_index); gnat_index = Next_Index (gnat_index))
! SET_TYPE_ACTUAL_BOUNDS (gnu_inner_type,
! tree_cons (NULL_TREE,
! get_unpadded_type (Etype (gnat_index)),
! TYPE_ACTUAL_BOUNDS (gnu_inner_type)));
if (Convention (gnat_entity) != Convention_Fortran)
! SET_TYPE_ACTUAL_BOUNDS (gnu_inner_type,
! nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type)));
if (TREE_CODE (gnu_type) == RECORD_TYPE
--- 2117,2130 ----
for (gnat_index = First_Index (gnat_entity);
Present (gnat_index); gnat_index = Next_Index (gnat_index))
! SET_TYPE_ACTUAL_BOUNDS
! (gnu_inner_type,
! tree_cons (NULL_TREE,
! get_unpadded_type (Etype (gnat_index)),
! TYPE_ACTUAL_BOUNDS (gnu_inner_type)));
if (Convention (gnat_entity) != Convention_Fortran)
! SET_TYPE_ACTUAL_BOUNDS
! (gnu_inner_type,
! nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type)));
if (TREE_CODE (gnu_type) == RECORD_TYPE
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2296,2303 ****
defer_incomplete_level++;
this_deferred = 1;
- set_lineno (gnat_entity, 0);
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
debug_info_p);
save_gnu_tree (gnat_entity, gnu_decl, 0);
this_made_decl = saved = 1;
--- 2286,2293 ----
defer_incomplete_level++;
this_deferred = 1;
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
debug_info_p);
+ annotate_decl_with_node (gnu_decl, gnat_entity);
save_gnu_tree (gnat_entity, gnu_decl, 0);
this_made_decl = saved = 1;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2657,2664 ****
DECL_INTERNAL_P (gnu_field)
= DECL_INTERNAL_P (gnu_old_field);
! SET_DECL_ORIGINAL_FIELD (gnu_field,
! (DECL_ORIGINAL_FIELD (gnu_old_field) != 0
! ? DECL_ORIGINAL_FIELD (gnu_old_field)
! : gnu_old_field));
DECL_DISCRIMINANT_NUMBER (gnu_field)
= DECL_DISCRIMINANT_NUMBER (gnu_old_field);
--- 2647,2654 ----
DECL_INTERNAL_P (gnu_field)
= DECL_INTERNAL_P (gnu_old_field);
! SET_DECL_ORIGINAL_FIELD
! (gnu_field, (DECL_ORIGINAL_FIELD (gnu_old_field) != 0
! ? DECL_ORIGINAL_FIELD (gnu_old_field)
! : gnu_old_field));
DECL_DISCRIMINANT_NUMBER (gnu_field)
= DECL_DISCRIMINANT_NUMBER (gnu_old_field);
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2701,2708 ****
for (gnu_temp = gnu_subst_list;
gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
! SET_TYPE_ADA_SIZE (gnu_type,
! substitute_in_expr (TYPE_ADA_SIZE (gnu_type),
! TREE_PURPOSE (gnu_temp),
! TREE_VALUE (gnu_temp)));
/* Recompute the mode of this record type now that we know its
--- 2691,2698 ----
for (gnu_temp = gnu_subst_list;
gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
! SET_TYPE_ADA_SIZE
! (gnu_type, substitute_in_expr (TYPE_ADA_SIZE (gnu_type),
! TREE_PURPOSE (gnu_temp),
! TREE_VALUE (gnu_temp)));
/* Recompute the mode of this record type now that we know its
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2902,2906 ****
TYPE_POINTER_TO (gnu_old) = gnu_type;
! set_lineno (gnat_entity, 0);
fields
= chainon (chainon (NULL_TREE,
--- 2892,2896 ----
TYPE_POINTER_TO (gnu_old) = gnu_type;
! Sloc_to_locus (Sloc (gnat_entity), &input_location);
fields
= chainon (chainon (NULL_TREE,
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3493,3497 ****
else
{
- set_lineno (gnat_param, 0);
gnu_param
= create_param_decl
--- 3483,3486 ----
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3506,3509 ****
--- 3495,3499 ----
= (Ekind (gnat_param) == E_In_Parameter
&& (by_ref_p || by_component_ptr_p));
+ annotate_decl_with_node (gnu_param, gnat_param);
save_gnu_tree (gnat_param, gnu_param, 0);
gnu_param_list = chainon (gnu_param, gnu_param_list);
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3531,3537 ****
}
- set_lineno (gnat_param, 0);
gnu_field = create_field_decl (gnu_param_name, gnu_param_type,
gnu_return_type, 0, 0, 0, 0);
TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field;
--- 3521,3527 ----
}
gnu_field = create_field_decl (gnu_param_name, gnu_param_type,
gnu_return_type, 0, 0, 0, 0);
+ annotate_decl_with_node (gnu_field, gnat_param);
TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3596,3600 ****
| (TYPE_QUAL_VOLATILE * volatile_flag)));
! set_lineno (gnat_entity, 0);
/* If there was no specified Interface_Name and the external and
--- 3586,3590 ----
| (TYPE_QUAL_VOLATILE * volatile_flag)));
! Sloc_to_locus (Sloc (gnat_entity), &input_location);
/* If there was no specified Interface_Name and the external and
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3703,3710 ****
/* Save this type as the full declaration's type so we can do any needed
updates when we see it. */
- set_lineno (gnat_entity, 0);
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
debug_info_p);
save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0);
break;
--- 3693,3700 ----
/* Save this type as the full declaration's type so we can do any needed
updates when we see it. */
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
debug_info_p);
+ annotate_decl_with_node (gnu_decl, gnat_entity);
save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0);
break;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3868,3877 ****
if (TREE_CODE (gnu_type) == RECORD_TYPE)
! SET_TYPE_ADA_SIZE (gnu_type,
! elaborate_expression_1 (gnat_entity, gnat_entity,
! TYPE_ADA_SIZE (gnu_type),
! get_identifier ("RM_SIZE"),
! definition, 0));
! }
}
--- 3858,3869 ----
if (TREE_CODE (gnu_type) == RECORD_TYPE)
! SET_TYPE_ADA_SIZE
! (gnu_type,
! elaborate_expression_1 (gnat_entity,
! gnat_entity,
! TYPE_ADA_SIZE (gnu_type),
! get_identifier ("RM_SIZE"),
! definition, 0));
! }
}
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3920,3927 ****
if (gnu_decl == 0)
{
- set_lineno (gnat_entity, 0);
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
debug_info_p);
}
else
--- 3912,3919 ----
if (gnu_decl == 0)
{
gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! Comes_From_Source (gnat_entity),
debug_info_p);
+ annotate_decl_with_node (gnu_decl, gnat_entity);
}
else
*************** mark_out_of_scope (Entity_Id gnat_entity
*** 4172,4177 ****
Present (gnat_sub_entity);
gnat_sub_entity = Next_Entity (gnat_sub_entity))
! if (Scope (gnat_sub_entity) == gnat_entity
! && gnat_sub_entity != gnat_entity)
mark_out_of_scope (gnat_sub_entity);
--- 4164,4169 ----
Present (gnat_sub_entity);
gnat_sub_entity = Next_Entity (gnat_sub_entity))
! if (Scope (gnat_sub_entity) == gnat_entity
! && gnat_sub_entity != gnat_entity)
mark_out_of_scope (gnat_sub_entity);
*************** get_unpadded_type (Entity_Id gnat_entity
*** 4428,4432 ****
tree
! maybe_variable (tree gnu_operand, Node_Id gnat_node)
{
if (TREE_CONSTANT (gnu_operand) || TREE_READONLY (gnu_operand)
--- 4420,4424 ----
tree
! maybe_variable (tree gnu_operand)
{
if (TREE_CONSTANT (gnu_operand) || TREE_READONLY (gnu_operand)
*************** maybe_variable (tree gnu_operand, Node_I
*** 4435,4443 ****
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)
{
--- 4427,4430 ----
*************** elaborate_expression_1 (Node_Id gnat_exp
*** 4555,4559 ****
if (need_debug || (expr_variable && expr_global))
{
- set_lineno (gnat_entity, ! global_bindings_p ());
gnu_decl
= create_var_decl (create_concat_name (gnat_entity,
--- 4542,4545 ----
*************** elaborate_expression_1 (Node_Id gnat_exp
*** 4561,4564 ****
--- 4547,4551 ----
NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1,
Is_Public (gnat_entity), ! definition, 0, 0);
+ annotate_decl_with_node (gnu_decl, gnat_entity);
add_decl_stmt (gnu_decl, gnat_entity);
}
*************** elaborate_expression_1 (Node_Id gnat_exp
*** 4571,4575 ****
return gnu_expr;
else
! return maybe_variable (gnu_expr, gnat_expr);
}
--- 4558,4562 ----
return gnu_expr;
else
! return maybe_variable (gnu_expr);
}
*************** make_packable_type (tree type)
*** 4676,4682 ****
DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
! SET_DECL_ORIGINAL_FIELD (new_field,
! (DECL_ORIGINAL_FIELD (old_field) != 0
! ? DECL_ORIGINAL_FIELD (old_field) : old_field));
if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
--- 4663,4669 ----
DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
! SET_DECL_ORIGINAL_FIELD
! (new_field, (DECL_ORIGINAL_FIELD (old_field) != 0
! ? DECL_ORIGINAL_FIELD (old_field) : old_field));
if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
*************** gnat_to_gnu_field (Entity_Id gnat_field,
*** 5194,5202 ****
/* 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,
packed, gnu_size, gnu_pos,
Is_Aliased (gnat_field));
!
TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field);
--- 5181,5188 ----
/* Now create the decl for the field. */
gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type,
packed, gnu_size, gnu_pos,
Is_Aliased (gnat_field));
! annotate_decl_with_node (gnu_field, gnat_field);
TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field);
*************** check_ok_for_atomic (tree object, Entity
*** 6202,6205 ****
--- 6188,6200 ----
}
+ /* 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,
return a new type with all size expressions that contain F
*************** gnat_substitute_in_type (tree t, tree f,
*** 6232,6237 ****
new = build_range_type (TREE_TYPE (t), low, high);
if (TYPE_INDEX_TYPE (t))
! SET_TYPE_INDEX_TYPE (new,
! gnat_substitute_in_type (TYPE_INDEX_TYPE (t), f, r));
return new;
}
--- 6227,6232 ----
new = build_range_type (TREE_TYPE (t), low, high);
if (TYPE_INDEX_TYPE (t))
! SET_TYPE_INDEX_TYPE
! (new, gnat_substitute_in_type (TYPE_INDEX_TYPE (t), f, r));
return new;
}
*************** gnat_substitute_in_type (tree t, tree f,
*** 6352,6357 ****
DECL_CONTEXT (new_field) = new;
SET_DECL_ORIGINAL_FIELD (new_field,
! (DECL_ORIGINAL_FIELD (field) != 0
! ? DECL_ORIGINAL_FIELD (field) : field));
/* If the size of the old field was set at a constant,
--- 6347,6352 ----
DECL_CONTEXT (new_field) = new;
SET_DECL_ORIGINAL_FIELD (new_field,
! (DECL_ORIGINAL_FIELD (field) != 0
! ? DECL_ORIGINAL_FIELD (field) : field));
/* If the size of the old field was set at a constant,
*** gigi.h 27 May 2004 22:42:37 -0000 1.20.2.17
--- gigi.h 7 Jun 2004 14:47:09 -0000
*************** extern unsigned int largest_move_alignme
*** 37,46 ****
/* 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
objects. */
--- 37,40 ----
*************** extern void gnat_compute_largest_alignme
*** 51,57 ****
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
default. */
--- 45,48 ----
*************** extern tree gnat_to_gnu_type (Entity_Id)
*** 93,96 ****
--- 84,93 ----
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.
Get SLOC from Entity_Id. */
*************** extern tree get_unpadded_type (Entity_Id
*** 112,116 ****
/* Called when we need to protect a variable object using a save_expr. */
! extern tree maybe_variable (tree, Node_Id);
/* Create a record type that contains a field of TYPE with a starting bit
--- 109,113 ----
/* Called when we need to protect a variable object using a save_expr. */
! extern tree maybe_variable (tree);
/* Create a record type that contains a field of TYPE with a starting bit
*************** extern tree get_entity_name (Entity_Id);
*** 148,157 ****
extern tree create_concat_name (Entity_Id, const char *);
! /* Flag indicating whether file names are discarded in exception messages */
! extern int discard_file_names;
!
! /* 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;
--- 145,151 ----
extern tree create_concat_name (Entity_Id, const char *);
! /* 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;
*** 159,167 ****
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
structures and then generates code. */
--- 153,156 ----
*************** extern void gigi (Node_Id, int, int, str
*** 172,180 ****
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
GCC tree corresponding to that GNAT tree. Normally, no code is generated;
--- 161,164 ----
*************** extern tree gnat_to_gnu (Node_Id);
*** 186,189 ****
--- 170,178 ----
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
a separate Freeze node exists, delay the bulk of the processing. Otherwise
*************** extern void gnat_expand_stmt (tree);
*** 192,202 ****
extern void process_type (Entity_Id);
! /* Determine the input_filename and the input_line from the source location
! (Sloc) of GNAT_NODE node. Set the global variable input_filename and
! input_line. If WRITE_NOTE_P is true, emit a line number note. */
! extern void set_lineno (Node_Id, int);
!
! /* Likewise, but passed a Sloc. */
! extern void set_lineno_from_sloc (Source_Ptr, int);
/* Post an error message. MSG is the error message, properly annotated.
--- 181,190 ----
extern void process_type (Entity_Id);
! /* Convert Sloc into *LOCUS (a location_t). Return true if this Sloc
! corresponds to a source code location and false if it doesn't. In the
! latter case, we don't update *LOCUS. We also set the Gigi global variable
! REF_FILENAME to the reference file name as given by sinput (i.e no
! directory). */
! extern bool Sloc_to_locus (Source_Ptr, location_t *);
/* Post an error message. MSG is the error message, properly annotated.
*************** extern int global_bindings_p (void);
*** 384,391 ****
extern tree getdecls (void);
! /* Enter and exit a new binding level. We return the BLOCK node, if any
! when we exit a binding level. */
extern void gnat_pushlevel (void);
! extern tree gnat_poplevel (void);
/* Insert BLOCK at the end of the list of subblocks of the
--- 372,384 ----
extern tree getdecls (void);
! /* Enter and exit a new binding level. */
extern void gnat_pushlevel (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
*************** extern void begin_subprog_body (tree);
*** 564,569 ****
/* Finish the definition of the current subprogram and compile it all the way
! to assembler language output. */
! extern void end_subprog_body (void);
/* Build a template of type TEMPLATE_TYPE from the array bounds of ARRAY_TYPE.
--- 557,563 ----
/* Finish the definition of the current subprogram and compile it all the way
! to assembler language output. BODY is the tree corresponding to
! the subprogram. */
! extern void end_subprog_body (tree);
/* Build a template of type TEMPLATE_TYPE from the array bounds of ARRAY_TYPE.
*** misc.c 17 May 2004 04:12:12 -0000 1.44.2.38
--- misc.c 7 Jun 2004 14:47:13 -0000
***************
*** 49,52 ****
--- 49,54 ----
#include "flags.h"
#include "debug.h"
+ #include "cgraph.h"
+ #include "tree-inline.h"
#include "insn-codes.h"
#include "insn-flags.h"
*************** extern FILE *asm_out_file;
*** 85,93 ****
unsigned int largest_move_alignment;
- static size_t gnat_tree_size (enum tree_code);
static bool gnat_init (void);
static void gnat_finish_incomplete_decl (tree);
static unsigned int gnat_init_options (unsigned int, const char **);
static int gnat_handle_option (size_t, const char *, int);
static HOST_WIDE_INT gnat_get_alias_set (tree);
static void gnat_print_decl (FILE *, tree, int);
--- 87,95 ----
unsigned int largest_move_alignment;
static bool gnat_init (void);
static void gnat_finish_incomplete_decl (tree);
static unsigned int gnat_init_options (unsigned int, const char **);
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 void gnat_print_decl (FILE *, tree, int);
*************** static void gnat_adjust_rli (record_lay
*** 108,113 ****
#undef LANG_HOOKS_IDENTIFIER_SIZE
#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
#define LANG_HOOKS_INIT gnat_init
--- 110,113 ----
*************** static void gnat_adjust_rli (record_lay
*** 116,119 ****
--- 116,121 ----
#undef LANG_HOOKS_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
#define LANG_HOOKS_PARSE_FILE gnat_parse_file
*************** static void gnat_adjust_rli (record_lay
*** 144,147 ****
--- 146,156 ----
#undef LANG_HOOKS_DECL_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
#define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode
*************** gnat_parse_file (int set_yydebug ATTRIBU
*** 225,232 ****
adainit ();
- immediate_size_expand = 1;
-
/* Call the front end */
_ada_gnat1drv ();
}
--- 234,242 ----
adainit ();
/* Call the front end */
_ada_gnat1drv ();
+
+ cgraph_finalize_compilation_unit ();
+ cgraph_optimize ();
}
*************** gnat_init_options (unsigned int argc, co
*** 333,336 ****
--- 343,364 ----
}
+ /* 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. */
*************** internal_error_function (const char *msg
*** 360,378 ****
}
- /* 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. */
--- 388,391 ----
*************** gnat_printable_name (tree decl, int verb
*** 560,564 ****
/* Expands GNAT-specific GCC tree nodes. The only ones we support
! here are TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR and NULL_EXPR. */
static rtx
--- 573,577 ----
/* Expands GNAT-specific GCC tree nodes. The only ones we support
! here are and NULL_EXPR. */
static rtx
*************** gnat_expand_expr (tree exp, rtx target,
*** 568,572 ****
tree type = TREE_TYPE (exp);
tree new;
- rtx result;
/* If this is a statement, call the expansion routine for statements. */
--- 581,584 ----
*************** gnat_expand_expr (tree exp, rtx target,
*** 580,600 ****
switch (TREE_CODE (exp))
{
! case TRANSFORM_EXPR:
! 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:
return
--- 592,596 ----
switch (TREE_CODE (exp))
{
! #if 0
case ALLOCATE_EXPR:
return
*************** gnat_expand_expr (tree exp, rtx target,
*** 603,625 ****
EXPAND_NORMAL),
NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
!
! 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:
--- 599,603 ----
EXPAND_NORMAL),
NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
! #endif
case UNCONSTRAINED_ARRAY_REF:
*************** gnat_adjust_rli (record_layout_info rli
*** 668,683 ****
#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. */
--- 646,649 ----
*************** gnat_eh_type_covers (tree a, tree b)
*** 705,757 ****
}
- /* 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. */
--- 671,674 ----
*** trans.c 27 May 2004 22:50:16 -0000 1.68.2.53
--- trans.c 7 Jun 2004 14:47:28 -0000
***************
*** 32,35 ****
--- 32,36 ----
#include "real.h"
#include "flags.h"
+ #include "toplev.h"
#include "rtl.h"
#include "expr.h"
***************
*** 39,42 ****
--- 40,44 ----
#include "debug.h"
#include "output.h"
+ #include "tree-gimple.h"
#include "ada.h"
#include "types.h"
*************** struct List_Header *List_Headers_Ptr;
*** 69,75 ****
const char *ref_filename;
- /* Flag indicating whether file names are discarded in exception messages */
- int discard_file_names;
-
/* If true, then gigi is being called on an analyzed but unexpanded
tree, and the only purpose of the call is to properly annotate
--- 71,74 ----
*************** int discard_file_names;
*** 77,93 ****
int type_annotate_only;
! /* 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. TREE_PURPOSE gives the bottom condition for a loop,
! if this block is for a loop. The latter is only used to save the tree
! over GC. */
! tree gnu_block_stack;
!
! /* The current BLOCK_STMT node. TREE_CHAIN points to the previous
! BLOCK_STMT node. */
! static GTY(()) tree gnu_block_stmt_node;
! /* List of unused BLOCK_STMT nodes. */
! static GTY((deletable)) tree gnu_block_stmt_free_list;
/* List of TREE_LIST nodes representing a stack of exception pointer
--- 76,98 ----
int type_annotate_only;
! /* A structure used to gather together information about a statement group.
! We use this to gather related statements, for example the "then" part
! of a IF. In the case where it represents a lexical scope, we may also
! have a BLOCK node corresponding to it and/or cleanups. */
!
! struct stmt_group GTY((chain_next ("%h.previous"))) {
! struct stmt_group *previous; /* Previous code group. */
! tree stmt_list; /* List of statements for this code group. */
! tree block; /* BLOCK for this code group, if any. */
! tree cleanups; /* Cleanups for this code group, if any. */
! };
!
! static GTY(()) struct stmt_group *current_stmt_group;
! /* List of unused struct stmt_group nodes. */
! static GTY((deletable)) struct stmt_group *stmt_group_free_list;
!
! /* Free list of TREE_LIST nodes used for stacks. */
! static GTY((deletable)) tree gnu_stack_free_list;
/* List of TREE_LIST nodes representing a stack of exception pointer
*************** static GTY((deletable)) tree gnu_block_s
*** 97,100 ****
--- 102,113 ----
static GTY(()) tree gnu_except_ptr_stack;
+ /* Variable that stores a list of labels to be used as a goto target instead of
+ a return in some functions. See processing for N_Subprogram_Body. */
+ static GTY(()) tree gnu_return_label_stack;
+
+ /* List of TREE_LIST nodes representing a stack of LOOP_STMT nodes.
+ TREE_VALUE of each entry is the corresponding LOOP_STMT. */
+ static GTY(()) tree gnu_loop_stmt_stack;
+
/* List of TREE_LIST nodes containing pending elaborations lists.
used to prevent the elaborations being reclaimed by GC. */
*************** static enum tree_code gnu_codes[Number_N
*** 107,120 ****
Node_Id error_gnat_node;
! /* Variable that stores a list of labels to be used as a goto target instead of
! a return in some functions. See processing for N_Subprogram_Body. */
! static GTY(()) tree gnu_return_label_stack;
!
! static tree tree_transform (Node_Id);
! static rtx first_nondeleted_insn (rtx);
! static tree start_block_stmt (void);
! static tree end_block_stmt (bool);
! static tree build_block_stmt (List_Id);
! static tree make_expr_stmt_from_rtl (rtx, Node_Id);
static void elaborate_all_entities (Node_Id);
static void process_freeze_entity (Node_Id);
--- 120,136 ----
Node_Id error_gnat_node;
! static void record_code_position (Node_Id);
! static void insert_code_for (Node_Id);
! static void start_stmt_group (void);
! static void add_cleanup (tree);
! static tree end_stmt_group (void);
! static void add_stmt_list (List_Id);
! static tree build_stmt_group (List_Id, bool);
! static void push_stack (tree *, tree, tree);
! static void pop_stack (tree *);
! static enum gimplify_status gnat_gimplify_stmt (tree *);
! static tree gnat_gimplify_type_sizes (tree);
! static void gnat_gimplify_one_sizepos (tree *, tree *);
! static void gnat_expand_body_1 (tree, bool);
static void elaborate_all_entities (Node_Id);
static void process_freeze_entity (Node_Id);
*************** static tree maybe_implicit_deref (tree);
*** 132,135 ****
--- 148,152 ----
static tree gnat_stabilize_reference_1 (tree, int);
static int build_unit_elab (Entity_Id, int, tree);
+ static void annotate_with_node (tree, Node_Id);
/* Constants for +0.5 and -0.5 for float-to-integer rounding. */
*************** gigi (Node_Id gnat_root,
*** 183,194 ****
}
- /* See if we should discard file names in exception messages. */
- discard_file_names = Debug_Flag_NN;
-
if (Nkind (gnat_root) != N_Compilation_Unit)
gigi_abort (301);
- set_lineno (gnat_root, 0);
-
/* Initialize ourselves. */
init_gnat_to_gnu ();
--- 200,206 ----
*************** gigi (Node_Id gnat_root,
*** 196,200 ****
init_code_table ();
gnat_compute_largest_alignment ();
! start_block_stmt ();
/* Enable GNAT stack checking method if needed */
--- 208,212 ----
init_code_table ();
gnat_compute_largest_alignment ();
! start_stmt_group ();
/* Enable GNAT stack checking method if needed */
*************** gigi (Node_Id gnat_root,
*** 202,205 ****
--- 214,220 ----
set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
+ if (Exception_Mechanism == Front_End_ZCX)
+ abort ();
+
/* Save the type we made for integer as the type for Standard.Integer.
Then make the rest of the standard types. Note that some of these
*************** gigi (Node_Id gnat_root,
*** 232,354 ****
gnat_init_gcc_eh ();
! gnat_to_code (gnat_root);
}
-
! /* 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. */
!
! void
! gnat_to_code (Node_Id gnat_node)
! {
! tree gnu_root;
!
! /* Save node number in case error */
! error_gnat_node = gnat_node;
!
! start_block_stmt ();
! gnu_root = tree_transform (gnat_node);
! gnat_expand_stmt (end_block_stmt (false));
!
! /* If we return a statement, generate code for it. */
! if (IS_STMT (gnu_root))
! {
! if (TREE_CODE (gnu_root) != NULL_STMT)
! gnat_expand_stmt (gnu_root);
! }
! /* This should just generate code, not return a value. If it returns
! a value, something is wrong. */
! else if (gnu_root != error_mark_node)
! gigi_abort (302);
! }
!
! /* 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.
! We just return an equivalent tree which is used elsewhere to generate
! code. */
tree
gnat_to_gnu (Node_Id gnat_node)
{
- tree gnu_root;
- bool made_sequence = false;
-
- /* We support the use of this on statements now as a transition
- to full function-at-a-time processing. So we need to see if anything
- we do generates RTL and returns error_mark_node. */
- if (!global_bindings_p ())
- {
- do_pending_stack_adjust ();
- emit_queue ();
- start_sequence ();
- emit_note (NOTE_INSN_DELETED);
- made_sequence = true;
- }
-
- /* Save node number in case error */
- error_gnat_node = gnat_node;
-
- start_block_stmt ();
- gnu_root = tree_transform (gnat_node);
- gnat_expand_stmt (end_block_stmt (false));
-
- if (gnu_root == error_mark_node)
- {
- if (!made_sequence)
- {
- if (type_annotate_only)
- return gnu_root;
- else
- gigi_abort (303);
- }
-
- do_pending_stack_adjust ();
- emit_queue ();
- gnu_root = make_expr_stmt_from_rtl (first_nondeleted_insn (get_insns ()),
- gnat_node);
- end_sequence ();
- }
- else if (made_sequence)
- {
- rtx insns;
-
- do_pending_stack_adjust ();
- emit_queue ();
- insns = first_nondeleted_insn (get_insns ());
- end_sequence ();
-
- if (insns)
- {
- /* If we have a statement, we need to first evaluate any RTL we
- made in the process of building it and then the statement. */
- if (IS_STMT (gnu_root))
- {
- tree gnu_expr_stmt = make_expr_stmt_from_rtl (insns, gnat_node);
-
- TREE_CHAIN (gnu_expr_stmt) = gnu_root;
- gnu_root = build_nt (BLOCK_STMT, gnu_expr_stmt, NULL_TREE);
- TREE_SLOC (gnu_root) = Sloc (gnat_node);
- }
- else
- emit_insn (insns);
- }
- }
-
- return gnu_root;
- }
-
- /* This function is the driver of the GNAT to GCC tree transformation process.
- It is the entry point of the tree transformer. GNAT_NODE is the root of
- some GNAT tree. Return the root of the corresponding GCC tree or
- error_mark_node to signal that there is no GCC tree to return.
-
- The latter is the case if only code generation actions have to be performed
- like in the case of if statements, loops, etc. This routine is wrapped
- in the above two routines for most purposes. */
-
- static tree
- tree_transform (Node_Id gnat_node)
- {
tree gnu_result = error_mark_node; /* Default to no value. */
tree gnu_result_type = void_type_node;
--- 247,265 ----
gnat_init_gcc_eh ();
! gnat_to_gnu (gnat_root);
}
! /* This function is the driver of the GNAT to GCC tree transformation
! process. It is the entry point of the tree transformer. GNAT_NODE is the
! root of some GNAT tree. Return the root of the corresponding GCC tree.
! If this is an expression, return the GCC equivalent of the expression. If
! it is a statement, return the statement. In the case when called for a
! statement, it may also add statements to the current statement group, in
! which case anything it returns is to be interpreted as occuring after
! anything `it already added. */
tree
gnat_to_gnu (Node_Id gnat_node)
{
tree gnu_result = error_mark_node; /* Default to no value. */
tree gnu_result_type = void_type_node;
*************** tree_transform (Node_Id gnat_node)
*** 358,408 ****
Entity_Id gnat_temp_type;
! /* Set input_file_name and lineno from the Sloc in the GNAT tree. */
! set_lineno (gnat_node, 0);
!
! if (IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)
! && type_annotate_only)
! return error_mark_node;
!
! /* If this is a Statement and we are at top level, we add the statement
! as an elaboration for a null tree. That will cause it to be placed
! in the elaboration procedure. */
! if (global_bindings_p ()
! && ((IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)
! && Nkind (gnat_node) != N_Null_Statement)
! || Nkind (gnat_node) == N_Procedure_Call_Statement
! || Nkind (gnat_node) == N_Label
! || (Nkind (gnat_node) == N_Handled_Sequence_Of_Statements
! && (Present (Exception_Handlers (gnat_node))
! || Present (At_End_Proc (gnat_node))))
! || ((Nkind (gnat_node) == N_Raise_Constraint_Error
! || Nkind (gnat_node) == N_Raise_Storage_Error
! || Nkind (gnat_node) == N_Raise_Program_Error)
! && (Ekind (Etype (gnat_node)) == E_Void))))
! {
! add_pending_elaborations (NULL_TREE, make_transform_expr (gnat_node));
! return error_mark_node;
! }
/* If this node is a non-static subexpression and we are only
! annotating types, make this into a NULL_EXPR for non-VOID types
! and error_mark_node for void return types. But allow
! N_Identifier since we use it for lots of things, including
! getting trees for discriminants. */
!
if (type_annotate_only
&& IN (Nkind (gnat_node), N_Subexpr)
&& Nkind (gnat_node) != N_Identifier
&& ! Compile_Time_Known_Value (gnat_node))
! {
! gnu_result_type = get_unpadded_type (Etype (gnat_node));
!
! if (TREE_CODE (gnu_result_type) == VOID_TYPE)
! return error_mark_node;
! else
! return build1 (NULL_EXPR, gnu_result_type,
! build_call_raise (CE_Range_Check_Failed));
! }
switch (Nkind (gnat_node))
--- 269,288 ----
Entity_Id gnat_temp_type;
! /* Save node number for error message and set location information. */
! error_gnat_node = gnat_node;
! Sloc_to_locus (Sloc (gnat_node), &input_location);
! if (type_annotate_only
! && IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call))
! return alloc_stmt_list ();
/* If this node is a non-static subexpression and we are only
! annotating types, make this into a NULL_EXPR. */
if (type_annotate_only
&& IN (Nkind (gnat_node), N_Subexpr)
&& Nkind (gnat_node) != N_Identifier
&& ! Compile_Time_Known_Value (gnat_node))
! return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)),
! build_call_raise (CE_Range_Check_Failed));
switch (Nkind (gnat_node))
*************** tree_transform (Node_Id gnat_node)
*** 417,431 ****
case N_Defining_Identifier:
! /* If the Etype of this node does not equal the Etype of the
! Entity, something is wrong with the entity map, probably in
! generic instantiation. However, this does not apply to
! types. Since we sometime have strange Ekind's, just do
! this test for objects. Also, if the Etype of the Entity is
! private, the Etype of the N_Identifier is allowed to be the full
! type and also we consider a packed array type to be the same as
! the original type. Similarly, a class-wide type is equivalent
! to a subtype of itself. Finally, if the types are Itypes,
! one may be a copy of the other, which is also legal. */
!
gnat_temp = (Nkind (gnat_node) == N_Defining_Identifier
? gnat_node : Entity (gnat_node));
--- 297,309 ----
case N_Defining_Identifier:
! /* If the Etype of this node does not equal the Etype of the Entity,
! something is wrong with the entity map, probably in generic
! instantiation. However, this does not apply to types. Since we
! sometime have strange Ekind's, just do this test for objects. Also,
! if the Etype of the Entity is private, the Etype of the N_Identifier
! is allowed to be the full type and also we consider a packed array
! type to be the same as the original type. Similarly, a class-wide
! type is equivalent to a subtype of itself. Finally, if the types are
! Itypes, one may be a copy of the other, which is also legal. */
gnat_temp = (Nkind (gnat_node) == N_Defining_Identifier
? gnat_node : Entity (gnat_node));
*************** tree_transform (Node_Id gnat_node)
*** 459,463 ****
exp_disp,adb). In that case we need the type itself, not is parent,
in particular if it is a derived type */
-
if (Is_Private_Type (gnat_temp_type)
&& Has_Unknown_Discriminants (gnat_temp_type)
--- 337,340 ----
*************** tree_transform (Node_Id gnat_node)
*** 499,508 ****
the handler, only if it is referenced in the handler and declared
in an enclosing block, but we have no way of testing that
! right now. */
! if (TREE_VALUE (gnu_except_ptr_stack) != 0)
! {
! gnat_mark_addressable (gnu_result);
! flush_addressof (gnu_result);
! }
/* Some objects (such as parameters passed by reference, globals of
--- 376,386 ----
the handler, only if it is referenced in the handler and declared
in an enclosing block, but we have no way of testing that
! right now.
!
! ??? Also, for now all we can do is make it volatile. But we only
! do this for SJLJ. */
! if (TREE_VALUE (gnu_except_ptr_stack) != 0
! && TREE_CODE (gnu_result) == VAR_DECL)
! TREE_THIS_VOLATILE (gnu_result) = TREE_SIDE_EFFECTS (gnu_result) = 1;
/* Some objects (such as parameters passed by reference, globals of
*************** tree_transform (Node_Id gnat_node)
*** 742,750 ****
case N_Pragma:
! if (type_annotate_only)
! break;
!
! /* Check for (and ignore) unrecognized pragma */
! if (! Is_Pragma_Name (Chars (gnat_node)))
break;
--- 620,628 ----
case N_Pragma:
! gnu_result = alloc_stmt_list ();
! /* Check for (and ignore) unrecognized pragma and do nothing if
! we are just annotating types. */
! if (type_annotate_only
! || ! Is_Pragma_Name (Chars (gnat_node)))
break;
*************** tree_transform (Node_Id gnat_node)
*** 757,761 ****
break;
- set_lineno (gnat_node, 1);
for (gnat_temp = First (Pragma_Argument_Associations (gnat_node));
Present (gnat_temp);
--- 635,638 ----
*************** tree_transform (Node_Id gnat_node)
*** 766,772 ****
gnu_expr = TREE_OPERAND (gnu_expr, 0);
! gnu_expr = build1 (USE_EXPR, void_type_node, gnu_expr);
! TREE_SIDE_EFFECTS (gnu_expr) = 1;
! expand_expr_stmt (gnu_expr);
}
break;
--- 643,648 ----
gnu_expr = TREE_OPERAND (gnu_expr, 0);
! gnu_expr = build1 (USE_STMT, void_type_node, gnu_expr);
! add_stmt (gnu_expr);
}
break;
*************** tree_transform (Node_Id gnat_node)
*** 810,813 ****
--- 686,690 ----
case N_Task_Type_Declaration:
process_type (Defining_Entity (gnat_node));
+ gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 815,818 ****
--- 692,696 ----
case N_Exception_Declaration:
gnat_temp = Defining_Entity (gnat_node);
+ gnu_result = alloc_stmt_list ();
/* If we are just annotating types and this object has an unconstrained
*************** tree_transform (Node_Id gnat_node)
*** 851,855 ****
}
else
! gnu_expr = maybe_variable (gnu_expr, Expression (gnat_node));
save_gnu_tree (gnat_node, gnu_expr, 1);
--- 729,733 ----
}
else
! gnu_expr = maybe_variable (gnu_expr);
save_gnu_tree (gnat_node, gnu_expr, 1);
*************** tree_transform (Node_Id gnat_node)
*** 868,873 ****
case N_Object_Renaming_Declaration:
-
gnat_temp = Defining_Entity (gnat_node);
/* Don't do anything if this renaming is handled by the front end.
--- 746,751 ----
case N_Object_Renaming_Declaration:
gnat_temp = Defining_Entity (gnat_node);
+ gnu_result = alloc_stmt_list ();
/* Don't do anything if this renaming is handled by the front end.
*************** tree_transform (Node_Id gnat_node)
*** 885,888 ****
--- 763,767 ----
case N_Implicit_Label_Declaration:
gnat_to_gnu_entity (Defining_Entity (gnat_node), NULL_TREE, 1);
+ gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 892,895 ****
--- 771,775 ----
case N_Subprogram_Renaming_Declaration:
/* These are fully handled in the front end. */
+ gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 1862,1901 ****
break;
- case N_And_Then: case N_Or_Else:
- {
- /* Some processing below (e.g. clear_last_expr) requires access to
- status fields now maintained in the current function context, so
- we'll setup a dummy one if needed. We cannot use global_binding_p,
- since it might be true due to force_global and making a dummy
- context would kill the current function context. */
- bool make_dummy_context = (cfun == 0);
- enum tree_code code = gnu_codes[Nkind (gnat_node)];
- tree gnu_rhs_side;
-
- if (make_dummy_context)
- init_dummy_function_start ();
-
- /* The elaboration of the RHS may generate code. If so,
- we need to make sure it gets executed after the LHS. */
- gnu_lhs = gnat_to_gnu (Left_Opnd (gnat_node));
- clear_last_expr ();
-
- gnu_rhs_side = expand_start_stmt_expr (1 /*has_scope*/);
- gnu_rhs = gnat_to_gnu (Right_Opnd (gnat_node));
- expand_end_stmt_expr (gnu_rhs_side);
-
- if (make_dummy_context)
- expand_dummy_function_end ();
-
- gnu_result_type = get_unpadded_type (Etype (gnat_node));
-
- if (first_nondeleted_insn (RTL_EXPR_SEQUENCE (gnu_rhs_side)))
- gnu_rhs = build (COMPOUND_EXPR, gnu_result_type, gnu_rhs_side,
- gnu_rhs);
-
- gnu_result = build_binary_op (code, gnu_result_type, gnu_lhs, gnu_rhs);
- }
- break;
-
case N_Op_Or: case N_Op_And: case N_Op_Xor:
/* These can either be operations on booleans or on modular types.
--- 1742,1745 ----
*************** tree_transform (Node_Id gnat_node)
*** 1929,1932 ****
--- 1773,1777 ----
case N_Op_Shift_Right:
case N_Op_Shift_Right_Arithmetic:
+ case N_And_Then: case N_Or_Else:
{
enum tree_code code = gnu_codes[Nkind (gnat_node)];
*************** tree_transform (Node_Id gnat_node)
*** 2115,2123 ****
case N_Label:
! gnu_result = build_nt (LABEL_STMT, gnat_to_gnu (Identifier (gnat_node)));
break;
case N_Null_Statement:
! gnu_result = build_nt (NULL_STMT);
break;
--- 1960,1969 ----
case N_Label:
! gnu_result = build1 (LABEL_EXPR, void_type_node,
! gnat_to_gnu (Identifier (gnat_node)));
break;
case N_Null_Statement:
! gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 2144,2179 ****
gnu_result
= build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs);
-
- gnu_result = build_nt (EXPR_STMT, gnu_result);
break;
case N_If_Statement:
! gnu_result = NULL_TREE;
!
! /* Make an IF_STMT for each of the "else if" parts. Avoid
! non-determinism. */
! if (Present (Elsif_Parts (gnat_node)))
! for (gnat_temp = First (Elsif_Parts (gnat_node));
! Present (gnat_temp); gnat_temp = Next (gnat_temp))
! {
! gnu_expr = make_node (IF_STMT);
! IF_STMT_COND (gnu_expr) = gnat_to_gnu (Condition (gnat_temp));
! IF_STMT_TRUE (gnu_expr)
! = build_block_stmt (Then_Statements (gnat_temp));
! IF_STMT_ELSE (gnu_expr) = IF_STMT_ELSEIF (gnu_expr) = NULL_TREE;
! TREE_SLOC (gnu_expr) = Sloc (Condition (gnat_temp));
! TREE_CHAIN (gnu_expr) = gnu_result;
! TREE_TYPE (gnu_expr) = void_type_node;
! gnu_result = gnu_expr;
! }
! /* Now make the IF_STMT. Also avoid non-determinism. */
! gnu_expr = make_node (IF_STMT);
! IF_STMT_COND (gnu_expr) = gnat_to_gnu (Condition (gnat_node));
! IF_STMT_TRUE (gnu_expr) = build_block_stmt (Then_Statements (gnat_node));
! IF_STMT_ELSEIF (gnu_expr) = nreverse (gnu_result);
! IF_STMT_ELSE (gnu_expr) = build_block_stmt (Else_Statements (gnat_node));
! gnu_result = gnu_expr;
break;
--- 1990,2028 ----
gnu_result
= build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs);
break;
case N_If_Statement:
! {
! tree *gnu_else_ptr; /* Point to put next "else if" or "else". */
! /* Make the outer COND_EXPR. Avoid non-determinism. */
! gnu_result = build (COND_EXPR, void_type_node,
! gnat_to_gnu (Condition (gnat_node)),
! NULL_TREE, NULL_TREE);
! COND_EXPR_THEN (gnu_result)
! = build_stmt_group (Then_Statements (gnat_node), false);
! TREE_SIDE_EFFECTS (gnu_result) = 1;
! gnu_else_ptr = &COND_EXPR_ELSE (gnu_result);
!
! /* Now make a COND_EXPR for each of the "else if" parts. Put each
! into the previous "else" part and point to where to put any
! outer "else". Also avoid non-determinism. */
! if (Present (Elsif_Parts (gnat_node)))
! for (gnat_temp = First (Elsif_Parts (gnat_node));
! Present (gnat_temp); gnat_temp = Next (gnat_temp))
! {
! gnu_expr = build (COND_EXPR, void_type_node,
! gnat_to_gnu (Condition (gnat_temp)),
! NULL_TREE, NULL_TREE);
! COND_EXPR_THEN (gnu_expr)
! = build_stmt_group (Then_Statements (gnat_temp), false);
! TREE_SIDE_EFFECTS (gnu_expr) = 1;
! annotate_with_node (gnu_expr, gnat_temp);
! *gnu_else_ptr = gnu_expr;
! gnu_else_ptr = &COND_EXPR_ELSE (gnu_expr);
! }
! *gnu_else_ptr = build_stmt_group (Else_Statements (gnat_node), false);
! }
break;
*************** tree_transform (Node_Id gnat_node)
*** 2181,2187 ****
{
Node_Id gnat_when;
- Node_Id gnat_choice;
- tree gnu_label;
- Node_Id gnat_statement;
gnu_expr = gnat_to_gnu (Expression (gnat_node));
--- 2030,2033 ----
*************** tree_transform (Node_Id gnat_node)
*** 2205,2257 ****
gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
! set_lineno (gnat_node, 1);
! expand_start_case (1, gnu_expr, TREE_TYPE (gnu_expr), "case");
for (gnat_when = First_Non_Pragma (Alternatives (gnat_node));
Present (gnat_when);
gnat_when = Next_Non_Pragma (gnat_when))
{
! tree gnu_temp_stmt, gnu_block;
! /* First compile all the different case choices for the current
WHEN alternative. */
-
for (gnat_choice = First (Discrete_Choices (gnat_when));
Present (gnat_choice); gnat_choice = Next (gnat_choice))
! {
! int error_code;
!
! gnu_label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
- set_lineno (gnat_choice, 1);
switch (Nkind (gnat_choice))
{
case N_Range:
! /* Abort on all errors except range empty, which
! means we ignore this alternative. */
! error_code
! = pushcase_range (gnat_to_gnu (Low_Bound (gnat_choice)),
! gnat_to_gnu (High_Bound (gnat_choice)),
! convert, gnu_label, 0);
!
! if (error_code != 0 && error_code != 4)
! gigi_abort (332);
break;
case N_Subtype_Indication:
! error_code
! = pushcase_range
! (gnat_to_gnu (Low_Bound (Range_Expression
! (Constraint (gnat_choice)))),
! gnat_to_gnu (High_Bound (Range_Expression
! (Constraint (gnat_choice)))),
! convert, gnu_label, 0);
!
! if (error_code != 0 && error_code != 4)
! gigi_abort (332);
break;
case N_Identifier:
! case N_Expanded_Name:
/* This represents either a subtype range or a static value
of some kind; Ekind says which. If a static value,
--- 2051,2089 ----
gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
! /* We build a SWITCH_EXPR that contains the code with interspersed
! CASE_LABEL_EXPRs for each label. */
+ start_stmt_group ();
for (gnat_when = First_Non_Pragma (Alternatives (gnat_node));
Present (gnat_when);
gnat_when = Next_Non_Pragma (gnat_when))
{
! Node_Id gnat_choice;
! /* First compile all the different case choices for the current
WHEN alternative. */
for (gnat_choice = First (Discrete_Choices (gnat_when));
Present (gnat_choice); gnat_choice = Next (gnat_choice))
! {
! tree gnu_low = NULL_TREE, gnu_high = NULL_TREE;
switch (Nkind (gnat_choice))
{
case N_Range:
! gnu_low = gnat_to_gnu (Low_Bound (gnat_choice));
! gnu_high = gnat_to_gnu (High_Bound (gnat_choice));
break;
case N_Subtype_Indication:
! gnu_low = gnat_to_gnu (Low_Bound
! (Range_Expression
! (Constraint (gnat_choice))));
! gnu_high = gnat_to_gnu (High_Bound
! (Range_Expression
! (Constraint (gnat_choice))));
break;
case N_Identifier:
! case N_Expanded_Name:
/* This represents either a subtype range or a static value
of some kind; Ekind says which. If a static value,
*************** tree_transform (Node_Id gnat_node)
*** 2259,2284 ****
if (IN (Ekind (Entity (gnat_choice)), Type_Kind))
{
! tree type = get_unpadded_type (Entity (gnat_choice));
!
! error_code
! = pushcase_range (fold (TYPE_MIN_VALUE (type)),
! fold (TYPE_MAX_VALUE (type)),
! convert, gnu_label, 0);
! if (error_code != 0 && error_code != 4)
! gigi_abort (332);
break;
}
/* ... fall through ... */
case N_Character_Literal:
case N_Integer_Literal:
! if (pushcase (gnat_to_gnu (gnat_choice), convert,
! gnu_label, 0))
! gigi_abort (332);
break;
case N_Others_Choice:
- if (pushcase (NULL_TREE, convert, gnu_label, 0))
- gigi_abort (332);
break;
--- 2091,2109 ----
if (IN (Ekind (Entity (gnat_choice)), Type_Kind))
{
! tree gnu_type
! = get_unpadded_type (Entity (gnat_choice));
! gnu_low = fold (TYPE_MIN_VALUE (gnu_type));
! gnu_high = fold (TYPE_MAX_VALUE (gnu_type));
break;
}
+
/* ... fall through ... */
case N_Character_Literal:
case N_Integer_Literal:
! gnu_low = gnat_to_gnu (gnat_choice);
break;
case N_Others_Choice:
break;
*************** tree_transform (Node_Id gnat_node)
*** 2286,2339 ****
gigi_abort (316);
}
- }
-
- /* After compiling the choices attached to the WHEN compile the
- body of statements that have to be executed, should the
- "WHEN ... =>" be taken. Push a binding level here in case
- variables are declared since we want them to be local to this
- set of statements instead of the block containing the Case
- statement. */
- gnat_pushlevel ();
- start_block_stmt ();
! for (gnat_statement = First (Statements (gnat_when));
! Present (gnat_statement);
! gnat_statement = Next (gnat_statement))
! add_stmt (gnat_to_gnu (gnat_statement));
!
! /* Communicate to GCC that we are done with the current WHEN,
! i.e. insert a "break" statement. */
! gnu_temp_stmt = build_nt (BREAK_STMT);
! TREE_SLOC (gnu_temp_stmt) = Sloc (gnat_when);
! add_stmt (gnu_temp_stmt);
!
! gnu_block = gnat_poplevel ();
! gnu_temp_stmt = end_block_stmt (gnu_block != 0);
! if (gnu_block)
! BLOCK_STMT_BLOCK (gnu_temp_stmt) = gnu_block;
!
! expand_expr_stmt (gnu_temp_stmt);
! }
! expand_end_case (gnu_expr);
}
- break;
case N_Loop_Statement:
{
! /* The loop variable in GCC form, if any. */
tree gnu_loop_var = NULL_TREE;
- /* PREINCREMENT_EXPR or PREDECREMENT_EXPR. */
- enum tree_code gnu_update = ERROR_MARK;
- /* Used if this is a named loop for so EXIT can work. */
- struct nesting *loop_id;
- /* Condition to continue loop tested at top of loop. */
- tree gnu_top_condition = integer_one_node;
- /* Similar, but tested at bottom of loop. */
- tree gnu_bottom_condition = integer_one_node;
- Node_Id gnat_statement;
Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
! Node_Id gnat_top_condition = Empty;
! int enclosing_if_p = 0;
/* Set the condition that under which the loop should continue.
--- 2111,2148 ----
gigi_abort (316);
}
! add_stmt_with_node (build (CASE_LABEL_EXPR, void_type_node,
! gnu_low, gnu_high,
! create_artificial_label ()),
! gnat_choice);
! }
! /* Push a binding level here in case variables are declared since
! we want them to be local to this set of statements instead of
! the block containing the Case statement. */
! add_stmt (build_stmt_group (Statements (gnat_when), true));
! }
!
! gnu_result = build (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr,
! end_stmt_group (), NULL_TREE);
! break;
}
case N_Loop_Statement:
{
! /* ??? It would be nice to use "build" here, but there's no build5. */
! tree gnu_loop_stmt = build_nt (LOOP_STMT, NULL_TREE, NULL_TREE,
! NULL_TREE, NULL_TREE, NULL_TREE);
tree gnu_loop_var = NULL_TREE;
Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
! tree gnu_cond_expr = NULL_TREE;
!
! TREE_TYPE (gnu_loop_stmt) = void_type_node;
! TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
! annotate_with_node (gnu_loop_stmt, gnat_node);
!
! /* Save this LOOP_STMT in a stack so that the corresponding
! N_Exit_Statement can find it. */
! push_stack (&gnu_loop_stmt_stack, NULL_TREE, gnu_loop_stmt);
/* Set the condition that under which the loop should continue.
*************** tree_transform (Node_Id gnat_node)
*** 2343,2347 ****
/* The case "WHILE condition LOOP ..... END LOOP;" */
else if (Present (Condition (gnat_iter_scheme)))
! gnat_top_condition = Condition (gnat_iter_scheme);
else
{
--- 2152,2157 ----
/* The case "WHILE condition LOOP ..... END LOOP;" */
else if (Present (Condition (gnat_iter_scheme)))
! LOOP_STMT_TOP_COND (gnu_loop_stmt)
! = gnat_to_gnu (Condition (gnat_iter_scheme));
else
{
*************** tree_transform (Node_Id gnat_node)
*** 2372,2391 ****
|| tree_int_cst_equal (gnu_last, gnu_limit))
{
! gnu_expr = build_binary_op (LE_EXPR, integer_type_node,
! gnu_low, gnu_high);
! set_lineno (gnat_loop_spec, 1);
! expand_start_cond (gnu_expr, 0);
! enclosing_if_p = 1;
}
/* Open a new nesting level that will surround the loop to declare
the loop index variable. */
gnat_pushlevel ();
- expand_start_bindings (0);
/* Declare the loop index and set it to its initial value. */
- start_block_stmt ();
gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1);
- expand_expr_stmt (end_block_stmt (false));
if (DECL_BY_REF_P (gnu_loop_var))
gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE,
--- 2182,2200 ----
|| tree_int_cst_equal (gnu_last, gnu_limit))
{
! gnu_cond_expr
! = build (COND_EXPR, void_type_node,
! build_binary_op (LE_EXPR, integer_type_node,
! gnu_low, gnu_high),
! NULL_TREE, alloc_stmt_list ());
! annotate_with_node (gnu_cond_expr, gnat_loop_spec);
}
/* Open a new nesting level that will surround the loop to declare
the loop index variable. */
+ start_stmt_group ();
gnat_pushlevel ();
/* Declare the loop index and set it to its initial value. */
gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1);
if (DECL_BY_REF_P (gnu_loop_var))
gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE,
*************** tree_transform (Node_Id gnat_node)
*** 2399,2505 ****
appropriate depending on whether we know an overflow
cannot occur or not. */
! if (enclosing_if_p)
! gnu_bottom_condition
= build_binary_op (NE_EXPR, integer_type_node,
gnu_loop_var, gnu_last);
else
! gnu_top_condition
= build_binary_op (end_code, integer_type_node,
gnu_loop_var, gnu_last);
! gnu_update = reversep ? PREDECREMENT_EXPR : PREINCREMENT_EXPR;
}
- set_lineno (gnat_node, 1);
- if (gnu_loop_var)
- loop_id = expand_start_loop_continue_elsewhere (1);
- else
- loop_id = expand_start_loop (1);
-
/* If the loop was named, have the name point to this loop. In this
! case, the association is not a ..._DECL node; in fact, it isn't
! a GCC tree node at all. Since this name is referenced inside
! the loop, do it before we process the statements of the loop. */
if (Present (Identifier (gnat_node)))
! {
! tree gnu_loop_id = make_node (GNAT_LOOP_ID);
!
! TREE_LOOP_ID (gnu_loop_id) = loop_id;
! save_gnu_tree (Entity (Identifier (gnat_node)), gnu_loop_id, 1);
! }
!
! set_lineno (gnat_node, 1);
!
! /* We must evaluate the condition after we've entered the
! loop so that any expression actions get done in the right
! place. */
! if (Present (gnat_top_condition))
! gnu_top_condition = gnat_to_gnu (gnat_top_condition);
!
! expand_exit_loop_top_cond (0, gnu_top_condition);
!
! /* Make the loop body into its own block, so any allocated
! storage will be released every iteration. This is needed
! for stack allocation. */
!
! gnat_pushlevel ();
! gnu_block_stack
! = tree_cons (gnu_bottom_condition, NULL_TREE, gnu_block_stack);
! expand_start_bindings (0);
!
! for (gnat_statement = First (Statements (gnat_node));
! Present (gnat_statement);
! gnat_statement = Next (gnat_statement))
! gnat_to_code (gnat_statement);
!
! expand_end_bindings (NULL_TREE, block_has_vars (), -1);
! gnat_poplevel ();
! gnu_block_stack = TREE_CHAIN (gnu_block_stack);
!
! set_lineno (gnat_node, 1);
! expand_exit_loop_if_false (0, gnu_bottom_condition);
if (gnu_loop_var)
{
! expand_loop_continue_here ();
! gnu_expr = build_binary_op (gnu_update, TREE_TYPE (gnu_loop_var),
! gnu_loop_var,
! convert (TREE_TYPE (gnu_loop_var),
! integer_one_node));
! set_lineno (gnat_iter_scheme, 1);
! expand_expr_stmt (gnu_expr);
! }
!
! set_lineno (gnat_node, 1);
! expand_end_loop ();
!
! if (gnu_loop_var)
! {
! /* Close the nesting level that sourround the loop that was used to
! declare the loop index variable. */
! set_lineno (gnat_node, 1);
! expand_end_bindings (NULL_TREE, block_has_vars (), -1);
gnat_poplevel ();
}
! if (enclosing_if_p)
{
! set_lineno (gnat_node, 1);
! expand_end_cond ();
}
}
break;
case N_Block_Statement:
gnat_pushlevel ();
- gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack);
- expand_start_bindings (0);
- start_block_stmt ();
process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
! gnat_expand_stmt (end_block_stmt (false));
! gnat_to_code (Handled_Statement_Sequence (gnat_node));
! expand_end_bindings (NULL_TREE, block_has_vars (), -1);
gnat_poplevel ();
! gnu_block_stack = TREE_CHAIN (gnu_block_stack);
if (Present (Identifier (gnat_node)))
mark_out_of_scope (Entity (Identifier (gnat_node)));
--- 2208,2274 ----
appropriate depending on whether we know an overflow
cannot occur or not. */
! if (gnu_cond_expr)
! LOOP_STMT_BOT_COND (gnu_loop_stmt)
= build_binary_op (NE_EXPR, integer_type_node,
gnu_loop_var, gnu_last);
else
! LOOP_STMT_TOP_COND (gnu_loop_stmt)
= build_binary_op (end_code, integer_type_node,
gnu_loop_var, gnu_last);
! LOOP_STMT_UPDATE (gnu_loop_stmt)
! = build_binary_op (reversep ? PREDECREMENT_EXPR
! : PREINCREMENT_EXPR,
! TREE_TYPE (gnu_loop_var),
! gnu_loop_var,
! convert (TREE_TYPE (gnu_loop_var),
! integer_one_node));
! annotate_with_node (LOOP_STMT_UPDATE (gnu_loop_stmt),
! gnat_iter_scheme);
}
/* If the loop was named, have the name point to this loop. In this
! case, the association is not a ..._DECL node, but this LOOP_STMT. */
if (Present (Identifier (gnat_node)))
! save_gnu_tree (Entity (Identifier (gnat_node)), gnu_loop_stmt, 1);
+ /* Make the loop body into its own block, so any allocated storage
+ will be released every iteration. This is needed for stack
+ allocation. */
+ LOOP_STMT_BODY (gnu_loop_stmt)
+ = build_stmt_group (Statements (gnat_node), true);
+
+ /* If we declared a variable, then we are in a statement group for
+ that declaration. Add the LOOP_STMT to it and make that the
+ "loop". */
if (gnu_loop_var)
{
! add_stmt (gnu_loop_stmt);
gnat_poplevel ();
+ gnu_loop_stmt = end_stmt_group ();
}
! /* If we have an outer COND_EXPR, that's our result and this loop
! is its "true" statement. Otherwise, the result is the LOOP_STMT. */
! if (gnu_cond_expr)
{
! COND_EXPR_THEN (gnu_cond_expr) = gnu_loop_stmt;
! gnu_result = gnu_cond_expr;
}
+ else
+ gnu_result = gnu_loop_stmt;
+
+ pop_stack (&gnu_loop_stmt_stack);
}
break;
case N_Block_Statement:
+ start_stmt_group ();
gnat_pushlevel ();
process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
! add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node)));
gnat_poplevel ();
! gnu_result = end_stmt_group ();
!
if (Present (Identifier (gnat_node)))
mark_out_of_scope (Entity (Identifier (gnat_node)));
*************** tree_transform (Node_Id gnat_node)
*** 2507,2528 ****
case N_Exit_Statement:
! {
! /* Which loop to exit, NULL if the current loop. */
! struct nesting *loop_id = 0;
! /* The GCC version of the optional GNAT condition node attached to the
! exit statement. Exit the loop if this is false. */
! tree gnu_cond = integer_zero_node;
!
! if (Present (Name (gnat_node)))
! loop_id
! = TREE_LOOP_ID (get_gnu_tree (Entity (Name (gnat_node))));
!
! if (Present (Condition (gnat_node)))
! gnu_cond = invert_truthvalue (gnat_truthvalue_conversion
! (gnat_to_gnu (Condition (gnat_node))));
!
! set_lineno (gnat_node, 1);
! expand_exit_loop_if_false (loop_id, gnu_cond);
! }
break;
--- 2276,2286 ----
case N_Exit_Statement:
! gnu_result
! = build (EXIT_STMT, void_type_node,
! (Present (Condition (gnat_node))
! ? gnat_to_gnu (Condition (gnat_node)) : NULL_TREE),
! (Present (Name (gnat_node))
! ? get_gnu_tree (Entity (Name (gnat_node)))
! : TREE_VALUE (gnu_loop_stmt_stack)));
break;
*************** tree_transform (Node_Id gnat_node)
*** 2548,2553 ****
if (TREE_VALUE (gnu_return_label_stack) != 0)
{
! gnu_result = build_nt (GOTO_STMT,
! TREE_VALUE (gnu_return_label_stack));
break;
}
--- 2306,2311 ----
if (TREE_VALUE (gnu_return_label_stack) != 0)
{
! gnu_result = build1 (GOTO_EXPR, void_type_node,
! TREE_VALUE (gnu_return_label_stack));
break;
}
*************** tree_transform (Node_Id gnat_node)
*** 2611,2620 ****
}
! gnu_result = build_nt (RETURN_STMT, gnu_ret_val);
}
break;
case N_Goto_Statement:
! gnu_result = build_nt (GOTO_STMT, gnat_to_gnu (Name (gnat_node)));
break;
--- 2369,2384 ----
}
! gnu_result = build1 (RETURN_EXPR, void_type_node,
! (gnu_ret_val
! ? build (MODIFY_EXPR, TREE_TYPE (gnu_ret_val),
! DECL_RESULT (current_function_decl),
! gnu_ret_val)
! : NULL_TREE));
}
break;
case N_Goto_Statement:
! gnu_result = build1 (GOTO_EXPR, void_type_node,
! gnat_to_gnu (Name (gnat_node)));
break;
*************** tree_transform (Node_Id gnat_node)
*** 2632,2636 ****
gnat_to_gnu_entity (Defining_Entity (Specification (gnat_node)),
NULL_TREE, 1);
!
break;
--- 2396,2400 ----
gnat_to_gnu_entity (Defining_Entity (Specification (gnat_node)),
NULL_TREE, 1);
! gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 2647,2650 ****
--- 2411,2415 ----
gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0);
+ gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 2653,2657 ****
specificaton. We get this when we try to find the spec of
a child unit package that is the compilation unit being compiled. */
! gnat_to_code (Parent (gnat_node));
break;
--- 2418,2422 ----
specificaton. We get this when we try to find the spec of
a child unit package that is the compilation unit being compiled. */
! gnu_result = gnat_to_gnu (Parent (gnat_node));
break;
*************** tree_transform (Node_Id gnat_node)
*** 2680,2691 ****
/* If this is a generic object or if it has been eliminated,
ignore it. */
-
if (Ekind (gnat_subprog_id) == E_Generic_Procedure
|| Ekind (gnat_subprog_id) == E_Generic_Function
|| Is_Eliminated (gnat_subprog_id))
! break;
! /* If debug information is suppressed for the subprogram,
! turn debug mode off for the duration of processing. */
if (!Needs_Debug_Info (gnat_subprog_id))
{
--- 2445,2455 ----
/* If this is a generic object or if it has been eliminated,
ignore it. */
if (Ekind (gnat_subprog_id) == E_Generic_Procedure
|| Ekind (gnat_subprog_id) == E_Generic_Function
|| Is_Eliminated (gnat_subprog_id))
! return alloc_stmt_list ();
! /* If debug information is suppressed for the subprogram, turn debug
! mode off for the duration of processing. */
if (!Needs_Debug_Info (gnat_subprog_id))
{
*************** tree_transform (Node_Id gnat_node)
*** 2696,2704 ****
/* If this subprogram acts as its own spec, define it. Otherwise,
just get the already-elaborated tree node. However, if this
! subprogram had its elaboration deferred, we will already have
! made a tree node for it. So treat it as not being defined in
! that case. Such a subprogram cannot have an address clause or
! a freeze node, so this test is safe, though it does disable
! some otherwise-useful error checking. */
gnu_subprog_decl
= gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE,
--- 2460,2468 ----
/* If this subprogram acts as its own spec, define it. Otherwise,
just get the already-elaborated tree node. However, if this
! subprogram had its elaboration deferred, we will already have made
! a tree node for it. So treat it as not being defined in that
! case. Such a subprogram cannot have an address clause or a freeze
! node, so this test is safe, though it does disable some
! otherwise-useful error checking. */
gnu_subprog_decl
= gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE,
*************** tree_transform (Node_Id gnat_node)
*** 2708,2711 ****
--- 2472,2480 ----
gnu_subprog_type = TREE_TYPE (gnu_subprog_decl);
+ /* We handle pending sizes via the elaboration of types, so we don't
+ need to save them. This causes them to be marked as part of the
+ outer function and then discarded. */
+ get_pending_sizes ();
+
/* ??? Temporarily do this to avoid GC throwing away outer stuff. */
ggc_push_context ();
*************** tree_transform (Node_Id gnat_node)
*** 2714,2756 ****
the body so that the line number notes are written
correctly. */
! set_lineno (gnat_node, 0);
! DECL_SOURCE_LOCATION (gnu_subprog_decl) = input_location;
!
! begin_subprog_body (gnu_subprog_decl);
! /* There used to be a second call to set_lineno here, with
! write_note_p set, but begin_subprog_body actually already emits the
! note we want (via init_function_start).
!
! Emitting a second note here was necessary for -ftest-coverage with
! GCC 2.8.1, as the first one was skipped by branch_prob. This is no
! longer the case with GCC 3.x, so emitting a second note here would
! result in having the first line of the subprogram counted twice by
! gcov. */
gnat_pushlevel ();
! gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack);
! expand_start_bindings (0);
! start_block_stmt ();
!
gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
! /* If there are OUT parameters, we need to ensure that the
! return statement properly copies them out. We do this by
! making a new block and converting any inner return into a goto
! to a label at the end of the block. */
! if (gnu_cico_list != 0)
! {
! gnu_return_label_stack
! = tree_cons (NULL_TREE,
! build_decl (LABEL_DECL, NULL_TREE, NULL_TREE),
! gnu_return_label_stack);
! gnat_pushlevel ();
! expand_start_bindings (0);
! }
! else
! gnu_return_label_stack
! = tree_cons (NULL_TREE, NULL_TREE, gnu_return_label_stack);
/* See if there are any parameters for which we don't yet have
--- 2483,2512 ----
the body so that the line number notes are written
correctly. */
! Sloc_to_locus (Sloc (gnat_node),
! &DECL_SOURCE_LOCATION (gnu_subprog_decl));
! current_function_decl = gnu_subprog_decl;
! announce_function (gnu_subprog_decl);
+ /* Enter a new binding level and show that all the parameters belong to
+ this function. */
gnat_pushlevel ();
! for (gnu_expr = DECL_ARGUMENTS (gnu_subprog_decl); gnu_expr;
! gnu_expr = TREE_CHAIN (gnu_expr))
! DECL_CONTEXT (gnu_expr) = gnu_subprog_decl;
!
! make_decl_rtl (gnu_subprog_decl, NULL);
gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
! /* If there are OUT parameters, we need to ensure that the return
! statement properly copies them out. We do this by making a new
! block and converting any inner return into a goto to a label at
! the end of the block. */
! push_stack (&gnu_return_label_stack, NULL_TREE,
! gnu_cico_list ? create_artificial_label () : NULL_TREE);
! /* Get a tree corresponding to the code for the subprogram. */
! start_stmt_group ();
! gnat_pushlevel ();
/* See if there are any parameters for which we don't yet have
*************** tree_transform (Node_Id gnat_node)
*** 2760,2764 ****
We can match up the entries because TYPE_CI_CO_LIST is in the
order of the parameters. */
-
for (gnat_param = First_Formal (gnat_subprog_id);
Present (gnat_param);
--- 2516,2519 ----
*************** tree_transform (Node_Id gnat_node)
*** 2778,2809 ****
}
- gnat_expand_stmt (end_block_stmt (false));
- start_block_stmt ();
process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
- gnat_expand_stmt (end_block_stmt (false));
/* Generate the code of the subprogram itself. A return statement
will be present and any OUT parameters will be handled there. */
! gnat_to_code (Handled_Statement_Sequence (gnat_node));
!
! expand_end_bindings (NULL_TREE, block_has_vars (), -1);
gnat_poplevel ();
! gnu_block_stack = TREE_CHAIN (gnu_block_stack);
if (TREE_VALUE (gnu_return_label_stack) != 0)
{
tree gnu_retval;
! expand_end_bindings (NULL_TREE, block_has_vars (), -1);
! gnat_poplevel ();
! expand_label (TREE_VALUE (gnu_return_label_stack));
gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
- set_lineno (gnat_node, 1);
if (list_length (gnu_cico_list) == 1)
gnu_retval = TREE_VALUE (gnu_cico_list);
else
! gnu_retval = gnat_build_constructor (TREE_TYPE (gnu_subprog_type),
! gnu_cico_list);
if (DECL_P (gnu_retval) && DECL_BY_REF_P (gnu_retval))
--- 2533,2565 ----
}
process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
/* Generate the code of the subprogram itself. A return statement
will be present and any OUT parameters will be handled there. */
! add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node)));
gnat_poplevel ();
! gnu_result = end_stmt_group ();
+ /* If we made a special return label, we need to make a block that
+ contains the definition of that label and the copying to the
+ return value. That block first contains the function, then
+ the label and copy statement. */
if (TREE_VALUE (gnu_return_label_stack) != 0)
{
tree gnu_retval;
! start_stmt_group ();
! gnat_pushlevel ();
! add_stmt (gnu_result);
! add_stmt (build1 (LABEL_EXPR, void_type_node,
! TREE_VALUE (gnu_return_label_stack)));
gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
if (list_length (gnu_cico_list) == 1)
gnu_retval = TREE_VALUE (gnu_cico_list);
else
! gnu_retval
! = gnat_build_constructor (TREE_TYPE (gnu_subprog_type),
! gnu_cico_list);
if (DECL_P (gnu_retval) && DECL_BY_REF_P (gnu_retval))
*************** tree_transform (Node_Id gnat_node)
*** 2811,2822 ****
= build_unary_op (INDIRECT_REF, NULL_TREE, gnu_retval);
! expand_return
! (build_binary_op (MODIFY_EXPR, NULL_TREE,
! DECL_RESULT (current_function_decl),
! gnu_retval));
!
}
! gnu_return_label_stack = TREE_CHAIN (gnu_return_label_stack);
/* Disconnect the trees for parameters that we made variables for
--- 2567,2585 ----
= build_unary_op (INDIRECT_REF, NULL_TREE, gnu_retval);
! add_stmt_with_node
! (build1 (RETURN_EXPR, void_type_node,
! build (MODIFY_EXPR, TREE_TYPE (gnu_retval),
! DECL_RESULT (current_function_decl),
! gnu_retval)),
! gnat_node);
! gnat_poplevel ();
! gnu_result = end_stmt_group ();
}
! pop_stack (&gnu_return_label_stack);
! if (!type_annotate_only)
! add_decl_stmt (current_function_decl, gnat_node);
!
! end_subprog_body (gnu_result);
/* Disconnect the trees for parameters that we made variables for
*************** tree_transform (Node_Id gnat_node)
*** 2829,2837 ****
save_gnu_tree (gnat_param, NULL_TREE, 0);
- end_subprog_body ();
mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node)));
write_symbols = save_write_symbols;
debug_hooks = save_debug_hooks;
ggc_pop_context ();
}
break;
--- 2592,2600 ----
save_gnu_tree (gnat_param, NULL_TREE, 0);
mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node)));
write_symbols = save_write_symbols;
debug_hooks = save_debug_hooks;
ggc_pop_context ();
+ gnu_result = alloc_stmt_list ();
}
break;
*************** tree_transform (Node_Id gnat_node)
*** 2879,2883 ****
Present (gnat_actual);
gnat_actual = Next_Actual (gnat_actual))
! expand_expr_stmt (gnat_to_gnu (gnat_actual));
if (Nkind (gnat_node) == N_Function_Call)
--- 2642,2646 ----
Present (gnat_actual);
gnat_actual = Next_Actual (gnat_actual))
! add_stmt (gnat_to_gnu (gnat_actual));
if (Nkind (gnat_node) == N_Function_Call)
*************** tree_transform (Node_Id gnat_node)
*** 2889,2895 ****
}
else
! gnu_result
! = build_nt (EXPR_STMT,
! build_call_raise (PE_Stubbed_Subprogram_Called));
break;
}
--- 2652,2656 ----
}
else
! gnu_result = build_call_raise (PE_Stubbed_Subprogram_Called);
break;
}
*************** tree_transform (Node_Id gnat_node)
*** 2983,2995 ****
/* Set up to move the copy back to the original. */
! gnu_temp
! = build_nt (EXPR_STMT,
! build (MODIFY_EXPR, TREE_TYPE (gnu_copy),
! gnu_copy, gnu_actual));
!
! TREE_TYPE (gnu_temp) = void_type_node;
! TREE_SLOC (gnu_temp) = Sloc (gnat_actual);
! TREE_CHAIN (gnu_temp) = gnu_after_list;
! gnu_after_list = gnu_temp;
}
}
--- 2744,2751 ----
/* Set up to move the copy back to the original. */
! gnu_temp = build (MODIFY_EXPR, TREE_TYPE (gnu_copy),
! gnu_copy, gnu_actual);
! annotate_with_node (gnu_temp, gnat_actual);
! append_to_statement_list (gnu_temp, &gnu_after_list);
}
}
*************** tree_transform (Node_Id gnat_node)
*** 3287,3298 ****
}
! gnu_result
! = build_nt (EXPR_STMT,
! build_binary_op (MODIFY_EXPR, NULL_TREE,
! gnu_actual, gnu_result));
! TREE_TYPE (gnu_result) = void_type_node;
! TREE_SLOC (gnu_result) = Sloc (gnat_actual);
! TREE_CHAIN (gnu_result) = gnu_before_list;
! gnu_before_list = gnu_result;
scalar_return_list = TREE_CHAIN (scalar_return_list);
gnu_name_list = TREE_CHAIN (gnu_name_list);
--- 3043,3050 ----
}
! gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
! gnu_actual, gnu_result);
! annotate_with_node (gnu_result, gnat_actual);
! append_to_statement_list (gnu_result, &gnu_before_list);
scalar_return_list = TREE_CHAIN (scalar_return_list);
gnu_name_list = TREE_CHAIN (gnu_name_list);
*************** tree_transform (Node_Id gnat_node)
*** 3301,3313 ****
else
{
! gnu_before_list = build_nt (EXPR_STMT, gnu_subprog_call);
! TREE_TYPE (gnu_before_list) = void_type_node;
! TREE_SLOC (gnu_before_list) = Sloc (gnat_node);
}
! gnu_result = chainon (nreverse (gnu_before_list),
! nreverse (gnu_after_list));
! if (TREE_CHAIN (gnu_result))
! gnu_result = build_nt (BLOCK_STMT, gnu_result, NULL_TREE);
}
break;
--- 3053,3062 ----
else
{
! annotate_with_node (gnu_subprog_call, gnat_node);
! append_to_statement_list (gnu_subprog_call, &gnu_before_list);
}
! append_to_statement_list (gnu_after_list, &gnu_before_list);
! gnu_result = gnu_before_list;
}
break;
*************** tree_transform (Node_Id gnat_node)
*** 3318,3330 ****
case N_Package_Declaration:
! gnat_to_code (Specification (gnat_node));
break;
case N_Package_Specification:
! start_block_stmt ();
process_decls (Visible_Declarations (gnat_node),
Private_Declarations (gnat_node), Empty, 1, 1);
! gnat_expand_stmt (end_block_stmt (false));
break;
--- 3067,3079 ----
case N_Package_Declaration:
! gnu_result = gnat_to_gnu (Specification (gnat_node));
break;
case N_Package_Specification:
! start_stmt_group ();
process_decls (Visible_Declarations (gnat_node),
Private_Declarations (gnat_node), Empty, 1, 1);
! gnu_result = end_stmt_group ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 3333,3348 ****
/* If this is the body of a generic package - do nothing */
if (Ekind (Corresponding_Spec (gnat_node)) == E_Generic_Package)
! break;
! start_block_stmt ();
process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
- gnat_expand_stmt (end_block_stmt (false));
if (Present (Handled_Statement_Sequence (gnat_node)))
! {
! gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack);
! gnat_to_code (Handled_Statement_Sequence (gnat_node));
! gnu_block_stack = TREE_CHAIN (gnu_block_stack);
! }
break;
--- 3082,3097 ----
/* If this is the body of a generic package - do nothing */
if (Ekind (Corresponding_Spec (gnat_node)) == E_Generic_Package)
! {
! gnu_result = alloc_stmt_list ();
! break;
! }
! start_stmt_group ();
process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
if (Present (Handled_Statement_Sequence (gnat_node)))
! add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node)));
!
! gnu_result = end_stmt_group ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 3354,3357 ****
--- 3103,3107 ----
case N_Use_Type_Clause:
/* Nothing to do here - but these may appear in list of declarations */
+ gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 3361,3368 ****
--- 3111,3120 ----
case N_Protected_Type_Declaration:
+ gnu_result = alloc_stmt_list ();
break;
case N_Single_Task_Declaration:
gnat_to_gnu_entity (Defining_Entity (gnat_node), NULL_TREE, 1);
+ gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 3373,3381 ****
case N_Compilation_Unit:
/* For a body, first process the spec if there is one. */
if (Nkind (Unit (gnat_node)) == N_Package_Body
|| (Nkind (Unit (gnat_node)) == N_Subprogram_Body
&& ! Acts_As_Spec (gnat_node)))
! gnat_to_code (Library_Unit (gnat_node));
process_inlined_subprograms (gnat_node);
--- 3125,3135 ----
case N_Compilation_Unit:
+ start_stmt_group ();
+
/* For a body, first process the spec if there is one. */
if (Nkind (Unit (gnat_node)) == N_Package_Body
|| (Nkind (Unit (gnat_node)) == N_Subprogram_Body
&& ! Acts_As_Spec (gnat_node)))
! add_stmt (gnat_to_gnu (Library_Unit (gnat_node)));
process_inlined_subprograms (gnat_node);
*************** tree_transform (Node_Id gnat_node)
*** 3388,3424 ****
|| Nkind (Unit (gnat_node)) == N_Generic_Package_Declaration
|| Nkind (Unit (gnat_node)) == N_Generic_Subprogram_Declaration)
! break;
! };
- start_block_stmt();
process_decls (Declarations (Aux_Decls_Node (gnat_node)),
Empty, Empty, 1, 1);
! gnat_expand_stmt (end_block_stmt (false));
!
! gnat_to_code (Unit (gnat_node));
!
! /* Process any pragmas following the unit. */
! if (Present (Pragmas_After (Aux_Decls_Node (gnat_node))))
! for (gnat_temp = First (Pragmas_After (Aux_Decls_Node (gnat_node)));
! gnat_temp; gnat_temp = Next (gnat_temp))
! gnat_to_code (gnat_temp);
!
! /* Put all the Actions into the elaboration routine if we already had
! elaborations. This will happen anyway if they are statements, but we
! want to force declarations there too due to order-of-elaboration
! issues. Most should have Is_Statically_Allocated set. If we
! have had no elaborations, we have no order-of-elaboration issue and
! don't want to create elaborations here. */
! if (Is_Non_Empty_List (Actions (Aux_Decls_Node (gnat_node))))
! for (gnat_temp = First (Actions (Aux_Decls_Node (gnat_node)));
! Present (gnat_temp); gnat_temp = Next (gnat_temp))
! {
! if (pending_elaborations_p ())
! add_pending_elaborations (NULL_TREE,
! make_transform_expr (gnat_temp));
! else
! gnat_to_code (gnat_temp);
! }
/* Generate elaboration code for this unit, if necessary, and
say whether we did or not. */
--- 3142,3159 ----
|| Nkind (Unit (gnat_node)) == N_Generic_Package_Declaration
|| Nkind (Unit (gnat_node)) == N_Generic_Subprogram_Declaration)
! {
! gnu_result = end_stmt_group ();
! break;
! }
! }
process_decls (Declarations (Aux_Decls_Node (gnat_node)),
Empty, Empty, 1, 1);
! add_stmt (gnat_to_gnu (Unit (gnat_node)));
+ /* Process any pragmas and actions following the unit. */
+ add_stmt_list (Pragmas_After (Aux_Decls_Node (gnat_node)));
+ add_stmt_list (Actions (Aux_Decls_Node (gnat_node)));
+
/* Generate elaboration code for this unit, if necessary, and
say whether we did or not. */
*************** tree_transform (Node_Id gnat_node)
*** 3431,3434 ****
--- 3166,3170 ----
get_pending_elaborations ()));
+ gnu_result = end_stmt_group ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 3438,3446 ****
case N_Task_Body_Stub:
/* Simply process whatever unit is being inserted. */
! gnat_to_code (Unit (Library_Unit (gnat_node)));
break;
case N_Subunit:
! gnat_to_code (Proper_Body (gnat_node));
break;
--- 3174,3182 ----
case N_Task_Body_Stub:
/* Simply process whatever unit is being inserted. */
! gnu_result = gnat_to_gnu (Unit (Library_Unit (gnat_node)));
break;
case N_Subunit:
! gnu_result = gnat_to_gnu (Proper_Body (gnat_node));
break;
*************** tree_transform (Node_Id gnat_node)
*** 3475,3483 ****
/* If there is an At_End procedure attached to this node, and the eh
! mechanism is GNAT oriented (SJLJ or ZCX with front end tables), we
! must have at least a corresponding At_End handler, unless the
! No_Exception_Handlers restriction is set. */
if (! type_annotate_only
! && Exception_Mechanism != GCC_ZCX
&& Present (At_End_Proc (gnat_node))
&& ! Present (Exception_Handlers (gnat_node))
--- 3211,3218 ----
/* If there is an At_End procedure attached to this node, and the eh
! mechanism is SJLJ, we must have at least a corresponding At_End
! handler, unless the No_Exception_Handlers restriction is set. */
if (! type_annotate_only
! && Exception_Mechanism == Setjmp_Longjmp
&& Present (At_End_Proc (gnat_node))
&& ! Present (Exception_Handlers (gnat_node))
*************** tree_transform (Node_Id gnat_node)
*** 3486,3683 ****
{
! /* Need a binding level that we can exit for this sequence if there is
! at least one exception handler for this block (since each handler
! needs an identified exit point) or there is an At_End procedure
! attached to this node (in order to have an attachment point for a
! GCC cleanup). */
! bool exitable_binding_for_block
! = (! type_annotate_only
! && (Present (Exception_Handlers (gnat_node))
! || Present (At_End_Proc (gnat_node))));
!
! /* Make a binding level that we can exit if we need one. */
! if (exitable_binding_for_block)
{
gnat_pushlevel ();
- expand_start_bindings (1);
- }
-
- /* If we are to call a function when exiting this block, expand a GCC
- cleanup to take care. We have made a binding level for this cleanup
- above. */
- if (Present (At_End_Proc (gnat_node)))
- {
- tree gnu_cleanup_call
- = build_call_0_expr (gnat_to_gnu (At_End_Proc (gnat_node)));
-
- tree gnu_cleanup_decl
- = create_var_decl (get_identifier ("CLEANUP"), NULL_TREE,
- integer_type_node, NULL_TREE, 0, 0, 0, 0,
- 0);
-
- start_block_stmt ();
- add_decl_stmt (gnu_cleanup_decl, gnat_node);
- gnat_expand_stmt (end_block_stmt (false));
- expand_decl_cleanup (gnu_cleanup_decl, gnu_cleanup_call);
}
! /* Now we generate the code for this block, with a different layout
! for GNAT SJLJ and for GCC or front end ZCX. The handlers come first
! in the GNAT SJLJ case, while they come after the handled sequence
! in the other cases. */
!
! /* First deal with possible handlers for the GNAT SJLJ scheme. */
! if (! type_annotate_only
! && Exception_Mechanism == Setjmp_Longjmp
! && Present (Exception_Handlers (gnat_node)))
{
! /* We already have a fresh binding level at hand. Declare a
! variable to save the old __gnat_jmpbuf value and a variable for
! our jmpbuf. Call setjmp and handle each of the possible
! exceptions if it returns one. */
!
! tree gnu_jmpsave_decl
= create_var_decl (get_identifier ("JMPBUF_SAVE"), NULL_TREE,
jmpbuf_ptr_type,
build_call_0_expr (get_jmpbuf_decl),
0, 0, 0, 0, 0);
!
! tree gnu_jmpbuf_decl
= create_var_decl (get_identifier ("JMP_BUF"),
NULL_TREE, jmpbuf_type,
! NULL_TREE, 0, 0, 0, 0,
! 0);
- start_block_stmt ();
add_decl_stmt (gnu_jmpsave_decl, gnat_node);
add_decl_stmt (gnu_jmpbuf_decl, gnat_node);
! gnat_expand_stmt (end_block_stmt (false));
!
! TREE_VALUE (gnu_block_stack) = gnu_jmpbuf_decl;
/* When we exit this block, restore the saved value. */
! expand_decl_cleanup (gnu_jmpsave_decl,
! build_call_1_expr (set_jmpbuf_decl,
! gnu_jmpsave_decl));
!
! /* Call setjmp and handle exceptions if it returns one. */
! set_lineno (gnat_node, 1);
! expand_start_cond
! (build_call_1_expr (setjmp_decl,
! build_unary_op (ADDR_EXPR, NULL_TREE,
! gnu_jmpbuf_decl)),
! 0);
! /* Restore our incoming longjmp value before we do anything. */
! expand_expr_stmt
! (build_call_1_expr (set_jmpbuf_decl, gnu_jmpsave_decl));
/* Make a binding level for the exception handling declarations
! and code. Don't assign it an exit label, since this is the
! outer block we want to exit at the end of each handler. */
gnat_pushlevel ();
- expand_start_bindings (0);
! gnu_except_ptr_stack
! = tree_cons (NULL_TREE,
! create_var_decl
! (get_identifier ("EXCEPT_PTR"), NULL_TREE,
! build_pointer_type (except_type_node),
! build_call_0_expr (get_excptr_decl),
! 0, 0, 0, 0, 0),
! gnu_except_ptr_stack);
! start_block_stmt ();
add_decl_stmt (TREE_VALUE (gnu_except_ptr_stack), gnat_node);
- gnat_expand_stmt (end_block_stmt (false));
/* Generate code for each handler. The N_Exception_Handler case
! below does the real work. We ignore the dummy exception handler
! for the identifier case, as this is used only by the front
! end. */
for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node));
Present (gnat_temp);
gnat_temp = Next_Non_Pragma (gnat_temp))
! gnat_to_code (gnat_temp);
! /* If none of the exception handlers did anything, re-raise
! but do not defer abortion. */
! set_lineno (gnat_node, 1);
! expand_expr_stmt
! (build_call_1_expr (raise_nodefer_decl,
! TREE_VALUE (gnu_except_ptr_stack)));
! gnu_except_ptr_stack = TREE_CHAIN (gnu_except_ptr_stack);
! /* End the binding level dedicated to the exception handlers. */
! expand_end_bindings (NULL_TREE, block_has_vars (), -1);
gnat_poplevel ();
! /* End the "if" on setjmp. Note that we have arranged things so
! control never returns here. */
! expand_end_cond ();
!
! /* This is now immediately before the body proper. Set our jmp_buf
! as the current buffer. */
! expand_expr_stmt
! (build_call_1_expr (set_jmpbuf_decl,
build_unary_op (ADDR_EXPR, NULL_TREE,
! gnu_jmpbuf_decl)));
}
!
! /* Now comes the processing for the sequence body. */
!
! /* If we use the back-end eh support, tell the back-end we are
! starting a new exception region. */
! if (! type_annotate_only
! && Exception_Mechanism == GCC_ZCX
! && Present (Exception_Handlers (gnat_node)))
! expand_eh_region_start ();
!
! /* Generate code and declarations for the prefix of this block,
! if any. */
! start_block_stmt ();
! if (Present (First_Real_Statement (gnat_node)))
! process_decls (Statements (gnat_node), Empty,
! First_Real_Statement (gnat_node), 1, 1);
! gnat_expand_stmt (end_block_stmt (false));
!
! /* Generate code for each statement in the block. */
! for (gnat_temp = (Present (First_Real_Statement (gnat_node))
! ? First_Real_Statement (gnat_node)
! : First (Statements (gnat_node)));
! Present (gnat_temp);
! gnat_temp = Next (gnat_temp))
! gnat_to_code (gnat_temp);
!
! /* Exit the binding level we made, if any. */
! if (exitable_binding_for_block)
! expand_exit_something ();
!
! /* Compile the handlers for front end ZCX or back-end supported
! exceptions. */
! if (! type_annotate_only
! && Exception_Mechanism != Setjmp_Longjmp
! && Present (Exception_Handlers (gnat_node)))
{
! if (Exception_Mechanism == GCC_ZCX)
! expand_start_all_catch ();
for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node));
Present (gnat_temp);
gnat_temp = Next_Non_Pragma (gnat_temp))
! gnat_to_code (gnat_temp);
! if (Exception_Mechanism == GCC_ZCX)
! expand_end_all_catch ();
}
! /* Close the binding level we made, if any. */
! if (exitable_binding_for_block)
{
! expand_end_bindings (NULL_TREE, block_has_vars (), -1);
gnat_poplevel ();
}
}
-
break;
--- 3221,3401 ----
{
! tree gnu_jmpsave_decl = NULL_TREE;
! tree gnu_jmpbuf_decl = NULL_TREE;
! /* If just annotating, ignore all EH and cleanups. */
! bool gcc_zcx
! = (!type_annotate_only && Present (Exception_Handlers (gnat_node))
! && Exception_Mechanism == GCC_ZCX);
! bool setjmp_longjmp
! = (!type_annotate_only && Present (Exception_Handlers (gnat_node))
! && Exception_Mechanism == Setjmp_Longjmp);
! bool at_end = !type_annotate_only && Present (At_End_Proc (gnat_node));
! bool binding_for_block = (at_end || gcc_zcx || setjmp_longjmp);
! /* The statement(s) for the block itself. */
! tree gnu_inner_block;
!
! /* If there are any exceptions or cleanup processing involved, we need
! an outer statement group (for Setjmp_Longjmp) and binding level. */
! if (binding_for_block)
{
+ start_stmt_group ();
gnat_pushlevel ();
}
! /* If we are to call a function when exiting this block add a cleanup
! to the binding level we made above. */
! if (at_end)
! add_cleanup (build_call_0_expr
! (gnat_to_gnu (At_End_Proc (gnat_node))));
!
! /* If using setjmp_longjmp, make the variables for the setjmp
! buffer and save area for address of previous buffer. Do this
! first since we need to have the setjmp buf known for any decls
! in this block. */
! if (setjmp_longjmp)
{
! gnu_jmpsave_decl
= create_var_decl (get_identifier ("JMPBUF_SAVE"), NULL_TREE,
jmpbuf_ptr_type,
build_call_0_expr (get_jmpbuf_decl),
0, 0, 0, 0, 0);
! gnu_jmpbuf_decl
= create_var_decl (get_identifier ("JMP_BUF"),
NULL_TREE, jmpbuf_type,
! NULL_TREE, 0, 0, 0, 0, 0);
add_decl_stmt (gnu_jmpsave_decl, gnat_node);
add_decl_stmt (gnu_jmpbuf_decl, gnat_node);
! set_block_jmpbuf_decl (gnu_jmpbuf_decl);
/* When we exit this block, restore the saved value. */
! add_cleanup (build_call_1_expr (set_jmpbuf_decl,
! gnu_jmpsave_decl));
! }
!
! /* Now build the tree for the declarations and statements inside this
! block. If this is SJLJ, set our jmp_buf as the current buffer. */
! start_stmt_group ();
! if (setjmp_longjmp)
! add_stmt (build_call_1_expr
! (set_jmpbuf_decl,
! build_unary_op (ADDR_EXPR, NULL_TREE, gnu_jmpbuf_decl)));
!
!
! if (Present (First_Real_Statement (gnat_node)))
! process_decls (Statements (gnat_node), Empty,
! First_Real_Statement (gnat_node), 1, 1);
!
! /* Generate code for each statement in the block. */
! for (gnat_temp = (Present (First_Real_Statement (gnat_node))
! ? First_Real_Statement (gnat_node)
! : First (Statements (gnat_node)));
! Present (gnat_temp); gnat_temp = Next (gnat_temp))
! add_stmt (gnat_to_gnu (gnat_temp));
! gnu_inner_block = end_stmt_group ();
!
! /* Now generate code for the two exception models, if either is
! relevant for this block. */
! if (setjmp_longjmp)
! {
! tree *gnu_else_ptr = 0;
! tree gnu_handler;
/* Make a binding level for the exception handling declarations
! and code and set up gnu_except_ptr_stack for the handlers
! to use. */
! start_stmt_group ();
gnat_pushlevel ();
! push_stack (&gnu_except_ptr_stack, NULL_TREE,
! create_var_decl (get_identifier ("EXCEPT_PTR"),
! NULL_TREE,
! build_pointer_type (except_type_node),
! build_call_0_expr (get_excptr_decl),
! 0, 0, 0, 0, 0));
add_decl_stmt (TREE_VALUE (gnu_except_ptr_stack), gnat_node);
/* Generate code for each handler. The N_Exception_Handler case
! below does the real work and returns a COND_EXPR for each
! handler, which we chain together here. */
for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node));
Present (gnat_temp);
gnat_temp = Next_Non_Pragma (gnat_temp))
! {
! gnu_expr = gnat_to_gnu (gnat_temp);
!
! /* If this is the first one, set it as the outer one.
! Otherwise, point the "else" part of the previous handler
! to us. Then point to our "else" part. */
! if (!gnu_else_ptr)
! add_stmt (gnu_expr);
! else
! *gnu_else_ptr = gnu_expr;
! gnu_else_ptr = &COND_EXPR_ELSE (gnu_expr);
! }
! /* If none of the exception handlers did anything, re-raise but
! do not defer abortion. */
! gnu_expr = build_call_1_expr (raise_nodefer_decl,
! TREE_VALUE (gnu_except_ptr_stack));
! annotate_with_node (gnu_expr, gnat_node);
! if (gnu_else_ptr)
! *gnu_else_ptr = gnu_expr;
! else
! add_stmt (gnu_expr);
!
! /* End the binding level dedicated to the exception handlers
! and get the whole statement group. */
! pop_stack (&gnu_except_ptr_stack);
gnat_poplevel ();
+ gnu_handler = end_stmt_group ();
! /* If the setjmp returns 1, we restore our incoming longjmp value
! and then check the handlers. */
! start_stmt_group ();
! add_stmt_with_node (build_call_1_expr (set_jmpbuf_decl,
! gnu_jmpsave_decl),
! gnat_node);
! add_stmt (gnu_handler);
! gnu_handler = end_stmt_group ();
!
! /* This block is now "if (setjmp) ... <handlers> else <block>". */
! gnu_result = build (COND_EXPR, void_type_node,
! (build_call_1_expr
! (setjmp_decl,
build_unary_op (ADDR_EXPR, NULL_TREE,
! gnu_jmpbuf_decl))),
! gnu_handler, gnu_inner_block);
}
! else if (gcc_zcx)
{
! tree gnu_handlers;
+ /* First make a block containing the handlers. */
+ start_stmt_group ();
for (gnat_temp = First_Non_Pragma (Exception_Handlers (gnat_node));
Present (gnat_temp);
gnat_temp = Next_Non_Pragma (gnat_temp))
! add_stmt (gnat_to_gnu (gnat_temp));
! gnu_handlers = end_stmt_group ();
! /* Now make the TRY_CATCH_EXPR for the block. */
! gnu_result = build (TRY_CATCH_EXPR, void_type_node,
! gnu_inner_block, gnu_handlers);
}
+ else
+ gnu_result = gnu_inner_block;
! /* Now close our outer block, if we had to make one. */
! if (binding_for_block)
{
! add_stmt (gnu_result);
gnat_poplevel ();
+ gnu_result = end_stmt_group ();
}
}
break;
*************** tree_transform (Node_Id gnat_node)
*** 3691,3694 ****
--- 3409,3413 ----
For "Non-ada", accept an exception if "Lang" is 'V'. */
tree gnu_choice = integer_zero_node;
+ tree gnu_body = build_stmt_group (Statements (gnat_node), false);
for (gnat_temp = First (Exception_Choices (gnat_node));
*************** tree_transform (Node_Id gnat_node)
*** 3719,3730 ****
|| Nkind (gnat_temp) == N_Expanded_Name)
{
! Entity_Id gnat_ex_id = Entity (gnat_temp);
!
! /* Exception may be a renaming. Recover original exception
! which is the one elaborated and registered. */
! if (Present (Renamed_Object (gnat_ex_id)))
! gnat_ex_id = Renamed_Object (gnat_ex_id);
!
! gnu_expr = gnat_to_gnu_entity (gnat_ex_id, NULL_TREE, 0);
this_choice
--- 3438,3443 ----
|| Nkind (gnat_temp) == N_Expanded_Name)
{
! gnu_expr
! = gnat_to_gnu_entity (Entity (gnat_temp), NULL_TREE, 0);
this_choice
*************** tree_transform (Node_Id gnat_node)
*** 3765,3775 ****
}
! set_lineno (gnat_node, 1);
!
! expand_start_cond (gnu_choice, 0);
}
/* Tell the back end that we start an exception handler if necessary. */
! if (Exception_Mechanism == GCC_ZCX)
{
/* We build a TREE_LIST of nodes representing what exception
--- 3478,3487 ----
}
! gnu_result = build (COND_EXPR, void_type_node, gnu_choice, gnu_body,
! NULL_TREE);
}
/* Tell the back end that we start an exception handler if necessary. */
! else if (Exception_Mechanism == GCC_ZCX)
{
/* We build a TREE_LIST of nodes representing what exception
*************** tree_transform (Node_Id gnat_node)
*** 3792,3797 ****
doing the trick currently. */
- tree gnu_expr, gnu_etype;
tree gnu_etypes_list = NULL_TREE;
for (gnat_temp = First (Exception_Choices (gnat_node));
--- 3504,3511 ----
doing the trick currently. */
tree gnu_etypes_list = NULL_TREE;
+ tree gnu_etype;
+ tree gnu_current_exc_ptr;
+ tree gnu_incoming_exc_ptr;
for (gnat_temp = First (Exception_Choices (gnat_node));
*************** tree_transform (Node_Id gnat_node)
*** 3833,3900 ****
gnu_etypes_list
= tree_cons (NULL_TREE, gnu_etype, gnu_etypes_list);
-
}
! expand_start_catch (gnu_etypes_list);
!
gnat_pushlevel ();
- expand_start_bindings (0);
-
- {
- /* Expand a call to the begin_handler hook at the beginning of the
- handler, and arrange for a call to the end_handler hook to
- occur on every possible exit path.
-
- The hooks expect a pointer to the low level occurrence. This
- is required for our stack management scheme because a raise
- inside the handler pushes a new occurrence on top of the
- stack, which means that this top does not necessarily match
- the occurrence this handler was dealing with.
-
- The EXC_PTR_EXPR object references the exception occurrence
- beeing propagated. Upon handler entry, this is the exception
- for which the handler is triggered. This might not be the case
- upon handler exit, however, as we might have a new occurrence
- propagated by the handler's body, and the end_handler hook
- called as a cleanup in this context.
-
- We use a local variable to retrieve the incoming value at
- handler entry time, and reuse it to feed the end_handler
- hook's argument at exit time. */
- tree gnu_current_exc_ptr
- = build (EXC_PTR_EXPR, ptr_type_node);
- tree gnu_incoming_exc_ptr
- = create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
- ptr_type_node, gnu_current_exc_ptr,
- 0, 0, 0, 0, 0);
-
- start_block_stmt ();
- add_decl_stmt (gnu_incoming_exc_ptr, gnat_node);
- gnat_expand_stmt (end_block_stmt (false));
- expand_expr_stmt
- (build_call_1_expr (begin_handler_decl, gnu_incoming_exc_ptr));
- expand_decl_cleanup
- (0, build_call_1_expr (end_handler_decl, gnu_incoming_exc_ptr));
- }
- }
! for (gnat_temp = First (Statements (gnat_node));
! gnat_temp; gnat_temp = Next (gnat_temp))
! gnat_to_code (gnat_temp);
!
! if (Exception_Mechanism == GCC_ZCX)
! {
! /* Tell the back end that we're done with the current handler. */
! expand_end_bindings (NULL_TREE, block_has_vars (), -1);
gnat_poplevel ();
! expand_end_catch ();
}
else
! /* At the end of the handler, exit the block. We made this block in
! N_Handled_Sequence_Of_Statements. */
! expand_exit_something ();
!
! if (Exception_Mechanism == Setjmp_Longjmp)
! expand_end_cond ();
break;
--- 3547,3594 ----
gnu_etypes_list
= tree_cons (NULL_TREE, gnu_etype, gnu_etypes_list);
}
! start_stmt_group ();
gnat_pushlevel ();
! /* Expand a call to the begin_handler hook at the beginning of the
! handler, and arrange for a call to the end_handler hook to occur
! on every possible exit path.
!
! The hooks expect a pointer to the low level occurrence. This is
! required for our stack management scheme because a raise inside
! the handler pushes a new occurrence on top of the stack, which
! means that this top does not necessarily match the occurrence
! this handler was dealing with.
!
! The EXC_PTR_EXPR object references the exception occurrence
! beeing propagated. Upon handler entry, this is the exception for
! which the handler is triggered. This might not be the case upon
! handler exit, however, as we might have a new occurrence
! propagated by the handler's body, and the end_handler hook
! called as a cleanup in this context.
!
! We use a local variable to retrieve the incoming value at
! handler entry time, and reuse it to feed the end_handler hook's
! argument at exit time. */
! gnu_current_exc_ptr = build (EXC_PTR_EXPR, ptr_type_node);
! gnu_incoming_exc_ptr
! = create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
! ptr_type_node, gnu_current_exc_ptr,
! 0, 0, 0, 0, 0);
!
! add_decl_stmt (gnu_incoming_exc_ptr, gnat_node);
! add_stmt_with_node (build_call_1_expr (begin_handler_decl,
! gnu_incoming_exc_ptr),
! gnat_node);
! add_cleanup (build_call_1_expr (end_handler_decl,
! gnu_incoming_exc_ptr));
! add_stmt_list (Statements (gnat_node));
gnat_poplevel ();
! gnu_result = build (CATCH_EXPR, void_type_node,
! gnu_etypes_list, end_stmt_group ());
}
else
! abort ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 3914,3917 ****
--- 3608,3612 ----
/* These nodes can appear on a declaration list but there is nothing to
to be done with them. */
+ gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 3923,3926 ****
--- 3618,3623 ----
case N_Attribute_Definition_Clause:
+ gnu_result = alloc_stmt_list ();
+
/* The only one we need deal with is for 'Address. For the others, SEM
puts the information elsewhere. We need only deal with 'Address
*************** tree_transform (Node_Id gnat_node)
*** 3933,3938 ****
equivalent for GNAT_TEMP. When the object is frozen,
gnat_to_gnu_entity will do the right thing. */
! gnu_expr = gnat_to_gnu (Expression (gnat_node));
! save_gnu_tree (Entity (Name (gnat_node)), gnu_expr, 1);
break;
--- 3630,3635 ----
equivalent for GNAT_TEMP. When the object is frozen,
gnat_to_gnu_entity will do the right thing. */
! save_gnu_tree (Entity (Name (gnat_node)),
! gnat_to_gnu (Expression (gnat_node)), 1);
break;
*************** tree_transform (Node_Id gnat_node)
*** 3941,3944 ****
--- 3638,3642 ----
case N_At_Clause:
/* We do nothing with these. SEM puts the information elsewhere. */
+ gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 3947,3951 ****
{
tree gnu_template = gnat_to_gnu (Asm_Template (gnat_node));
! tree gnu_input_list = 0, gnu_output_list = 0, gnu_orig_out_list = 0;
tree gnu_clobber_list = 0;
char *clobber;
--- 3645,3649 ----
{
tree gnu_template = gnat_to_gnu (Asm_Template (gnat_node));
! tree gnu_input_list = 0, gnu_output_list = 0;
tree gnu_clobber_list = 0;
char *clobber;
*************** tree_transform (Node_Id gnat_node)
*** 3971,3976 ****
(Asm_Output_Constraint ()));
- gnu_orig_out_list
- = tree_cons (gnu_constr, gnu_value, gnu_orig_out_list);
gnu_output_list
= tree_cons (gnu_constr, gnu_value, gnu_output_list);
--- 3669,3672 ----
*************** tree_transform (Node_Id gnat_node)
*** 3987,3996 ****
gnu_input_list = nreverse (gnu_input_list);
gnu_output_list = nreverse (gnu_output_list);
! gnu_orig_out_list = nreverse (gnu_orig_out_list);
! gnu_result = build_nt (ASM_STMT, gnu_template, gnu_output_list,
! gnu_orig_out_list, gnu_input_list,
! gnu_clobber_list);
! TREE_THIS_VOLATILE (gnu_result) = Is_Asm_Volatile (gnat_node);
}
break;
--- 3683,3694 ----
gnu_input_list = nreverse (gnu_input_list);
gnu_output_list = nreverse (gnu_output_list);
! gnu_result = build (ASM_EXPR, void_type_node,
! gnu_template, gnu_output_list,
! gnu_input_list, gnu_clobber_list);
! ASM_VOLATILE_P (gnu_result) = Is_Asm_Volatile (gnat_node);
}
+ else
+ gnu_result = alloc_stmt_list ();
+
break;
*************** tree_transform (Node_Id gnat_node)
*** 4000,4007 ****
case N_Freeze_Entity:
process_freeze_entity (gnat_node);
- start_block_stmt ();
process_decls (Actions (gnat_node), Empty, Empty, 1, 1);
! gnat_expand_stmt (end_block_stmt (false));
break;
--- 3698,3705 ----
case N_Freeze_Entity:
+ start_stmt_group ();
process_freeze_entity (gnat_node);
process_decls (Actions (gnat_node), Empty, Empty, 1, 1);
! gnu_result = end_stmt_group ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 4009,4012 ****
--- 3707,3712 ----
if (! present_gnu_tree (Itype (gnat_node)))
process_type (Itype (gnat_node));
+
+ gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 4057,4066 ****
}
! gnu_result
! = build_nt (EXPR_STMT,
! build_call_alloc_dealloc
! (gnu_ptr, gnu_obj_size, align,
! Procedure_To_Call (gnat_node),
! Storage_Pool (gnat_node), gnat_node));
}
break;
--- 3757,3764 ----
}
! gnu_result = build_call_alloc_dealloc (gnu_ptr, gnu_obj_size, align,
! Procedure_To_Call (gnat_node),
! Storage_Pool (gnat_node),
! gnat_node);
}
break;
*************** tree_transform (Node_Id gnat_node)
*** 4069,4075 ****
case N_Raise_Program_Error:
case N_Raise_Storage_Error:
-
if (type_annotate_only)
! break;
gnu_result_type = get_unpadded_type (Etype (gnat_node));
--- 3767,3775 ----
case N_Raise_Program_Error:
case N_Raise_Storage_Error:
if (type_annotate_only)
! {
! gnu_result = alloc_stmt_list ();
! break;
! }
gnu_result_type = get_unpadded_type (Etype (gnat_node));
*************** tree_transform (Node_Id gnat_node)
*** 4081,4092 ****
if (TREE_CODE (gnu_result_type) == VOID_TYPE)
{
! gnu_result = build_nt (EXPR_STMT, gnu_result);
! TREE_TYPE (gnu_result) = void_type_node;
! TREE_SLOC (gnu_result) = Sloc (gnat_node);
if (Present (Condition (gnat_node)))
! gnu_result = build_nt (IF_STMT,
! gnat_to_gnu (Condition (gnat_node)),
! gnu_result, NULL_TREE, NULL_TREE);
}
else
--- 3781,3790 ----
if (TREE_CODE (gnu_result_type) == VOID_TYPE)
{
! annotate_with_node (gnu_result, gnat_node);
if (Present (Condition (gnat_node)))
! gnu_result = build (COND_EXPR, void_type_node,
! gnat_to_gnu (Condition (gnat_node)),
! gnu_result, alloc_stmt_list ());
}
else
*************** tree_transform (Node_Id gnat_node)
*** 4123,4126 ****
--- 3821,3825 ----
}
}
+ gnu_result = alloc_stmt_list ();
break;
*************** tree_transform (Node_Id gnat_node)
*** 4134,4148 ****
if (! type_annotate_only)
gigi_abort (321);
- }
! /* If the result is a statement, set needed flags and return it. */
! if (IS_STMT (gnu_result))
! {
! TREE_TYPE (gnu_result) = void_type_node;
! TREE_THIS_VOLATILE (gnu_result) = TREE_SIDE_EFFECTS (gnu_result) = 1;
! TREE_SLOC (gnu_result) = Sloc (gnat_node);
! return gnu_result;
}
/* If the result is a constant that overflows, raise constraint error. */
else if (TREE_CODE (gnu_result) == INTEGER_CST
--- 3833,3849 ----
if (! type_annotate_only)
gigi_abort (321);
! gnu_result = alloc_stmt_list ();
}
+ /* Set the location information into the result. If we're supposed to
+ return something of void_type, it means we have something we're
+ elaborating for effect, so just return. */
+ if (IS_EXPR_CODE_CLASS (TREE_CODE_CLASS (TREE_CODE (gnu_result))))
+ annotate_with_node (gnu_result, gnat_node);
+
+ if (TREE_CODE (gnu_result_type) == VOID_TYPE)
+ return gnu_result;
+
/* If the result is a constant that overflows, raise constraint error. */
else if (TREE_CODE (gnu_result) == INTEGER_CST
*************** tree_transform (Node_Id gnat_node)
*** 4258,4323 ****
}
! /* INSN is a list of insns. Return the first rtl in the list that isn't
! an INSN_NOTE_DELETED. */
! static rtx
! first_nondeleted_insn (rtx insns)
{
! for (; insns && GET_CODE (insns) == NOTE
! && NOTE_LINE_NUMBER (insns) == NOTE_INSN_DELETED;
! insns = NEXT_INSN (insns))
! ;
! return insns;
}
! /* Push the BLOCK_STMT stack and allocate a new BLOCK_STMT. */
! static tree
! start_block_stmt ()
{
! tree gnu_block_stmt;
/* First see if we can get one from the free list. */
! if (gnu_block_stmt_free_list)
! {
! gnu_block_stmt = gnu_block_stmt_free_list;
! gnu_block_stmt_free_list = TREE_CHAIN (gnu_block_stmt_free_list);
! }
else
! {
! gnu_block_stmt = make_node (BLOCK_STMT);
! TREE_TYPE (gnu_block_stmt) = void_type_node;
! }
! BLOCK_STMT_LIST (gnu_block_stmt) = NULL_TREE;
! BLOCK_STMT_BLOCK (gnu_block_stmt) = NULL_TREE;
! TREE_CHAIN (gnu_block_stmt) = gnu_block_stmt_node;
! gnu_block_stmt_node = gnu_block_stmt;
!
! return gnu_block_stmt;
}
! /* Add GNU_STMT to the current BLOCK_STMT node. We add them backwards
! order and the reverse in end_block_stmt. */
void
add_stmt (tree gnu_stmt)
{
! if (TREE_CODE_CLASS (TREE_CODE (gnu_stmt)) != 's')
! gigi_abort (340);
! if (TREE_CODE (gnu_stmt) != NULL_STMT)
! {
! TREE_CHAIN (gnu_stmt) = BLOCK_STMT_LIST (gnu_block_stmt_node);
! BLOCK_STMT_LIST (gnu_block_stmt_node) = gnu_stmt;
! TREE_TYPE (gnu_stmt) = void_type_node;
! }
!
! /* If this is a DECL_STMT for a variable with DECL_INIT_BY_ASSIGN_P set,
generate the assignment statement too. */
if (TREE_CODE (gnu_stmt) == DECL_STMT
&& TREE_CODE (DECL_STMT_VAR (gnu_stmt)) == VAR_DECL
! && DECL_INIT_BY_ASSIGN_P (DECL_STMT_VAR (gnu_stmt)))
{
tree gnu_decl = DECL_STMT_VAR (gnu_stmt);
--- 3959,4012 ----
}
! /* Record the current code position in GNAT_NODE. */
! static void
! record_code_position (Node_Id gnat_node)
{
! tree stmt_stmt = build (STMT_STMT, void_type_node, NULL_TREE);
! add_stmt_with_node (stmt_stmt, gnat_node);
! save_gnu_tree (gnat_node, stmt_stmt, 1);
! }
!
! /* Insert the code for GNAT_NODE at the position saved for that node. */
!
! static void
! insert_code_for (Node_Id gnat_node)
! {
! STMT_STMT_STMT (get_gnu_tree (gnat_node)) = gnat_to_gnu (gnat_node);
! save_gnu_tree (gnat_node, NULL_TREE, 1);
}
! /* Start a new statement group chained to the previous group. */
! static void
! start_stmt_group ()
{
! struct stmt_group *group = stmt_group_free_list;
/* First see if we can get one from the free list. */
! if (group)
! stmt_group_free_list = group->previous;
else
! group = (struct stmt_group *) ggc_alloc (sizeof (struct stmt_group));
! group->previous = current_stmt_group;
! group->stmt_list = group->block = group->cleanups = NULL_TREE;
! current_stmt_group = group;
}
! /* Add GNU_STMT to the current statement group. */
void
add_stmt (tree gnu_stmt)
{
! append_to_statement_list (gnu_stmt, ¤t_stmt_group->stmt_list);
! /* If this is a DECL_STMT for a variable with DECL_INITIAL set,
generate the assignment statement too. */
if (TREE_CODE (gnu_stmt) == DECL_STMT
&& TREE_CODE (DECL_STMT_VAR (gnu_stmt)) == VAR_DECL
! && DECL_INITIAL (DECL_STMT_VAR (gnu_stmt)))
{
tree gnu_decl = DECL_STMT_VAR (gnu_stmt);
*************** add_stmt (tree gnu_stmt)
*** 4333,4349 ****
gnu_assign_stmt
! = build_nt (EXPR_STMT,
! build_binary_op (MODIFY_EXPR, NULL_TREE,
! gnu_lhs, DECL_INITIAL (gnu_decl)));
DECL_INITIAL (gnu_decl) = 0;
- DECL_INIT_BY_ASSIGN_P (gnu_decl) = 0;
! TREE_SLOC (gnu_assign_stmt) = TREE_SLOC (gnu_stmt);
! TREE_TYPE (gnu_assign_stmt) = void_type_node;
add_stmt (gnu_assign_stmt);
}
}
! /* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node.
Get SLOC from Entity_Id. */
--- 4022,4044 ----
gnu_assign_stmt
! = build_binary_op (MODIFY_EXPR, NULL_TREE,
! gnu_lhs, DECL_INITIAL (gnu_decl));
DECL_INITIAL (gnu_decl) = 0;
! SET_EXPR_LOCUS (gnu_assign_stmt, &DECL_SOURCE_LOCATION (gnu_decl));
add_stmt (gnu_assign_stmt);
}
}
! /* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */
!
! void
! add_stmt_with_node (tree gnu_stmt, Node_Id gnat_node)
! {
! annotate_with_node (gnu_stmt, gnat_node);
! add_stmt (gnu_stmt);
! }
!
! /* Add a declaration statement for GNU_DECL to the current statement group.
Get SLOC from Entity_Id. */
*************** void
*** 4351,4356 ****
add_decl_stmt (tree gnu_decl, Entity_Id gnat_entity)
{
- tree gnu_stmt;
-
/* If this is a variable that Gigi is to ignore, we may have been given
an ERROR_MARK. So test for it. We also might have been given a
--- 4046,4049 ----
*************** add_decl_stmt (tree gnu_decl, Entity_Id
*** 4359,4447 ****
return;
! gnu_stmt = build_nt (DECL_STMT, gnu_decl);
! TREE_TYPE (gnu_stmt) = void_type_node;
! TREE_SLOC (gnu_stmt) = Sloc (gnat_entity);
! add_stmt (gnu_stmt);
}
! /* Return the BLOCK_STMT that corresponds to the statement that add_stmt
! has been emitting or just a single statement if only one. If FORCE
! is true, then always emit the BLOCK_STMT. */
! static tree
! end_block_stmt (bool force)
{
! tree gnu_block_stmt = gnu_block_stmt_node;
! tree gnu_retval = gnu_block_stmt;
! gnu_block_stmt_node = TREE_CHAIN (gnu_block_stmt);
! TREE_CHAIN (gnu_block_stmt) = 0;
! /* If we have only one statement, return it and free this node. Otherwise,
! finish setting up this node and return it. If we have no statements,
! return a NULL_STMT. */
! if (!force && BLOCK_STMT_LIST (gnu_block_stmt) == 0)
! {
! gnu_retval = build_nt (NULL_STMT);
! TREE_TYPE (gnu_retval) = void_type_node;
! }
! else if (!force && TREE_CHAIN (BLOCK_STMT_LIST (gnu_block_stmt)) == 0)
! gnu_retval = BLOCK_STMT_LIST (gnu_block_stmt);
! else
! {
! BLOCK_STMT_LIST (gnu_block_stmt)
! = nreverse (BLOCK_STMT_LIST (gnu_block_stmt));
! TREE_SLOC (gnu_block_stmt)
! = TREE_SLOC (BLOCK_STMT_LIST (gnu_block_stmt));
! }
!
! if (gnu_retval != gnu_block_stmt)
! {
! TREE_CHAIN (gnu_block_stmt) = gnu_block_stmt_free_list;
! gnu_block_stmt_free_list = gnu_block_stmt;
! }
! return gnu_retval;
}
! /* Build a BLOCK_STMT from GNAT_LIST, a possibly-empty list of statements. */
static tree
! build_block_stmt (List_Id gnat_list)
{
! tree gnu_result = NULL_TREE;
! Node_Id gnat_node;
! if (No (gnat_list) || Is_Empty_List (gnat_list))
! return NULL_TREE;
! start_block_stmt ();
! for (gnat_node = First (gnat_list);
! Present (gnat_node);
! gnat_node = Next (gnat_node))
! add_stmt (gnat_to_gnu (gnat_node));
! gnu_result = end_block_stmt (false);
! return TREE_CODE (gnu_result) == NULL_STMT ? NULL_TREE : gnu_result;
}
! /* Build an EXPR_STMT to evaluate INSNS. Use Sloc from GNAT_NODE. */
static tree
! make_expr_stmt_from_rtl (rtx insns, Node_Id gnat_node)
{
! tree gnu_result = make_node (RTL_EXPR);
! TREE_TYPE (gnu_result) = void_type_node;
! RTL_EXPR_RTL (gnu_result) = RTL_EXPR_ALT_RTL (gnu_result) = const0_rtx;
! RTL_EXPR_SEQUENCE (gnu_result) = insns;
! rtl_expr_chain = tree_cons (NULL_TREE, gnu_result, rtl_expr_chain);
!
! gnu_result = build_nt (EXPR_STMT, gnu_result);
! TREE_SLOC (gnu_result) = Sloc (gnat_node);
! TREE_TYPE (gnu_result) = void_type_node;
! return gnu_result;
}
--- 4052,4171 ----
return;
! add_stmt_with_node (build (DECL_STMT, void_type_node, gnu_decl),
! gnat_entity);
}
! /* Add GNU_CLEANUP, a cleanup action, to the current code group. */
! static void
! add_cleanup (tree gnu_cleanup)
{
! append_to_statement_list (gnu_cleanup, ¤t_stmt_group->cleanups);
! }
! /* Set the BLOCK node corresponding to the current code group to GNU_BLOCK. */
! void
! set_block_for_group (tree gnu_block)
! {
! if (current_stmt_group->block)
! abort ();
! current_stmt_group->block = gnu_block;
}
! /* Return code corresponding to the current code group. It is normally
! a STATEMENT_LIST, but may also be a BIND_EXPR or TRY_FINALLY_EXPR if
! BLOCK or cleanups were set. */
static tree
! end_stmt_group ()
{
! struct stmt_group *group = current_stmt_group;
! tree gnu_retval = group->stmt_list;
!
! /* If this is a null list, allocate a new STATEMENT_LIST. Then, if there
! are cleanups, make a TRY_FINALLY_EXPR. Last, if there is a BLOCK,
! make a BIND_EXPR. Note that we nest in that because the cleanup may
! reference variables in the block. */
! if (gnu_retval == NULL_TREE)
! gnu_retval = alloc_stmt_list ();
!
! if (group->cleanups)
! gnu_retval = build (TRY_FINALLY_EXPR, void_type_node, gnu_retval,
! group->cleanups);
!
! if (current_stmt_group->block)
! gnu_retval = build (BIND_EXPR, void_type_node, BLOCK_VARS (group->block),
! gnu_retval, group->block);
!
! /* Remove this group from the stack and add it to the free list. */
! current_stmt_group = group->previous;
! group->previous = stmt_group_free_list;
! stmt_group_free_list = group;
! return gnu_retval;
! }
! /* Add a list of statements from GNAT_LIST, a possibly-empty list of
! statements.*/
! static void
! add_stmt_list (List_Id gnat_list)
! {
! Node_Id gnat_node;
! if (Present (gnat_list))
! for (gnat_node = First (gnat_list); Present (gnat_node);
! gnat_node = Next (gnat_node))
! add_stmt (gnat_to_gnu (gnat_node));
}
! /* Build a tree from GNAT_LIST, a possibly-empty list of statements.
! If BINDING_P is true, push and pop a binding level around the list. */
static tree
! build_stmt_group (List_Id gnat_list, bool binding_p)
{
! start_stmt_group ();
! if (binding_p)
! gnat_pushlevel ();
!
! add_stmt_list (gnat_list);
! if (binding_p)
! gnat_poplevel ();
! return end_stmt_group ();
! }
!
! /* Push and pop routines for stacks. We keep a free list around so we
! don't waste tree nodes. */
! static void
! push_stack (tree *gnu_stack_ptr, tree gnu_purpose, tree gnu_value)
! {
! tree gnu_node = gnu_stack_free_list;
!
! if (gnu_node)
! {
! gnu_stack_free_list = TREE_CHAIN (gnu_node);
! TREE_CHAIN (gnu_node) = *gnu_stack_ptr;
! TREE_PURPOSE (gnu_node) = gnu_purpose;
! TREE_VALUE (gnu_node) = gnu_value;
! }
! else
! gnu_node = tree_cons (gnu_purpose, gnu_value, *gnu_stack_ptr);
!
! *gnu_stack_ptr = gnu_node;
! }
!
! static void
! pop_stack (tree *gnu_stack_ptr)
! {
! tree gnu_node = *gnu_stack_ptr;
!
! *gnu_stack_ptr = TREE_CHAIN (gnu_node);
! TREE_CHAIN (gnu_node) = gnu_stack_free_list;
! gnu_stack_free_list = gnu_node;
}
*************** void
*** 4451,4570 ****
gnat_expand_stmt (tree gnu_stmt)
{
tree gnu_elmt, gnu_elmt_2;
!
! if (TREE_SLOC (gnu_stmt))
! set_lineno_from_sloc (TREE_SLOC (gnu_stmt), 1);
switch (TREE_CODE (gnu_stmt))
{
! case EXPR_STMT:
! expand_expr_stmt (EXPR_STMT_EXPR (gnu_stmt));
! break;
! case NULL_STMT:
! break;
! case DECL_STMT:
! if (TREE_CODE (DECL_STMT_VAR (gnu_stmt)) == TYPE_DECL)
! force_type_save_exprs (TREE_TYPE (DECL_STMT_VAR (gnu_stmt)));
else
! {
! expand_decl (DECL_STMT_VAR (gnu_stmt));
! if (DECL_CONTEXT (DECL_STMT_VAR (gnu_stmt)))
! expand_decl_init (DECL_STMT_VAR (gnu_stmt));
! if (TREE_ADDRESSABLE (DECL_STMT_VAR (gnu_stmt)))
! {
! put_var_into_stack (DECL_STMT_VAR (gnu_stmt), true);
! flush_addressof (DECL_STMT_VAR (gnu_stmt));
! }
! }
! break;
! case BLOCK_STMT:
! if (BLOCK_STMT_BLOCK (gnu_stmt))
! expand_start_bindings_and_block (0, BLOCK_STMT_BLOCK (gnu_stmt));
! for (gnu_elmt = BLOCK_STMT_LIST (gnu_stmt); gnu_elmt;
! gnu_elmt = TREE_CHAIN (gnu_elmt))
! gnat_expand_stmt (gnu_elmt);
! if (BLOCK_STMT_BLOCK (gnu_stmt))
! expand_end_bindings (NULL_TREE, 1, -1);
! break;
! case IF_STMT:
! expand_start_cond (IF_STMT_COND (gnu_stmt), 0);
! if (IF_STMT_TRUE (gnu_stmt))
! gnat_expand_stmt (IF_STMT_TRUE (gnu_stmt));
! for (gnu_elmt = IF_STMT_ELSEIF (gnu_stmt); gnu_elmt;
! gnu_elmt = TREE_CHAIN (gnu_elmt))
! {
! expand_start_else ();
! set_lineno_from_sloc (TREE_SLOC (gnu_elmt), 1);
! expand_elseif (IF_STMT_COND (gnu_elmt));
! if (IF_STMT_TRUE (gnu_elmt))
! gnat_expand_stmt (IF_STMT_TRUE (gnu_elmt));
! }
! if (IF_STMT_ELSE (gnu_stmt))
! {
! expand_start_else ();
! gnat_expand_stmt (IF_STMT_ELSE (gnu_stmt));
! }
! expand_end_cond ();
! break;
! case GOTO_STMT:
! TREE_USED (GOTO_STMT_LABEL (gnu_stmt)) = 1;
! expand_goto (GOTO_STMT_LABEL (gnu_stmt));
! break;
! case LABEL_STMT:
! expand_label (LABEL_STMT_LABEL (gnu_stmt));
! break;
! case RETURN_STMT:
! if (RETURN_STMT_EXPR (gnu_stmt))
! expand_return (build_binary_op (MODIFY_EXPR, NULL_TREE,
! DECL_RESULT (current_function_decl),
! RETURN_STMT_EXPR (gnu_stmt)));
! else
! expand_null_return ();
! break;
! case ASM_STMT:
! expand_asm_operands (ASM_STMT_TEMPLATE (gnu_stmt),
! ASM_STMT_OUTPUT (gnu_stmt),
! ASM_STMT_INPUT (gnu_stmt),
! ASM_STMT_CLOBBER (gnu_stmt),
! TREE_THIS_VOLATILE (gnu_stmt), input_location);
!
! /* Copy all the intermediate outputs into the specified outputs. */
! for ((gnu_elmt = ASM_STMT_OUTPUT (gnu_stmt),
! gnu_elmt_2 = ASM_STMT_ORIG_OUT (gnu_stmt));
! gnu_elmt;
! (gnu_elmt = TREE_CHAIN (gnu_elmt),
! gnu_elmt_2 = TREE_CHAIN (gnu_elmt_2)))
! if (TREE_VALUE (gnu_elmt) != TREE_VALUE (gnu_elmt_2))
! {
! expand_expr_stmt
! (build_binary_op (MODIFY_EXPR, NULL_TREE,
! TREE_VALUE (gnu_elmt_2),
! TREE_VALUE (gnu_elmt)));
! free_temp_slots ();
! }
! break;
! case BREAK_STMT:
! expand_exit_something ();
break;
default:
! abort ();
}
}
--- 4175,4423 ----
gnat_expand_stmt (tree gnu_stmt)
{
+ #if 0
tree gnu_elmt, gnu_elmt_2;
! #endif
switch (TREE_CODE (gnu_stmt))
{
! #if 0
! case USE_STMT:
! /* First write a volatile ASM_INPUT to prevent anything from being
! moved. */
! gnu_elmt = gen_rtx_ASM_INPUT (VOIDmode, "");
! MEM_VOLATILE_P (gnu_elmt) = 1;
! emit_insn (gnu_elmt);
!
! gnu_elmt = expand_expr (TREE_OPERAND (gnu_stmt, 0), NULL_RTX, VOIDmode,
! modifier);
! emit_insn (gen_rtx_USE (VOIDmode, ));
! return target;
! #endif
! default:
! abort ();
! }
! }
!
! /* Generate GIMPLE in place for the expression at *EXPR_P. */
! int
! gnat_gimplify_expr (tree *expr_p, tree *pre_p ATTRIBUTE_UNUSED, tree *post_p)
! {
! tree expr = *expr_p;
!
! if (IS_ADA_STMT (expr))
! return gnat_gimplify_stmt (expr_p);
!
! switch (TREE_CODE (expr))
! {
! case NULL_EXPR:
! /* If this is for a scalar, just make a VAR_DECL for it. If for
! an aggregate, get a null pointer of the appropriate type and
! dereference it. */
! if (AGGREGATE_TYPE_P (TREE_TYPE (expr)))
! *expr_p = build1 (INDIRECT_REF, TREE_TYPE (expr),
! convert (build_pointer_type (TREE_TYPE (expr)),
! integer_zero_node));
else
! *expr_p = create_tmp_var (TREE_TYPE (expr), NULL);
! append_to_statement_list (TREE_OPERAND (expr, 0), post_p);
! return GS_OK;
! case UNCONSTRAINED_ARRAY_REF:
! /* We should only do this if we are just elaborating for side-effects,
! but we can't know that yet. */
! *expr_p = TREE_OPERAND (*expr_p, 0);
! return GS_OK;
! default:
! return GS_UNHANDLED;
! }
! }
! /* Generate GIMPLE in place for the statement at *STMT_P. */
! static enum gimplify_status
! gnat_gimplify_stmt (tree *stmt_p)
! {
! tree stmt = *stmt_p;
! switch (TREE_CODE (stmt))
! {
! case STMT_STMT:
! *stmt_p = STMT_STMT_STMT (stmt);
! return GS_OK;
!
! case USE_STMT:
! *stmt_p = build_empty_stmt ();
! return GS_ALL_DONE;
! case DECL_STMT:
! if (TREE_CODE (DECL_STMT_VAR (stmt)) == TYPE_DECL)
! *stmt_p = gnat_gimplify_type_sizes (TREE_TYPE (DECL_STMT_VAR (stmt)));
! else
! *stmt_p = build_empty_stmt ();
! return GS_ALL_DONE;
! case LOOP_STMT:
! {
! tree gnu_start_label = create_artificial_label ();
! tree gnu_end_label = create_artificial_label ();
! /* Save the end label for EXIT_STMT and set to emit the statements
! of the loop. */
! LOOP_STMT_LABEL (stmt) = gnu_end_label;
! *stmt_p = NULL_TREE;
!
! /* We first emit the start label and then a conditional jump to
! the end label if there's a top condition, then the body of the
! loop, then a conditional branch to the end label, then the update,
! if any, and finally a jump to the start label and the definition
! of the end label. */
! append_to_statement_list (build1 (LABEL_EXPR, void_type_node,
! gnu_start_label),
! stmt_p);
!
! if (LOOP_STMT_TOP_COND (stmt))
! append_to_statement_list (build (COND_EXPR, void_type_node,
! LOOP_STMT_TOP_COND (stmt),
! alloc_stmt_list (),
! build1 (GOTO_EXPR,
! void_type_node,
! gnu_end_label)),
! stmt_p);
!
! append_to_statement_list (LOOP_STMT_BODY (stmt), stmt_p);
!
! if (LOOP_STMT_BOT_COND (stmt))
! append_to_statement_list (build (COND_EXPR, void_type_node,
! LOOP_STMT_BOT_COND (stmt),
! alloc_stmt_list (),
! build1 (GOTO_EXPR,
! void_type_node,
! gnu_end_label)),
! stmt_p);
!
! if (LOOP_STMT_UPDATE (stmt))
! append_to_statement_list (LOOP_STMT_UPDATE (stmt), stmt_p);
!
! append_to_statement_list (build1 (GOTO_EXPR, void_type_node,
! gnu_start_label),
! stmt_p);
! append_to_statement_list (build1 (LABEL_EXPR, void_type_node,
! gnu_end_label),
! stmt_p);
! return GS_OK;
! }
! case EXIT_STMT:
! /* Build a statement to jump to the corresponding end label, then
! see if it needs to be conditional. */
! *stmt_p = build1 (GOTO_EXPR, void_type_node,
! LOOP_STMT_LABEL (EXIT_STMT_LOOP (stmt)));
! if (EXIT_STMT_COND (stmt))
! *stmt_p = build (COND_EXPR, void_type_node,
! EXIT_STMT_COND (stmt), *stmt_p, alloc_stmt_list ());
! return GS_OK;
! default:
! abort ();
! }
! }
! /* Look through GNU_TYPE for variable-sized objects and gimplify each such
! size that we find. Return a STATEMENT_LIST containing the result. */
! static tree
! gnat_gimplify_type_sizes (tree gnu_type)
! {
! tree gnu_stmts = NULL_TREE;
! tree gnu_field;
!
! switch (TREE_CODE (gnu_type))
! {
! case ERROR_MARK:
! case UNCONSTRAINED_ARRAY_TYPE:
! return alloc_stmt_list ();
! case INTEGER_TYPE:
! case ENUMERAL_TYPE:
! case BOOLEAN_TYPE:
! case CHAR_TYPE:
! case REAL_TYPE:
! gnat_gimplify_one_sizepos (&TYPE_MIN_VALUE (gnu_type), &gnu_stmts);
! gnat_gimplify_one_sizepos (&TYPE_MAX_VALUE (gnu_type), &gnu_stmts);
! break;
!
! case RECORD_TYPE:
! case UNION_TYPE:
! case QUAL_UNION_TYPE:
! for (gnu_field = TYPE_FIELDS (gnu_type); gnu_field;
! gnu_field = TREE_CHAIN (gnu_field))
! if (TREE_CODE (gnu_field) == FIELD_DECL)
! gnat_gimplify_one_sizepos (&DECL_FIELD_OFFSET (gnu_field),
! &gnu_stmts);
break;
default:
! break;
}
+
+ gnat_gimplify_one_sizepos (&TYPE_SIZE (gnu_type), &gnu_stmts);
+ gnat_gimplify_one_sizepos (&TYPE_SIZE_UNIT (gnu_type), &gnu_stmts);
+
+ if (!gnu_stmts)
+ gnu_stmts = alloc_stmt_list ();
+
+ return gnu_stmts;
+ }
+
+ /* Subroutine of the above to gimplify one size or position, *GNU_EXPR_P.
+ We add any required statements to GNU_STMT_P. */
+
+ static void
+ gnat_gimplify_one_sizepos (tree *gnu_expr_p, tree *gnu_stmt_p)
+ {
+ tree gnu_pre = NULL_TREE, gnu_post = NULL_TREE;
+
+ /* We don't do anything if the value isn't there, is constant, or
+ contains a PLACEHOLDER_EXPR. */
+ if (*gnu_expr_p == NULL_TREE
+ || TREE_CONSTANT (*gnu_expr_p)
+ || CONTAINS_PLACEHOLDER_P (*gnu_expr_p))
+ return;
+
+ gimplify_expr (gnu_expr_p, &gnu_pre, &gnu_post, is_gimple_val, fb_rvalue);
+
+ if (gnu_pre)
+ append_to_statement_list (gnu_pre, gnu_stmt_p);
+ if (gnu_post)
+ append_to_statement_list (gnu_post, gnu_stmt_p);
+ }
+
+ /* Generate the RTL for the body of GNU_DECL. If NESTED_P is nonzero,
+ then we are already in the process of generating RTL for another
+ function. */
+
+ static void
+ gnat_expand_body_1 (tree gnu_decl, bool nested_p)
+ {
+ if (nested_p)
+ push_function_context ();
+
+ tree_rest_of_compilation (gnu_decl, nested_p);
+
+ if (nested_p)
+ pop_function_context ();
+ }
+
+ /* Expand the body of GNU_DECL, which is not a nested function. */
+
+ void
+ gnat_expand_body (tree gnu_decl)
+ {
+ if (DECL_INITIAL (gnu_decl) && DECL_INITIAL (gnu_decl) != error_mark_node)
+ gnat_expand_body_1 (gnu_decl, false);
}
*************** process_inlined_subprograms (Node_Id gna
*** 4791,4795 ****
{
gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
! gnat_to_code (gnat_body);
}
}
--- 4644,4648 ----
{
gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0);
! add_stmt (gnat_to_gnu (gnat_body));
}
}
*************** process_decls (List_Id gnat_decls, List_
*** 4825,4830 ****
gnat_decl != gnat_end_list; gnat_decl = Next (gnat_decl))
{
- set_lineno (gnat_decl, 0);
-
/* For package specs, we recurse inside the declarations,
thus taking the two pass approach inside the boundary. */
--- 4678,4681 ----
*************** process_decls (List_Id gnat_decls, List_
*** 4840,4846 ****
else if (Nkind (gnat_decl) == N_Freeze_Entity)
{
- start_block_stmt ();
process_freeze_entity (gnat_decl);
- gnat_expand_stmt (end_block_stmt (false));
process_decls (Actions (gnat_decl), Empty, Empty, 1, 0);
}
--- 4691,4695 ----
*************** process_decls (List_Id gnat_decls, List_
*** 4894,4902 ****
;
else
! {
! start_block_stmt ();
! gnat_to_code (gnat_decl);
! gnat_expand_stmt (end_block_stmt (false));
! }
}
--- 4743,4747 ----
;
else
! add_stmt (gnat_to_gnu (gnat_decl));
}
*************** process_decls (List_Id gnat_decls, List_
*** 4914,4918 ****
|| Nkind (gnat_decl) == N_Task_Body_Stub
|| Nkind (gnat_decl) == N_Protected_Body_Stub)
! gnat_to_code (gnat_decl);
else if (Nkind (gnat_decl) == N_Package_Declaration
--- 4759,4763 ----
|| Nkind (gnat_decl) == N_Task_Body_Stub
|| Nkind (gnat_decl) == N_Protected_Body_Stub)
! add_stmt (gnat_to_gnu (gnat_decl));
else if (Nkind (gnat_decl) == N_Package_Declaration
*************** process_type (Entity_Id gnat_entity)
*** 5324,5328 ****
/* Now fully elaborate the type. */
- start_block_stmt ();
gnu_new = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 1);
if (TREE_CODE (gnu_new) != TYPE_DECL)
--- 5169,5172 ----
*************** process_type (Entity_Id gnat_entity)
*** 5355,5360 ****
TREE_TYPE (gnu_new));
}
-
- gnat_expand_stmt (end_block_stmt (false));
}
--- 5199,5202 ----
*************** build_unit_elab (Entity_Id gnat_unit, in
*** 5744,5750 ****
begin_subprog_body (gnu_decl);
- set_lineno (gnat_unit, 1);
gnat_pushlevel ();
- gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack);
expand_start_bindings (0);
--- 5586,5590 ----
*************** build_unit_elab (Entity_Id gnat_unit, in
*** 5790,5795 ****
expand_end_bindings (NULL_TREE, block_has_vars (), -1);
gnat_poplevel ();
! gnu_block_stack = TREE_CHAIN (gnu_block_stack);
! end_subprog_body ();
/* We are finished with the elaboration list it can now be discarded. */
--- 5630,5634 ----
expand_end_bindings (NULL_TREE, block_has_vars (), -1);
gnat_poplevel ();
! end_subprog_body (alloc_stmt_list ());
/* We are finished with the elaboration list it can now be discarded. */
*************** build_unit_elab (Entity_Id gnat_unit, in
*** 5803,5826 ****
extern char *__gnat_to_canonical_file_spec (char *);
! /* Determine the input_filename and the input_line from the source location
! (Sloc) of GNAT_NODE node. Set the global variable input_filename and
! input_line. If WRITE_NOTE_P is true, emit a line number note. */
!
! void
! set_lineno (Node_Id gnat_node, int write_note_p)
! {
! Source_Ptr source_location = Sloc (gnat_node);
!
! set_lineno_from_sloc (source_location, write_note_p);
! }
!
! /* Likewise, but passed a Sloc. */
! void
! set_lineno_from_sloc (Source_Ptr source_location, int write_note_p)
{
/* If node not from source code, ignore. */
! if (source_location < 0)
! return;
/* Use the identifier table to make a hashed, permanent copy of the filename,
--- 5642,5657 ----
extern char *__gnat_to_canonical_file_spec (char *);
! /* Convert Sloc into *LOCUS (a location_t). Return true if this Sloc
! corresponds to a source code location and false if it doesn't. In the
! latter case, we don't update *LOCUS. We also set the Gigi global variable
! REF_FILENAME to the reference file name as given by sinput (i.e no
! directory). */
! bool
! Sloc_to_locus (Source_Ptr Sloc, location_t *locus)
{
/* If node not from source code, ignore. */
! if (Sloc < 0)
! return false;
/* Use the identifier table to make a hashed, permanent copy of the filename,
*************** set_lineno_from_sloc (Source_Ptr source_
*** 5829,5850 ****
call translates filenames from pragmas Source_Reference that contain host
style syntax not understood by gdb. */
! input_filename
= IDENTIFIER_POINTER
(get_identifier
(__gnat_to_canonical_file_spec
! (Get_Name_String
! (Full_Debug_Name (Get_Source_File_Index (source_location))))));
- /* ref_filename is the reference file name as given by sinput (i.e no
- directory) */
ref_filename
= IDENTIFIER_POINTER
(get_identifier
! (Get_Name_String
! (Debug_Source_Name (Get_Source_File_Index (source_location)))));;
! input_line = Get_Logical_Line_Number (source_location);
! if (! global_bindings_p () && write_note_p)
! emit_line_note (input_location);
}
--- 5660,5691 ----
call translates filenames from pragmas Source_Reference that contain host
style syntax not understood by gdb. */
! locus->file
= IDENTIFIER_POINTER
(get_identifier
(__gnat_to_canonical_file_spec
! (Get_Name_String (Full_Debug_Name (Get_Source_File_Index (Sloc))))));
!
! locus->line = Get_Logical_Line_Number (Sloc);
ref_filename
= IDENTIFIER_POINTER
(get_identifier
! (Get_Name_String (Debug_Source_Name (Get_Source_File_Index (Sloc)))));;
!
! return true;
! }
!
! /* Similar to annotate_with_locus, but start with the Sloc of GNAT_NODE and
! don't do anything if it doesn't correspond to a source location. */
!
! static void
! annotate_with_node (tree node, Node_Id gnat_node)
! {
! location_t locus;
!
! if (!Sloc_to_locus (Sloc (gnat_node), &locus))
! return;
! annotate_with_locus (node, locus);
}
*** utils.c 27 May 2004 22:51:19 -0000 1.48.2.49
--- utils.c 7 Jun 2004 14:47:30 -0000
***************
*** 39,42 ****
--- 39,46 ----
#include "target.h"
#include "function.h"
+ #include "cgraph.h"
+ #include "tree-inline.h"
+ #include "tree-gimple.h"
+ #include "tree-dump.h"
#include "ada.h"
*************** static GTY(()) tree signed_and_unsigned_
*** 102,113 ****
static GTY(()) tree float_types[NUM_MACHINE_MODES];
! /* For each binding contour we allocate a binding_level structure which records
! the entities defined or declared in that contour. Contours include:
!
! 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")))
--- 106,111 ----
static GTY(()) tree float_types[NUM_MACHINE_MODES];
! /* For each binding contour we allocate a binding_level structure to indicate
! the binding depth. */
struct ada_binding_level GTY((chain_next ("%h.chain")))
*************** struct ada_binding_level GTY((chain_next
*** 117,120 ****
--- 115,121 ----
/* The BLOCK node for this level. */
tree block;
+ /* If nonzero, the setjmp buffer that needs to be updated for any
+ variable-sized definition within this context. */
+ tree jmpbuf_decl;
};
*************** struct language_function GTY(())
*** 133,140 ****
--- 134,145 ----
};
+ 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 compute_related_constant (tree, tree);
static tree split_plus (tree, 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 convert_to_fat_pointer (tree, tree);
*************** gnat_pushlevel ()
*** 255,288 ****
active. */
newlevel->chain = current_binding_level;
current_binding_level = newlevel;
}
! /* Exit a binding level. Return the BLOCK node, if any. */
tree
gnat_poplevel ()
{
struct ada_binding_level *level = current_binding_level;
tree block = level->block;
- tree decl;
BLOCK_VARS (block) = nreverse (BLOCK_VARS (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
are no variables free the block and merge its subblocks into those of its
--- 260,294 ----
active. */
newlevel->chain = current_binding_level;
+ newlevel->jmpbuf_decl = NULL_TREE;
current_binding_level = newlevel;
}
! /* 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
+ 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 ()
{
struct ada_binding_level *level = current_binding_level;
tree block = level->block;
BLOCK_VARS (block) = nreverse (BLOCK_VARS (block));
BLOCK_SUBBLOCKS (block) = nreverse (BLOCK_SUBBLOCKS (block));
/* 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
*************** gnat_poplevel ()
*** 297,301 ****
TREE_CHAIN (block) = free_block_chain;
free_block_chain = block;
- block = NULL_TREE;
}
else
--- 303,306 ----
*************** gnat_poplevel ()
*** 304,307 ****
--- 309,313 ----
BLOCK_SUBBLOCKS (level->chain->block) = block;
TREE_USED (block) = 1;
+ set_block_for_group (block);
}
*************** gnat_poplevel ()
*** 310,314 ****
level->chain = free_binding_level;
free_binding_level = level;
- return block;
}
--- 316,319 ----
*************** gnat_init_decl_processing (void)
*** 401,405 ****
far better code using the width of Pmode. Make this here since we need
this before we can expand the GNAT types. */
! set_sizetype (gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0));
build_common_tree_nodes_2 (0);
--- 406,411 ----
far better code using the width of Pmode. Make this here since we need
this before we can expand the GNAT types. */
! size_type_node = gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0);
! set_sizetype (size_type_node);
build_common_tree_nodes_2 (0);
*************** gnat_init_decl_processing (void)
*** 415,420 ****
--- 421,514 ----
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
in the gcc back-end and initialize the global binding level. */
*************** create_var_decl (tree var_name, tree asm
*** 1230,1240 ****
/* 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
! we are defining a global here, leave a constant initialization and save
! any variable elaborations for the elaboration routine. Otherwise, if
! the initializing expression is not the same as TYPE, generate the
! initialization with an assignment statement, since it knows how
! 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)
--- 1324,1332 ----
/* 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 we are defining a global here, leave a constant initialization and
! save any variable elaborations for the elaboration routine. 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)
*************** create_var_decl (tree var_name, tree asm
*** 1248,1257 ****
}
- 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;
TREE_READONLY (var_decl) = const_flag;
--- 1340,1343 ----
*************** create_subprog_decl (tree subprog_name,
*** 1704,1708 ****
DECL_EXTERNAL (subprog_decl) = extern_flag;
TREE_PUBLIC (subprog_decl) = public_flag;
! DECL_INLINE (subprog_decl) = inline_flag;
TREE_READONLY (subprog_decl) = TYPE_READONLY (subprog_type);
TREE_THIS_VOLATILE (subprog_decl) = TYPE_VOLATILE (subprog_type);
--- 1790,1794 ----
DECL_EXTERNAL (subprog_decl) = extern_flag;
TREE_PUBLIC (subprog_decl) = public_flag;
! TREE_STATIC (subprog_decl) = 1;
TREE_READONLY (subprog_decl) = TYPE_READONLY (subprog_type);
TREE_THIS_VOLATILE (subprog_decl) = TYPE_VOLATILE (subprog_type);
*************** create_subprog_decl (tree subprog_name,
*** 1711,1714 ****
--- 1797,1803 ----
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)
SET_DECL_ASSEMBLER_NAME (subprog_decl, asm_name);
*************** begin_subprog_body (tree subprog_decl)
*** 1764,1856 ****
init_function_start (subprog_decl);
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
! to assembler language output. */
void
! end_subprog_body (void)
{
! tree decl;
! tree cico_list;
/* 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. */
BLOCK_VARS (current_binding_level->block) = 0;
! BLOCK_SUPERCONTEXT (current_binding_level->block) = current_function_decl;
! DECL_INITIAL (current_function_decl) = current_binding_level->block;
gnat_poplevel ();
/* Mark the RESULT_DECL as being in this subprogram. */
! DECL_CONTEXT (DECL_RESULT (current_function_decl)) = current_function_decl;
! expand_function_end ();
! /* If this is a nested function, push a new GC context. That will keep
! 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
! function. */
! if (!type_annotate_only)
! {
! rest_of_compilation (current_function_decl);
! if (! DECL_DEFER_OUTPUT (current_function_decl))
! {
! 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
! current_function_decl = 0;
}
--- 1853,1943 ----
init_function_start (subprog_decl);
expand_function_start (subprog_decl, 0);
}
/* Finish the definition of the current subprogram and compile it all the way
! to assembler language output. BODY is the tree corresponding to
! the subprogram. */
void
! end_subprog_body (tree body)
{
! tree fndecl = current_function_decl;
/* 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. */
BLOCK_VARS (current_binding_level->block) = 0;
! BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
! DECL_INITIAL (fndecl) = current_binding_level->block;
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. */
! DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
! DECL_SAVED_TREE (fndecl) = body;
! current_function_decl = DECL_CONTEXT (fndecl);
!
! /* If we're only annotating types, don't actually compile this function. */
! if (type_annotate_only)
! return;
!
! /* We do different things for nested and non-nested functions.
! ??? This should be in cgraph. */
! if (!DECL_CONTEXT (fndecl))
! {
! gnat_gimplify_function (fndecl);
! lower_nested_functions (fndecl);
! gnat_finalize (fndecl);
}
+ else
+ /* 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);
}
*************** convert (tree type, tree expr)
*** 2825,2829 ****
if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype))
return convert (type, fold (build (PLUS_EXPR, TREE_TYPE (etype),
! fold (build1 (GNAT_NOP_EXPR,
TREE_TYPE (etype), expr)),
TYPE_MIN_VALUE (etype))));
--- 2912,2916 ----
if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype))
return convert (type, fold (build (PLUS_EXPR, TREE_TYPE (etype),
! fold (build1 (NOP_EXPR,
TREE_TYPE (etype), expr)),
TYPE_MIN_VALUE (etype))));
*************** convert (tree type, tree expr)
*** 2865,2869 ****
return expr;
- case TRANSFORM_EXPR:
case NULL_EXPR:
/* Just set its type here. For TRANSFORM_EXPR, we will do the actual
--- 2952,2955 ----
*************** convert (tree type, tree expr)
*** 2960,2963 ****
--- 3046,3052 ----
return build1 (CONVERT_EXPR, type, expr);
+ case BOOLEAN_TYPE:
+ return fold (build1 (NOP_EXPR, type, gnat_truthvalue_conversion (expr)));
+
case INTEGER_TYPE:
if (TYPE_HAS_ACTUAL_BOUNDS_P (type)
*************** remove_conversions (tree exp, int true_a
*** 3107,3111 ****
case VIEW_CONVERT_EXPR: case NON_LVALUE_EXPR:
! case NOP_EXPR: case CONVERT_EXPR: case GNAT_NOP_EXPR:
return remove_conversions (TREE_OPERAND (exp, 0), true_address);
--- 3196,3200 ----
case VIEW_CONVERT_EXPR: case NON_LVALUE_EXPR:
! case NOP_EXPR: case CONVERT_EXPR:
return remove_conversions (TREE_OPERAND (exp, 0), true_address);
*************** unchecked_convert (tree type, tree expr,
*** 3210,3214 ****
TYPE_BIASED_REPRESENTATION_P (ntype) = 0;
TYPE_MAIN_VARIANT (ntype) = ntype;
! expr = build1 (GNAT_NOP_EXPR, ntype, expr);
}
--- 3299,3303 ----
TYPE_BIASED_REPRESENTATION_P (ntype) = 0;
TYPE_MAIN_VARIANT (ntype) = ntype;
! expr = build1 (NOP_EXPR, ntype, expr);
}
*************** unchecked_convert (tree type, tree expr,
*** 3223,3227 ****
expr = convert (rtype, expr);
if (type != rtype)
! expr = build1 (GNAT_NOP_EXPR, type, expr);
}
--- 3312,3316 ----
expr = convert (rtype, expr);
if (type != rtype)
! expr = build1 (NOP_EXPR, type, expr);
}
*** utils2.c 17 May 2004 04:19:18 -0000 1.21.4.18
--- utils2.c 7 Jun 2004 14:47:33 -0000
***************
*** 30,33 ****
--- 30,34 ----
#include "tm.h"
#include "tree.h"
+ #include "rtl.h"
#include "flags.h"
#include "output.h"
*************** build_unary_op (enum tree_code op_code,
*** 1346,1359 ****
tree
! build_cond_expr (tree result_type,
! tree condition_operand,
! tree true_operand,
! tree false_operand)
{
tree result;
int addr_p = 0;
! /* Front-end verifies that result, true and false operands have same base
! type. Convert everything to the result type. */
true_operand = convert (result_type, true_operand);
--- 1347,1358 ----
tree
! build_cond_expr (tree result_type, tree condition_operand,
! tree true_operand, tree false_operand)
{
tree result;
int addr_p = 0;
! /* The front-end verifies that result, true and false operands have same base
! type. Convert everything to the result type. */
true_operand = convert (result_type, true_operand);
*************** build_cond_expr (tree result_type,
*** 1362,1366 ****
/* If the result type is unconstrained, take the address of
the operands and then dereference our result. */
-
if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE
|| CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type)))
--- 1361,1364 ----
*************** build_call_raise (int msg)
*** 1451,1455 ****
{
tree fndecl = gnat_raise_decls[msg];
! const char *str = discard_file_names ? "" : ref_filename;
int len = strlen (str) + 1;
tree filename = build_string (len, str);
--- 1449,1453 ----
{
tree fndecl = gnat_raise_decls[msg];
! const char *str = Debug_Flag_NN ? "" : ref_filename;
int len = strlen (str) + 1;
tree filename = build_string (len, str);
*************** build_call_alloc_dealloc (tree gnu_obj,
*** 1744,1748 ****
else if (gnu_obj)
return build_call_1_expr (free_decl, gnu_obj);
! else if (gnat_pool == -1)
{
/* If the size is a constant, we can put it in the fixed portion of
--- 1742,1750 ----
else if (gnu_obj)
return build_call_1_expr (free_decl, gnu_obj);
!
! /* ??? 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
*************** build_call_alloc_dealloc (tree gnu_obj,
*** 1761,1765 ****
--- 1763,1770 ----
}
else
+ abort ();
+ #if 0
return build (ALLOCATE_EXPR, ptr_void_type_node, gnu_size, gnu_align);
+ #endif
}
else
*************** gnat_mark_addressable (tree expr_node)
*** 1978,1982 ****
case CONVERT_EXPR:
case NON_LVALUE_EXPR:
- case GNAT_NOP_EXPR:
case NOP_EXPR:
expr_node = TREE_OPERAND (expr_node, 0);
--- 1983,1986 ----
*************** gnat_mark_addressable (tree expr_node)
*** 1990,1994 ****
case PARM_DECL:
case RESULT_DECL:
! put_var_into_stack (expr_node, true);
return true;
--- 1994,2010 ----
case PARM_DECL:
case RESULT_DECL:
! /* 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;