diff options
Diffstat (limited to 'gcc/ada/gcc-interface/trans.c')
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 161 |
1 files changed, 74 insertions, 87 deletions
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index a90a7a0..2669bde 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -3454,64 +3454,55 @@ unchecked_conversion_lhs_nop (Node_Id gnat_node) return false; } -/* 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 occurring after - anything `it already added. */ +/* 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 this + is a statement, return the statement or add it to the current statement + group, in which case anything returned is to be interpreted as occurring + after anything added. */ tree gnat_to_gnu (Node_Id gnat_node) { + const Node_Kind kind = Nkind (gnat_node); bool went_into_elab_proc = false; tree gnu_result = error_mark_node; /* Default to no value. */ tree gnu_result_type = void_type_node; - tree gnu_expr; - tree gnu_lhs, gnu_rhs; + tree gnu_expr, gnu_lhs, gnu_rhs; Node_Id gnat_temp; /* 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)) + /* If this node is a statement and we are only annotating types, return an + empty statement list. */ + if (type_annotate_only && IN (kind, 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 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 + && IN (kind, N_Subexpr) + && kind != 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, gnat_node, N_Raise_Constraint_Error)); - /* If this is a Statement and we are at top level, it must be part of the - elaboration procedure, so mark us as being in that procedure and push our - context. - - If we are in the elaboration procedure, check if we are violating a - No_Elaboration_Code restriction by having a statement there. */ - if ((IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call) - && Nkind (gnat_node) != N_Null_Statement - && Nkind (gnat_node) != N_SCIL_Dispatch_Table_Object_Init - && Nkind (gnat_node) != N_SCIL_Dispatch_Table_Tag_Init - && Nkind (gnat_node) != N_SCIL_Dispatching_Call - && Nkind (gnat_node) != N_SCIL_Tag_Init) - || Nkind (gnat_node) == N_Procedure_Call_Statement - || Nkind (gnat_node) == N_Label - || Nkind (gnat_node) == N_Implicit_Label_Declaration - || Nkind (gnat_node) == N_Handled_Sequence_Of_Statements - || ((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))) + if ((IN (kind, N_Statement_Other_Than_Procedure_Call) + && !IN (kind, N_SCIL_Node) + && kind != N_Null_Statement) + || kind == N_Procedure_Call_Statement + || kind == N_Label + || kind == N_Implicit_Label_Declaration + || kind == N_Handled_Sequence_Of_Statements + || (IN (kind, N_Raise_xxx_Error) && Ekind (Etype (gnat_node)) == E_Void)) { + /* If this is a statement and we are at top level, it must be part of + the elaboration procedure, so mark us as being in that procedure + and push our context. */ if (!current_function_decl) { current_function_decl = TREE_VALUE (gnu_elab_proc_stack); @@ -3520,18 +3511,19 @@ gnat_to_gnu (Node_Id gnat_node) went_into_elab_proc = true; } - /* Don't check for a possible No_Elaboration_Code restriction violation - on N_Handled_Sequence_Of_Statements, as we want to signal an error on + /* If we are in the elaboration procedure, check if we are violating a + No_Elaboration_Code restriction by having a statement there. Don't + check for a possible No_Elaboration_Code restriction violation on + N_Handled_Sequence_Of_Statements, as we want to signal an error on every nested real statement instead. This also avoids triggering spurious errors on dummy (empty) sequences created by the front-end for package bodies in some cases. */ - if (current_function_decl == TREE_VALUE (gnu_elab_proc_stack) - && Nkind (gnat_node) != N_Handled_Sequence_Of_Statements) + && kind != N_Handled_Sequence_Of_Statements) Check_Elaboration_Code_Allowed (gnat_node); } - switch (Nkind (gnat_node)) + switch (kind) { /********************************/ /* Chapter 2: Lexical Elements */ @@ -3743,8 +3735,7 @@ gnat_to_gnu (Node_Id gnat_node) break; if (Present (Expression (gnat_node)) - && !(Nkind (gnat_node) == N_Object_Declaration - && No_Initialization (gnat_node)) + && !(kind == N_Object_Declaration && No_Initialization (gnat_node)) && (!type_annotate_only || Compile_Time_Known_Value (Expression (gnat_node)))) { @@ -4136,7 +4127,7 @@ gnat_to_gnu (Node_Id gnat_node) = convert_with_check (Etype (gnat_node), gnu_result, Do_Overflow_Check (gnat_node), Do_Range_Check (Expression (gnat_node)), - Nkind (gnat_node) == N_Type_Conversion + kind == N_Type_Conversion && Float_Truncate (gnat_node), gnat_node); break; @@ -4224,7 +4215,7 @@ gnat_to_gnu (Node_Id gnat_node) gnu_object, gnu_high)); } - if (Nkind (gnat_node) == N_Not_In) + if (kind == N_Not_In) gnu_result = invert_truthvalue (gnu_result); } break; @@ -4248,8 +4239,8 @@ gnat_to_gnu (Node_Id gnat_node) Modular_Integer_Kind)) { enum tree_code code - = (Nkind (gnat_node) == N_Op_Or ? BIT_IOR_EXPR - : Nkind (gnat_node) == N_Op_And ? BIT_AND_EXPR + = (kind == N_Op_Or ? BIT_IOR_EXPR + : kind == N_Op_And ? BIT_AND_EXPR : BIT_XOR_EXPR); gnu_lhs = gnat_to_gnu (Left_Opnd (gnat_node)); @@ -4273,7 +4264,7 @@ gnat_to_gnu (Node_Id gnat_node) case N_Op_Shift_Right_Arithmetic: case N_And_Then: case N_Or_Else: { - enum tree_code code = gnu_codes[Nkind (gnat_node)]; + enum tree_code code = gnu_codes[kind]; bool ignore_lhs_overflow = false; tree gnu_type; @@ -4299,18 +4290,16 @@ gnat_to_gnu (Node_Id gnat_node) /* If this is a shift whose count is not guaranteed to be correct, we need to adjust the shift count. */ - if (IN (Nkind (gnat_node), N_Op_Shift) - && !Shift_Count_OK (gnat_node)) + if (IN (kind, N_Op_Shift) && !Shift_Count_OK (gnat_node)) { tree gnu_count_type = get_base_type (TREE_TYPE (gnu_rhs)); tree gnu_max_shift = convert (gnu_count_type, TYPE_SIZE (gnu_type)); - if (Nkind (gnat_node) == N_Op_Rotate_Left - || Nkind (gnat_node) == N_Op_Rotate_Right) + if (kind == N_Op_Rotate_Left || kind == N_Op_Rotate_Right) gnu_rhs = build_binary_op (TRUNC_MOD_EXPR, gnu_count_type, gnu_rhs, gnu_max_shift); - else if (Nkind (gnat_node) == N_Op_Shift_Right_Arithmetic) + else if (kind == N_Op_Shift_Right_Arithmetic) gnu_rhs = build_binary_op (MIN_EXPR, gnu_count_type, @@ -4326,13 +4315,12 @@ gnat_to_gnu (Node_Id gnat_node) so we may need to choose a different type. In this case, we have to ignore integer overflow lest it propagates all the way down and causes a CE to be explicitly raised. */ - if (Nkind (gnat_node) == N_Op_Shift_Right - && !TYPE_UNSIGNED (gnu_type)) + if (kind == N_Op_Shift_Right && !TYPE_UNSIGNED (gnu_type)) { gnu_type = gnat_unsigned_type (gnu_type); ignore_lhs_overflow = true; } - else if (Nkind (gnat_node) == N_Op_Shift_Right_Arithmetic + else if (kind == N_Op_Shift_Right_Arithmetic && TYPE_UNSIGNED (gnu_type)) { gnu_type = gnat_signed_type (gnu_type); @@ -4355,9 +4343,9 @@ gnat_to_gnu (Node_Id gnat_node) do overflow checking, do it here. The goal is to push the expansions further into the back end over time. */ if (Do_Overflow_Check (gnat_node) && Backend_Overflow_Checks_On_Target - && (Nkind (gnat_node) == N_Op_Add - || Nkind (gnat_node) == N_Op_Subtract - || Nkind (gnat_node) == N_Op_Multiply) + && (kind == N_Op_Add + || kind == N_Op_Subtract + || kind == N_Op_Multiply) && !TYPE_UNSIGNED (gnu_type) && !FLOAT_TYPE_P (gnu_type)) gnu_result = build_binary_op_trapv (code, gnu_type, @@ -4368,8 +4356,7 @@ gnat_to_gnu (Node_Id gnat_node) /* If this is a logical shift with the shift count not verified, we must return zero if it is too large. We cannot compensate above in this case. */ - if ((Nkind (gnat_node) == N_Op_Shift_Left - || Nkind (gnat_node) == N_Op_Shift_Right) + if ((kind == N_Op_Shift_Left || kind == N_Op_Shift_Right) && !Shift_Count_OK (gnat_node)) gnu_result = build_cond_expr @@ -4391,9 +4378,8 @@ gnat_to_gnu (Node_Id gnat_node) = gnat_to_gnu (Next (Next (First (Expressions (gnat_node))))); gnu_result_type = get_unpadded_type (Etype (gnat_node)); - gnu_result = build_cond_expr (gnu_result_type, - gnat_truthvalue_conversion (gnu_cond), - gnu_true, gnu_false); + gnu_result + = build_cond_expr (gnu_result_type, gnu_cond, gnu_true, gnu_false); } break; @@ -4432,10 +4418,10 @@ gnat_to_gnu (Node_Id gnat_node) && !TYPE_UNSIGNED (gnu_result_type) && !FLOAT_TYPE_P (gnu_result_type)) gnu_result - = build_unary_op_trapv (gnu_codes[Nkind (gnat_node)], + = build_unary_op_trapv (gnu_codes[kind], gnu_result_type, gnu_expr, gnat_node); else - gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)], + gnu_result = build_unary_op (gnu_codes[kind], gnu_result_type, gnu_expr); break; @@ -5204,8 +5190,7 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result_type = get_unpadded_type (Etype (gnat_node)); gnu_result - = build_call_raise (UI_To_Int (Reason (gnat_node)), gnat_node, - Nkind (gnat_node)); + = build_call_raise (UI_To_Int (Reason (gnat_node)), gnat_node, kind); /* If the type is VOID, this is a statement, so we need to generate the code for the call. Handle a Condition, if there @@ -5564,14 +5549,14 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) /* Mark everything as used to prevent node sharing with subprograms. Note that walk_tree knows how to deal with TYPE_DECL, but neither VAR_DECL nor CONST_DECL. This appears to be somewhat arbitrary. */ - mark_visited (&gnu_stmt); + MARK_VISITED (gnu_stmt); if (TREE_CODE (gnu_decl) == VAR_DECL || TREE_CODE (gnu_decl) == CONST_DECL) { - mark_visited (&DECL_SIZE (gnu_decl)); - mark_visited (&DECL_SIZE_UNIT (gnu_decl)); - mark_visited (&DECL_INITIAL (gnu_decl)); + MARK_VISITED (DECL_SIZE (gnu_decl)); + MARK_VISITED (DECL_SIZE_UNIT (gnu_decl)); + MARK_VISITED (DECL_INITIAL (gnu_decl)); } } else @@ -5611,20 +5596,32 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) static tree mark_visited_r (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED) { - if (TREE_VISITED (*tp)) + tree t = *tp; + + if (TREE_VISITED (t)) *walk_subtrees = 0; /* Don't mark a dummy type as visited because we want to mark its sizes and fields once it's filled in. */ - else if (!TYPE_IS_DUMMY_P (*tp)) - TREE_VISITED (*tp) = 1; + else if (!TYPE_IS_DUMMY_P (t)) + TREE_VISITED (t) = 1; - if (TYPE_P (*tp)) - TYPE_SIZES_GIMPLIFIED (*tp) = 1; + if (TYPE_P (t)) + TYPE_SIZES_GIMPLIFIED (t) = 1; return NULL_TREE; } +/* Mark nodes rooted at T with TREE_VISITED and types as having their + sized gimplified. We use this to indicate all variable sizes and + positions in global types may not be shared by any subprogram. */ + +void +mark_visited (tree t) +{ + walk_tree (&t, mark_visited_r, NULL, NULL); +} + /* Utility function to unshare expressions wrapped up in a SAVE_EXPR. */ static tree @@ -5639,16 +5636,6 @@ unshare_save_expr (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED, return NULL_TREE; } -/* Mark nodes rooted at *TP with TREE_VISITED and types as having their - sized gimplified. We use this to indicate all variable sizes and - positions in global types may not be shared by any subprogram. */ - -void -mark_visited (tree *tp) -{ - walk_tree (tp, mark_visited_r, NULL, NULL); -} - /* Add GNU_CLEANUP, a cleanup action, to the current code group and set its location to that of GNAT_NODE if present. */ |