From: Eric Botcazou Date: Thu, 16 Jun 2005 08:56:46 +0000 (+0200) Subject: re PR ada/20515 ("stdcall" imports are not handled correctly) X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=ea6ac8593835b4fbff1a4f163a0e652bfa612852;p=platform%2Fupstream%2Fgcc.git re PR ada/20515 ("stdcall" imports are not handled correctly) 2005-06-10 Eric Botcazou Olivier Hainque Richard Kenner Pascal Obry * gigi.h: (build_allocator): Add arg IGNORE_INIT_TYPE. * trans.c (call_to_gnu): Issue a warning for users of Starlet when making a temporary around a procedure call because of non-addressable actual parameter. (process_freeze_entity): If entity is a private type, capture size information that may have been computed for the full view. (tree_transform, case N_Allocator): If have initializing expression, check type for Has_Constrained_Partial_View and pass that to build_allocator. (tree_transform, case N_Return_Statement): Pass extra arg to build_allocator. * decl.c (annotate_value): Remove early return if -gnatR is not specified. (gnat_to_gnu_field): Don't make a packable type for a component clause if the position is byte aligned, the field is aliased, and the clause size isn't a multiple of the packable alignment. It serves no useful purpose packing-wise and would be rejected later on. (gnat_to_gnu_entity, case object): Pass extra arg to build_allocator. PR ada/20515 (gnat_to_gnu_entity): Remove use of macro _WIN32 which is wrong in the context of cross compilers. We use TARGET_DLLIMPORT_DECL_ATTRIBUTES instead. (create_concat_name): Idem. From-SVN: r101070 --- diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index bd9f260..b2d9d1c 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -958,8 +958,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) post_error ("Storage_Error will be raised at run-time?", gnat_entity); - gnu_expr = build_allocator (gnu_alloc_type, gnu_expr, - gnu_type, 0, 0, gnat_entity); + gnu_expr = build_allocator (gnu_alloc_type, gnu_expr, gnu_type, + 0, 0, gnat_entity, false); } else { @@ -3630,7 +3630,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (list_length (gnu_return_list) == 1) gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_return_list)); -#ifdef _WIN32 +#ifdef TARGET_DLLIMPORT_DECL_ATTRIBUTES if (Convention (gnat_entity) == Convention_Stdcall) { struct attrib *attr @@ -5111,7 +5111,6 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, { tree gnu_field_id = get_entity_name (gnat_field); tree gnu_field_type = gnat_to_gnu_type (Etype (gnat_field)); - tree gnu_orig_field_type = gnu_field_type; tree gnu_pos = 0; tree gnu_size = 0; tree gnu_field; @@ -5138,24 +5137,47 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, gnat_field, FIELD_DECL, false, true); /* If we are packing this record, have a specified size that's smaller than - that of the field type, or a position is specified, and the field type - is also a record that's BLKmode and with a small constant size, see if - we can get a better form of the type that allows more packing. If we - can, show a size was specified for it if there wasn't one so we know to - make this a bitfield and avoid making things wider. */ + that of the field type, or a position is specified, and the field type is + also a record that's BLKmode and with a small constant size, see if we + can get a better form of the type that allows more packing. If we can, + show a size was specified for it if there wasn't one so we know to make + this a bitfield and avoid making things wider. */ if (TREE_CODE (gnu_field_type) == RECORD_TYPE && TYPE_MODE (gnu_field_type) == BLKmode && host_integerp (TYPE_SIZE (gnu_field_type), 1) && compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0 && (packed == 1 - || (gnu_size && tree_int_cst_lt (gnu_size, - TYPE_SIZE (gnu_field_type))) + || (gnu_size + && tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))) || Present (Component_Clause (gnat_field)))) { - gnu_field_type = make_packable_type (gnu_field_type); - - if (gnu_field_type != gnu_orig_field_type && !gnu_size) - gnu_size = rm_size (gnu_field_type); + /* See what the alternate type and size would be. */ + tree gnu_packable_type = make_packable_type (gnu_field_type); + + /* Compute whether we should avoid the substitution. */ + int reject = + /* There is no point subtituting if there is no change. */ + (gnu_packable_type == gnu_field_type + || + /* The size of an aliased field must be an exact multiple of the + type's alignment, which the substitution might increase. Reject + substitutions that would so invalidate a component clause when the + specified position is byte aligned, as the change would have no + real benefit from the packing standpoint anyway. */ + (Is_Aliased (gnat_field) + && Present (Component_Clause (gnat_field)) + && UI_To_Int (Component_Bit_Offset (gnat_field)) % BITS_PER_UNIT == 0 + && tree_low_cst (gnu_size, 1) % TYPE_ALIGN (gnu_packable_type) != 0) + ); + + /* Substitute unless told otherwise. */ + if (!reject) + { + gnu_field_type = gnu_packable_type; + + if (gnu_size == 0) + gnu_size = rm_size (gnu_field_type); + } } /* If we are packing the record and the field is BLKmode, round the @@ -5678,10 +5700,6 @@ annotate_value (tree gnu_size) int i; int size; - /* If back annotation is suppressed by the front end, return No_Uint */ - if (!Back_Annotate_Rep_Info) - return No_Uint; - /* See if we've already saved the value for this node. */ if (EXPR_P (gnu_size) && TREE_COMPLEXITY (gnu_size)) return (Node_Ref_Or_Val) TREE_COMPLEXITY (gnu_size); @@ -6606,7 +6624,7 @@ create_concat_name (Entity_Id gnat_entity, const char *suffix) Get_External_Name_With_Suffix (gnat_entity, fp); -#ifdef _WIN32 +#ifdef TARGET_DLLIMPORT_DECL_ATTRIBUTES /* A variable using the Stdcall convention (meaning we are running on a Windows box) live in a DLL. Here we adjust its name to use the jump-table, the _imp__NAME contains the address for the NAME diff --git a/gcc/ada/gigi.h b/gcc/ada/gigi.h index 79fdf51..fe2f110 100644 --- a/gcc/ada/gigi.h +++ b/gcc/ada/gigi.h @@ -709,10 +709,13 @@ extern tree build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, RESULT_TYPE, which must be some type of pointer. Return the tree. GNAT_PROC and GNAT_POOL optionally give the procedure to call and the storage pool to use. GNAT_NODE is used to provide an error - location for restriction violations messages. */ + location for restriction violations messages. If IGNORE_INIT_TYPE is + true, ignore the type of INIT for the purpose of determining the size; + this will cause the maximum size to be allocated if TYPE is of + self-referential size. */ extern tree build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, Entity_Id gnat_pool, - Node_Id gnat_node); + Node_Id gnat_node, bool); /* Fill in a VMS descriptor for EXPR and return a constructor for it. GNAT_FORMAL is how we find the descriptor record. */ diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index 36b5ba2..8bd2830 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -592,7 +592,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) /* If we are taking 'Address of an unconstrained object, this is the pointer to the underlying array. */ - gnu_prefix = maybe_unconstrained_array (gnu_prefix); + if (attribute == Attr_Address) + gnu_prefix = maybe_unconstrained_array (gnu_prefix); /* ... fall through ... */ @@ -1633,6 +1634,27 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) tree gnu_copy = gnu_name; tree gnu_temp; + /* For users of Starlet we issue a warning because the + interface apparently assumes that by-ref parameters + outlive the procedure invocation. The code still + will not work as intended, but we cannot do much + better since other low-level parts of the back-end + would allocate temporaries at will because of the + misalignment if we did not do so here. */ + + if (Is_Valued_Procedure (Entity (Name (gnat_node)))) + { + post_error + ("?possible violation of implicit assumption", + gnat_actual); + post_error_ne + ("?made by pragma Import_Valued_Procedure on &", + gnat_actual, Entity (Name (gnat_node))); + post_error_ne + ("?because of misalignment of &", + gnat_actual, gnat_formal); + } + /* Remove any unpadding on the actual and make a copy. But if the actual is a justified modular type, first convert to it. */ @@ -3319,6 +3341,7 @@ gnat_to_gnu (Node_Id gnat_node) { tree gnu_init = 0; tree gnu_type; + bool ignore_init_type = false; gnat_temp = Expression (gnat_node); @@ -3334,6 +3357,7 @@ gnat_to_gnu (Node_Id gnat_node) Entity_Id gnat_desig_type = Designated_Type (Underlying_Type (Etype (gnat_node))); + ignore_init_type = Has_Constrained_Partial_View (gnat_desig_type); gnu_init = gnat_to_gnu (Expression (gnat_temp)); gnu_init = maybe_unconstrained_array (gnu_init); @@ -3361,7 +3385,8 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result_type = get_unpadded_type (Etype (gnat_node)); return build_allocator (gnu_type, gnu_init, gnu_result_type, Procedure_To_Call (gnat_node), - Storage_Pool (gnat_node), gnat_node); + Storage_Pool (gnat_node), gnat_node, + ignore_init_type); } break; @@ -3576,7 +3601,7 @@ gnat_to_gnu (Node_Id gnat_node) = build_allocator (TREE_TYPE (gnu_ret_val), gnu_ret_val, TREE_TYPE (gnu_subprog_type), - 0, -1, gnat_node); + 0, -1, gnat_node, false); else gnu_ret_val = build_allocator (TREE_TYPE (gnu_ret_val), @@ -3584,7 +3609,7 @@ gnat_to_gnu (Node_Id gnat_node) TREE_TYPE (gnu_subprog_type), Procedure_To_Call (gnat_node), Storage_Pool (gnat_node), - gnat_node); + gnat_node, false); } } } @@ -4754,11 +4779,15 @@ process_freeze_entity (Node_Id gnat_node) /* Don't do anything for subprograms that may have been elaborated before their freeze nodes. This can happen, for example because of an inner call - in an instance body. */ - if (gnu_old - && TREE_CODE (gnu_old) == FUNCTION_DECL - && (Ekind (gnat_entity) == E_Function + in an instance body, or a previous compilation of a spec for inlining + purposes. */ + if ((gnu_old + && TREE_CODE (gnu_old) == FUNCTION_DECL + && (Ekind (gnat_entity) == E_Function || Ekind (gnat_entity) == E_Procedure)) + || (gnu_old + && (TREE_CODE (TREE_TYPE (gnu_old)) == FUNCTION_TYPE + && Ekind (gnat_entity) == E_Subprogram_Type))) return; /* If we have a non-dummy type old tree, we have nothing to do. Unless @@ -4798,6 +4827,16 @@ process_freeze_entity (Node_Id gnat_node) { gnu_new = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 1); + /* Propagate back-annotations from full view to partial view. */ + if (Unknown_Alignment (gnat_entity)) + Set_Alignment (gnat_entity, Alignment (Full_View (gnat_entity))); + + if (Unknown_Esize (gnat_entity)) + Set_Esize (gnat_entity, Esize (Full_View (gnat_entity))); + + if (Unknown_RM_Size (gnat_entity)) + Set_RM_Size (gnat_entity, RM_Size (Full_View (gnat_entity))); + /* The above call may have defined this entity (the simplest example of this is when we have a private enumeral type since the bounds will have the public view. */