Commit 169afcb9 by Eric Botcazou Committed by Eric Botcazou

decl.c (make_type_from_size): Just copy TYPE_NAME.

	* gcc-interface/decl.c (make_type_from_size) <INTEGER_TYPE>: Just copy
	TYPE_NAME.
	* gcc-interface/trans.c (smaller_packable_type_p): Rename into...
	(smaller_form_type_p): ...this.  Change parameter and variable names.
	(call_to_gnu): Use the nominal type of the parameter to create the
	temporary if it's a smaller form of the actual type.
	(addressable_p): Return false if the actual type is integral and its
	size is greater than that of the expected type.

From-SVN: r158398
parent 1f24872b
2010-04-16 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (make_type_from_size) <INTEGER_TYPE>: Just copy
TYPE_NAME.
* gcc-interface/trans.c (smaller_packable_type_p): Rename into...
(smaller_form_type_p): ...this. Change parameter and variable names.
(call_to_gnu): Use the nominal type of the parameter to create the
temporary if it's a smaller form of the actual type.
(addressable_p): Return false if the actual type is integral and its
size is greater than that of the expected type.
2010-04-15 Eric Botcazou <ebotcazou@adacore.com> 2010-04-15 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/cuintp.c (UI_To_gnu): Fix long line. * gcc-interface/cuintp.c (UI_To_gnu): Fix long line.
......
...@@ -7748,14 +7748,9 @@ make_type_from_size (tree type, tree size_tree, bool for_biased) ...@@ -7748,14 +7748,9 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
SET_TYPE_RM_MAX_VALUE (new_type, SET_TYPE_RM_MAX_VALUE (new_type,
convert (TREE_TYPE (new_type), convert (TREE_TYPE (new_type),
TYPE_MAX_VALUE (type))); TYPE_MAX_VALUE (type)));
/* Propagate the name to avoid creating a fake subrange type. */ /* Copy the name to show that it's essentially the same type and
if (TYPE_NAME (type)) not a subrange type. */
{ TYPE_NAME (new_type) = TYPE_NAME (type);
if (TREE_CODE (TYPE_NAME (type)) == TYPE_DECL)
TYPE_NAME (new_type) = DECL_NAME (TYPE_NAME (type));
else
TYPE_NAME (new_type) = TYPE_NAME (type);
}
TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p; TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
SET_TYPE_RM_SIZE (new_type, bitsize_int (size)); SET_TYPE_RM_SIZE (new_type, bitsize_int (size));
return new_type; return new_type;
......
...@@ -207,7 +207,7 @@ static tree emit_check (tree, tree, int, Node_Id); ...@@ -207,7 +207,7 @@ static tree emit_check (tree, tree, int, Node_Id);
static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id); static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id);
static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id); static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id);
static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id); static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id);
static bool smaller_packable_type_p (tree, tree); static bool smaller_form_type_p (tree, tree);
static bool addressable_p (tree, tree); static bool addressable_p (tree, tree);
static tree assoc_to_constructor (Entity_Id, Node_Id, tree); static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
static tree extract_values (tree, tree); static tree extract_values (tree, tree);
...@@ -2639,17 +2639,21 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) ...@@ -2639,17 +2639,21 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
(TREE_TYPE (TREE_OPERAND (gnu_name, 0)))) (TREE_TYPE (TREE_OPERAND (gnu_name, 0))))
gnu_orig = gnu_name = TREE_OPERAND (gnu_name, 0); gnu_orig = gnu_name = TREE_OPERAND (gnu_name, 0);
/* Otherwise convert to the nominal type of the object if it's /* Otherwise convert to the nominal type of the object if needed.
a record type. There are several cases in which we need to There are several cases in which we need to make the temporary
make the temporary using this type instead of the actual type using this type instead of the actual type of the object when
of the object if they are distinct, because the expectations they are distinct, because the expectations of the callee would
of the callee would otherwise not be met: otherwise not be met:
- if it's a justified modular type, - if it's a justified modular type,
- if the actual type is a smaller packable version of it. */ - if the actual type is a smaller form of it,
else if (TREE_CODE (gnu_name_type) == RECORD_TYPE - if it's a smaller form of the actual type. */
&& (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type) else if ((TREE_CODE (gnu_name_type) == RECORD_TYPE
|| smaller_packable_type_p (TREE_TYPE (gnu_name), && (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)
gnu_name_type))) || smaller_form_type_p (TREE_TYPE (gnu_name),
gnu_name_type)))
|| (INTEGRAL_TYPE_P (gnu_name_type)
&& smaller_form_type_p (gnu_name_type,
TREE_TYPE (gnu_name))))
gnu_name = convert (gnu_name_type, gnu_name); gnu_name = convert (gnu_name_type, gnu_name);
/* Create an explicit temporary holding the copy. This ensures that /* Create an explicit temporary holding the copy. This ensures that
...@@ -6873,28 +6877,28 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp, ...@@ -6873,28 +6877,28 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
return convert (gnu_type, gnu_result); return convert (gnu_type, gnu_result);
} }
/* Return true if TYPE is a smaller packable version of RECORD_TYPE. */ /* Return true if TYPE is a smaller form of ORIG_TYPE. */
static bool static bool
smaller_packable_type_p (tree type, tree record_type) smaller_form_type_p (tree type, tree orig_type)
{ {
tree size, rsize; tree size, osize;
/* We're not interested in variants here. */ /* We're not interested in variants here. */
if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (record_type)) if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (orig_type))
return false; return false;
/* Like a variant, a packable version keeps the original TYPE_NAME. */ /* Like a variant, a packable version keeps the original TYPE_NAME. */
if (TYPE_NAME (type) != TYPE_NAME (record_type)) if (TYPE_NAME (type) != TYPE_NAME (orig_type))
return false; return false;
size = TYPE_SIZE (type); size = TYPE_SIZE (type);
rsize = TYPE_SIZE (record_type); osize = TYPE_SIZE (orig_type);
if (!(TREE_CODE (size) == INTEGER_CST && TREE_CODE (rsize) == INTEGER_CST)) if (!(TREE_CODE (size) == INTEGER_CST && TREE_CODE (osize) == INTEGER_CST))
return false; return false;
return tree_int_cst_lt (size, rsize) != 0; return tree_int_cst_lt (size, osize) != 0;
} }
/* Return true if GNU_EXPR can be directly addressed. This is the case /* Return true if GNU_EXPR can be directly addressed. This is the case
...@@ -6959,13 +6963,21 @@ smaller_packable_type_p (tree type, tree record_type) ...@@ -6959,13 +6963,21 @@ smaller_packable_type_p (tree type, tree record_type)
static bool static bool
addressable_p (tree gnu_expr, tree gnu_type) addressable_p (tree gnu_expr, tree gnu_type)
{ {
/* The size of the real type of the object must not be smaller than /* For an integral type, the size of the actual type of the object may not
that of the expected type, otherwise an indirect access in the be greater than that of the expected type, otherwise an indirect access
latter type would be larger than the object. Only records need in the latter type wouldn't correctly set all the bits of the object. */
to be considered in practice. */ if (gnu_type
&& INTEGRAL_TYPE_P (gnu_type)
&& smaller_form_type_p (gnu_type, TREE_TYPE (gnu_expr)))
return false;
/* The size of the actual type of the object may not be smaller than that
of the expected type, otherwise an indirect access in the latter type
would be larger than the object. But only record types need to be
considered in practice for this case. */
if (gnu_type if (gnu_type
&& TREE_CODE (gnu_type) == RECORD_TYPE && TREE_CODE (gnu_type) == RECORD_TYPE
&& smaller_packable_type_p (TREE_TYPE (gnu_expr), gnu_type)) && smaller_form_type_p (TREE_TYPE (gnu_expr), gnu_type))
return false; return false;
switch (TREE_CODE (gnu_expr)) switch (TREE_CODE (gnu_expr))
......
2010-04-16 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/wide_boolean.adb: New test.
* gnat.dg/wide_boolean_pkg.ad[sb]: New helper.
2010-04-15 Richard Guenther <rguenther@suse.de> 2010-04-15 Richard Guenther <rguenther@suse.de>
* gcc.dg/ipa/ipa-pta-1.c: New testcase. * gcc.dg/ipa/ipa-pta-1.c: New testcase.
......
-- { dg-do run }
with Wide_Boolean_Pkg; use Wide_Boolean_Pkg;
procedure Wide_Boolean is
R : TREC;
LB_TEST_BOOL : TBOOL;
begin
R.B := FALSE;
LB_TEST_BOOL := FALSE;
Modify (R.H, R.B);
if (R.B /= TRUE) then
raise Program_Error;
end if;
Modify (R.H, LB_TEST_BOOL);
R.B := LB_TEST_BOOL;
if (R.B /= TRUE) then
raise Program_Error;
end if;
end;
package body Wide_Boolean_Pkg is
procedure Modify (LH : in out TUINT32; LB : in out TBOOL) is
begin
LH := 16#12345678#;
LB := TRUE;
end;
end Wide_Boolean_Pkg;
package Wide_Boolean_Pkg is
type TBOOL is new BOOLEAN;
for TBOOL use (FALSE => 0, TRUE => 1);
for TBOOL'SIZE use 8;
type TUINT32 is mod (2 ** 32);
for TUINT32'SIZE use 32;
type TREC is
record
H : TUINT32;
B : TBOOL;
end record;
for TREC use
record
H at 0 range 0..31;
B at 4 range 0..31;
end record;
procedure Modify (LH : in out TUINT32; LB : in out TBOOL);
pragma export(C, Modify, "Modify");
end Wide_Boolean_Pkg;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment