diff options
author | ebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-07-30 23:54:56 +0000 |
---|---|---|
committer | ebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-07-30 23:54:56 +0000 |
commit | 69c2baa9a0942ccd820712d04ca645cb0bbc8f99 (patch) | |
tree | 87a4eb9f676e3356453c46961c4ca3f72f9bd2a7 | |
parent | efc49b995db1f178dcf1ff5bed91c30d27327ce6 (diff) | |
download | gcc-69c2baa9a0942ccd820712d04ca645cb0bbc8f99.tar.gz |
PR ada/36554
* dwarf2out.c (is_subrange_type): Deal with BOOLEAN_TYPE.
ada/
* back_end.adb (Call_Back_End): Pass Standard_Boolean to gigi.
* gcc-interface/gigi.h (gigi): Take new standard_boolean parameter.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Enumeration_Subtype>:
Set precision to 1 for subtype of BOOLEAN_TYPE.
(set_rm_size): Set TYPE_RM_SIZE_NUM for BOOLEAN_TYPE.
(make_type_from_size): Deal with BOOLEAN_TYPE.
* gcc-interface/misc.c (gnat_print_type): Likewise.
* gcc-interface/trans.c (gigi): Take new standard_boolean parameter.
Set boolean_type_node as its translation in the table, as well
as boolean_false_node for False and boolean_true_node for True.
* gcc-interface/utils.c (gnat_init_decl_processing): Create custom
8-bit boolean_type_node and set its TYPE_RM_SIZE_NUM.
(create_param_decl): Deal with BOOLEAN_TYPE.
(build_vms_descriptor): Likewise.
(build_vms_descriptor64): Likewise.
(convert): Deal with BOOLEAN_TYPE like with ENUMERAL_TYPE.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@138348 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/ChangeLog | 26 | ||||
-rw-r--r-- | gcc/ada/back_end.adb | 2 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/decl.c | 33 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/gigi.h | 1 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/misc.c | 1 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/trans.c | 28 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/utils.c | 16 | ||||
-rw-r--r-- | gcc/dwarf2out.c | 3 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/boolean_expr.adb | 30 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/boolean_expr.ads | 5 |
12 files changed, 138 insertions, 18 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index e2b535a9e74..3584c53ca45 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,8 @@ +2008-07-30 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/36554 + * dwarf2out.c (is_subrange_type): Deal with BOOLEAN_TYPE. + 2008-07-30 Rafael Avila de Espindola <espindola@google.com> PR 36974 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b000c134db6..36c493e7ab5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2008-07-30 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/36554 + * back_end.adb (Call_Back_End): Pass Standard_Boolean to gigi. + * gcc-interface/gigi.h (gigi): Take new standard_boolean parameter. + * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Enumeration_Subtype>: + Set precision to 1 for subtype of BOOLEAN_TYPE. + (set_rm_size): Set TYPE_RM_SIZE_NUM for BOOLEAN_TYPE. + (make_type_from_size): Deal with BOOLEAN_TYPE. + * gcc-interface/misc.c (gnat_print_type): Likewise. + * gcc-interface/trans.c (gigi): Take new standard_boolean parameter. + Set boolean_type_node as its translation in the table, as well + as boolean_false_node for False and boolean_true_node for True. + * gcc-interface/utils.c (gnat_init_decl_processing): Create custom + 8-bit boolean_type_node and set its TYPE_RM_SIZE_NUM. + (create_param_decl): Deal with BOOLEAN_TYPE. + (build_vms_descriptor): Likewise. + (build_vms_descriptor64): Likewise. + (convert): Deal with BOOLEAN_TYPE like with ENUMERAL_TYPE. + 2008-07-30 Robert Dewar <dewar@adacore.com> * exp_ch9.adb: Minor reformatting @@ -16948,7 +16968,7 @@ PR ada/10768 * utils.c (create_var_decl): Use have_global_bss_p when deciding whether to make the decl common. -2006-02-20 Rafael Ávila de Espíndola <rafael.espindola@gmail.com> +2006-02-20 Rafael �vila de Esp�ndola <rafael.espindola@gmail.com> * Make-lang.in (Ada): Remove. (.PHONY): Remove Ada @@ -19406,11 +19426,11 @@ PR ada/10768 * s-bitops.adb: Clarify comment for Bits_Array -2005-12-07 Rafael Ávila de Espíndola <rafael.espindola@gmail.com> +2005-12-07 Rafael �vila de Esp�ndola <rafael.espindola@gmail.com> * Make-lang.in (ada.install-normal): Remove. -2005-12-07 Rafael Ávila de Espíndola <rafael.espindola@gmail.com> +2005-12-07 Rafael �vila de Esp�ndola <rafael.espindola@gmail.com> * Make-lang.in: Remove all dependencies on s-gtype. diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index a6600764988..7a4e4dadf0f 100644 --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -76,6 +76,7 @@ package body Back_End is number_file : Nat; file_info_ptr : Address; + gigi_standard_boolean : Entity_Id; gigi_standard_integer : Entity_Id; gigi_standard_long_long_float : Entity_Id; gigi_standard_exception_type : Entity_Id; @@ -112,6 +113,7 @@ package body Back_End is number_file => Num_Source_Files, file_info_ptr => File_Info_Array'Address, + gigi_standard_boolean => Standard_Boolean, gigi_standard_integer => Standard_Integer, gigi_standard_long_long_float => Standard_Long_Long_Float, gigi_standard_exception_type => Standard_Exception_Type, diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 61ae653de2a..b02b9a04132 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1536,15 +1536,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_expr, 0); gnu_type = make_node (INTEGER_TYPE); + TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity)); + + /* Set the precision to the Esize except for bit-packed arrays and + subtypes of Standard.Boolean. */ if (Is_Packed_Array_Type (gnat_entity) && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity))) { esize = UI_To_Int (RM_Size (gnat_entity)); TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1; } + else if (TREE_CODE (TREE_TYPE (gnu_type)) == BOOLEAN_TYPE) + esize = 1; TYPE_PRECISION (gnu_type) = esize; - TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity)); TYPE_MIN_VALUE (gnu_type) = convert (TREE_TYPE (gnu_type), @@ -1596,7 +1601,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) are uninitialized. Both goals are accomplished by wrapping the modular value in an enclosing struct. */ if (Is_Packed_Array_Type (gnat_entity) - && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity))) + && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity))) { tree gnu_field_type = gnu_type; tree gnu_field; @@ -7106,7 +7111,8 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) if (TREE_CODE (gnu_type) == INTEGER_TYPE && Is_Discrete_Or_Fixed_Point_Type (gnat_entity)) TYPE_RM_SIZE_NUM (gnu_type) = size; - else if (TREE_CODE (gnu_type) == ENUMERAL_TYPE) + else if (TREE_CODE (gnu_type) == ENUMERAL_TYPE + || TREE_CODE (gnu_type) == BOOLEAN_TYPE) TYPE_RM_SIZE_NUM (gnu_type) = size; else if ((TREE_CODE (gnu_type) == RECORD_TYPE || TREE_CODE (gnu_type) == UNION_TYPE @@ -7124,7 +7130,7 @@ static tree make_type_from_size (tree type, tree size_tree, bool for_biased) { unsigned HOST_WIDE_INT size; - bool biased_p; + bool biased_p, boolean_p; tree new_type; /* If size indicates an error, just return TYPE to avoid propagating @@ -7138,13 +7144,23 @@ make_type_from_size (tree type, tree size_tree, bool for_biased) { case INTEGER_TYPE: case ENUMERAL_TYPE: + case BOOLEAN_TYPE: biased_p = (TREE_CODE (type) == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type)); + boolean_p = (TREE_CODE (type) == BOOLEAN_TYPE + || (TREE_CODE (type) == INTEGER_TYPE + && TREE_TYPE (type) + && TREE_CODE (TREE_TYPE (type)) == BOOLEAN_TYPE)); + + if (boolean_p) + size = round_up_to_align (size, BITS_PER_UNIT); + /* Only do something if the type is not a packed array type and doesn't already have the proper size. */ if (TYPE_PACKED_ARRAY_TYPE_P (type) - || (TYPE_PRECISION (type) == size && biased_p == for_biased)) + || (biased_p == for_biased && TYPE_PRECISION (type) == size) + || (boolean_p && compare_tree_int (TYPE_SIZE (type), size) == 0)) break; biased_p |= for_biased; @@ -7154,13 +7170,18 @@ make_type_from_size (tree type, tree size_tree, bool for_biased) new_type = make_unsigned_type (size); else new_type = make_signed_type (size); + if (boolean_p) + TYPE_PRECISION (new_type) = 1; TREE_TYPE (new_type) = TREE_TYPE (type) ? TREE_TYPE (type) : type; TYPE_MIN_VALUE (new_type) = convert (TREE_TYPE (new_type), TYPE_MIN_VALUE (type)); TYPE_MAX_VALUE (new_type) = convert (TREE_TYPE (new_type), TYPE_MAX_VALUE (type)); TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p; - TYPE_RM_SIZE_NUM (new_type) = bitsize_int (size); + if (boolean_p) + TYPE_RM_SIZE_NUM (new_type) = bitsize_int (1); + else + TYPE_RM_SIZE_NUM (new_type) = bitsize_int (size); return new_type; case RECORD_TYPE: diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 685bb383bbd..8055359863c 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -218,6 +218,7 @@ extern void gigi (Node_Id gnat_root, int max_gnat_node, int number_name, struct List_Header *list_headers_ptr, Nat number_file, struct File_Info_Type *file_info_ptr, + Entity_Id standard_boolean, Entity_Id standard_integer, Entity_Id standard_long_long_float, Entity_Id standard_exception_type, diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 02397d7f445..47d249a4578 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -544,6 +544,7 @@ gnat_print_type (FILE *file, tree node, int indent) break; case ENUMERAL_TYPE: + case BOOLEAN_TYPE: print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4); break; diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 3b15e30a222..9d3f807c6e6 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -231,12 +231,12 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name, struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr, struct String_Entry *strings_ptr, Char_Code *string_chars_ptr, struct List_Header *list_headers_ptr, Nat number_file, - struct File_Info_Type *file_info_ptr, + struct File_Info_Type *file_info_ptr, Entity_Id standard_boolean, Entity_Id standard_integer, Entity_Id standard_long_long_float, Entity_Id standard_exception_type, Int gigi_operating_mode) { - tree gnu_standard_long_long_float; - tree gnu_standard_exception_type; + Entity_Id gnat_literal; + tree gnu_standard_long_long_float, gnu_standard_exception_type, t; struct elab_info *info; int i; @@ -311,6 +311,8 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name, /* Give names and make TYPE_DECLs for common types. */ create_type_decl (get_identifier (SIZE_TYPE), sizetype, NULL, false, true, Empty); + create_type_decl (get_identifier ("boolean"), boolean_type_node, + NULL, false, true, Empty); create_type_decl (get_identifier ("integer"), integer_type_node, NULL, false, true, Empty); create_type_decl (get_identifier ("unsigned char"), char_type_node, @@ -318,6 +320,26 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name, create_type_decl (get_identifier ("long integer"), long_integer_type_node, NULL, false, true, Empty); + /* Save the type we made for boolean as the type for Standard.Boolean. */ + save_gnu_tree (Base_Type (standard_boolean), TYPE_NAME (boolean_type_node), + false); + gnat_literal = First_Literal (Base_Type (standard_boolean)); + t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node); + gcc_assert (t == boolean_false_node); + t = create_var_decl (get_entity_name (gnat_literal), NULL_TREE, + boolean_type_node, t, true, false, false, false, + NULL, gnat_literal); + DECL_IGNORED_P (t) = 1; + save_gnu_tree (gnat_literal, t, false); + gnat_literal = Next_Literal (gnat_literal); + t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node); + gcc_assert (t == boolean_true_node); + t = create_var_decl (get_entity_name (gnat_literal), NULL_TREE, + boolean_type_node, t, true, false, false, false, + NULL, gnat_literal); + DECL_IGNORED_P (t) = 1; + save_gnu_tree (gnat_literal, t, false); + /* 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 may be subtypes. */ diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 01cc9b8948e..882293895cc 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -523,6 +523,13 @@ gnat_init_decl_processing (void) 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); + + /* In Ada, we use an unsigned 8-bit type for the default boolean type. */ + boolean_type_node = make_node (BOOLEAN_TYPE); + TYPE_PRECISION (boolean_type_node) = 1; + fixup_unsigned_type (boolean_type_node); + TYPE_RM_SIZE_NUM (boolean_type_node) = bitsize_int (1); + build_common_tree_nodes_2 (0); ptr_void_type_node = build_pointer_type (void_type_node); @@ -1762,7 +1769,8 @@ create_param_decl (tree param_name, tree param_type, bool readonly) lead to various ABI violations. */ if (targetm.calls.promote_prototypes (param_type) && (TREE_CODE (param_type) == INTEGER_TYPE - || TREE_CODE (param_type) == ENUMERAL_TYPE) + || TREE_CODE (param_type) == ENUMERAL_TYPE + || TREE_CODE (param_type) == BOOLEAN_TYPE) && TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node)) { /* We have to be careful about biased types here. Make a subtype @@ -2690,6 +2698,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) { case INTEGER_TYPE: case ENUMERAL_TYPE: + case BOOLEAN_TYPE: if (TYPE_VAX_FLOATING_POINT_P (type)) switch (tree_low_cst (TYPE_DIGITS_VALUE (type), 1)) { @@ -2992,6 +3001,7 @@ build_vms_descriptor64 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) { case INTEGER_TYPE: case ENUMERAL_TYPE: + case BOOLEAN_TYPE: if (TYPE_VAX_FLOATING_POINT_P (type)) switch (tree_low_cst (TYPE_DIGITS_VALUE (type), 1)) { @@ -4035,9 +4045,6 @@ convert (tree type, tree expr) case VOID_TYPE: return fold_build1 (CONVERT_EXPR, type, expr); - case BOOLEAN_TYPE: - return fold_convert (type, gnat_truthvalue_conversion (expr)); - case INTEGER_TYPE: if (TYPE_HAS_ACTUAL_BOUNDS_P (type) && (ecode == ARRAY_TYPE || ecode == UNCONSTRAINED_ARRAY_TYPE @@ -4052,6 +4059,7 @@ convert (tree type, tree expr) /* ... fall through ... */ case ENUMERAL_TYPE: + case BOOLEAN_TYPE: /* If we are converting an additive expression to an integer type with lower precision, be wary of the optimization that can be applied by convert_to_integer. There are 2 problematic cases: diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index 72514a61a27..f553f2e454a 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -8846,7 +8846,8 @@ is_subrange_type (const_tree type) return false; if (TREE_CODE (subtype) != INTEGER_TYPE - && TREE_CODE (subtype) != ENUMERAL_TYPE) + && TREE_CODE (subtype) != ENUMERAL_TYPE + && TREE_CODE (subtype) != BOOLEAN_TYPE) return false; if (TREE_CODE (type) == TREE_CODE (subtype) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ab4b945f30d..a4025292059 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2008-07-30 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/boolean_expr.ad[sb]: New test. + 2008-07-30 H.J. Lu <hongjiu.lu@intel.com> Joey Ye <joey.ye@intel.com> @@ -3666,7 +3670,7 @@ PR fortran/35780 * gfortran.dg/simplify_argN_1.f90: New test. -2008-04-06 Tobias Schlüter <tobi@gcc.gnu.org> +2008-04-06 Tobias Schl�ter <tobi@gcc.gnu.org> PR fortran/35832 * gfortran.dg/io_constraints_2.f90: Adapt to new error message. diff --git a/gcc/testsuite/gnat.dg/boolean_expr.adb b/gcc/testsuite/gnat.dg/boolean_expr.adb new file mode 100644 index 00000000000..6ac086dfe6d --- /dev/null +++ b/gcc/testsuite/gnat.dg/boolean_expr.adb @@ -0,0 +1,30 @@ +-- PR middle-end/36554 +-- Origin: Laurent Guerby <laurent@guerby.net> + +-- { dg-do compile } +-- { dg-options "-O2" } + +package body Boolean_Expr is + + function Long_Float_Is_Valid (X : in Long_Float) return Boolean is + Is_Nan : constant Boolean := X /= X; + Is_P_Inf : constant Boolean := X > Long_Float'Last; + Is_M_Inf : constant Boolean := X < Long_Float'First; + Is_Invalid : constant Boolean := Is_Nan or Is_P_Inf or Is_M_Inf; + begin + return not Is_Invalid; + end Long_Float_Is_Valid; + + function S (V : in Long_Float) return String is + begin + if not Long_Float_Is_Valid (V) then + return "INVALID"; + else + return "OK"; + end if; + exception + when others => + return "ERROR"; + end S; + +end Boolean_Expr; diff --git a/gcc/testsuite/gnat.dg/boolean_expr.ads b/gcc/testsuite/gnat.dg/boolean_expr.ads new file mode 100644 index 00000000000..8190ce77bd5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/boolean_expr.ads @@ -0,0 +1,5 @@ +package Boolean_Expr is + + function S (V : in Long_Float) return String; + +end Boolean_Expr; |