diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 56 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Makefile.in | 51 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.cc | 57 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/misc.cc | 2 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.cc | 79 |
5 files changed, 135 insertions, 110 deletions
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 964cae8..1c93816 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -185,6 +185,11 @@ ada.serial = gnat1$(exeext) # variable conveys what we need for this, set to "g++" if not bootstrapping, # ".../xg++" otherwise. +GNATMAKE_FOR_HOST = $(GNATMAKE) +GNATBIND_FOR_HOST = $(GNATBIND) +GNATLINK_FOR_HOST = $(subst gnatmake,gnatlink,$(GNATMAKE)) +GNATLS_FOR_HOST = $(subst gnatmake,gnatls,$(GNATMAKE)) + # There are too many Ada sources to check against here. Let's # always force the recursive make. ifeq ($(build), $(host)) @@ -214,20 +219,16 @@ ifeq ($(build), $(host)) CXX="$(CXX)" \ $(COMMON_FLAGS_TO_PASS) $(ADA_FLAGS_TO_PASS) \ ADA_INCLUDES="-I../generated -I$(RTS_DIR)/../adainclude -I$(RTS_DIR)" \ - GNATMAKE="gnatmake" \ - GNATBIND="gnatbind" \ - GNATLINK="gnatlink" \ + GNATMAKE="$(GNATMAKE_FOR_HOST)" \ + GNATBIND="$(GNATBIND_FOR_HOST)" \ + GNATLINK="$(GNATLINK_FOR_HOST)" \ LIBGNAT="" endif else # Build is different from host so we are either building a canadian cross # or a cross-native compiler. We provide defaults for tools targeting the - # host platform, but they can be overriden by just setting <tool>_FOR_HOST + # host platform, but they can be overridden by just setting <tool>_FOR_HOST # variables. - GNATMAKE_FOR_HOST=$(host_noncanonical)-gnatmake - GNATBIND_FOR_HOST=$(host_noncanonical)-gnatbind - GNATLINK_FOR_HOST=$(host_noncanonical)-gnatlink - GNATLS_FOR_HOST=$(host_noncanonical)-gnatls ifeq ($(host), $(target)) # This is a cross native. All the sources are taken from the currently @@ -315,23 +316,17 @@ GNAT_ADA_OBJS = \ ada/cstand.o \ ada/debug.o \ ada/debug_a.o \ - ada/diagnostics-brief_emitter.o \ - ada/diagnostics-constructors.o \ - ada/diagnostics-converter.o \ - ada/diagnostics-json_utils.o \ - ada/diagnostics-pretty_emitter.o \ - ada/diagnostics-repository.o \ - ada/diagnostics-sarif_emitter.o \ - ada/diagnostics-switch_repository.o \ - ada/diagnostics-utils.o \ - ada/diagnostics.o \ ada/einfo-entities.o \ ada/einfo-utils.o \ ada/einfo.o \ ada/elists.o \ ada/err_vars.o \ + ada/errid.o \ ada/errout.o \ ada/erroutc.o \ + ada/erroutc-pretty_emitter.o \ + ada/erroutc-sarif_emitter.o \ + ada/errsw.o \ ada/eval_fat.o \ ada/exp_aggr.o \ ada/exp_spark.o \ @@ -380,6 +375,7 @@ GNAT_ADA_OBJS = \ ada/impunit.o \ ada/inline.o \ ada/itypes.o \ + ada/json_utils.o \ ada/krunch.o \ ada/layout.o \ ada/lib-load.o \ @@ -535,6 +531,7 @@ GNAT_ADA_OBJS+= \ ada/libgnat/s-bitops.o \ ada/libgnat/s-carun8.o \ ada/libgnat/s-casuti.o \ + ada/libgnat/s-cautns.o \ ada/libgnat/s-crtl.o \ ada/libgnat/s-conca2.o \ ada/libgnat/s-conca3.o \ @@ -562,8 +559,6 @@ GNAT_ADA_OBJS+= \ ada/libgnat/s-secsta.o \ ada/libgnat/s-soflin.o \ ada/libgnat/s-soliin.o \ - ada/libgnat/s-spark.o \ - ada/libgnat/s-spcuop.o \ ada/libgnat/s-stache.o \ ada/libgnat/s-stalib.o \ ada/libgnat/s-stoele.o \ @@ -575,11 +570,8 @@ GNAT_ADA_OBJS+= \ ada/libgnat/s-trasym.o \ ada/libgnat/s-unstyp.o \ ada/libgnat/s-valint.o \ - ada/libgnat/s-valspe.o \ ada/libgnat/s-valuns.o \ ada/libgnat/s-valuti.o \ - ada/libgnat/s-vs_int.o \ - ada/libgnat/s-vs_uns.o \ ada/libgnat/s-wchcnv.o \ ada/libgnat/s-wchcon.o \ ada/libgnat/s-wchjis.o \ @@ -615,23 +607,17 @@ GNATBIND_OBJS = \ ada/casing.o \ ada/csets.o \ ada/debug.o \ - ada/diagnostics-brief_emitter.o \ - ada/diagnostics-constructors.o \ - ada/diagnostics-converter.o \ - ada/diagnostics-json_utils.o \ - ada/diagnostics-pretty_emitter.o \ - ada/diagnostics-repository.o \ - ada/diagnostics-sarif_emitter.o \ - ada/diagnostics-switch_repository.o \ - ada/diagnostics-utils.o \ - ada/diagnostics.o \ ada/einfo-entities.o \ ada/einfo-utils.o \ ada/einfo.o \ ada/elists.o \ ada/err_vars.o \ + ada/errid.o \ ada/errout.o \ ada/erroutc.o \ + ada/erroutc-sarif_emitter.o \ + ada/erroutc-pretty_emitter.o \ + ada/errsw.o \ ada/exit.o \ ada/final.o \ ada/fmap.o \ @@ -639,6 +625,7 @@ GNATBIND_OBJS = \ ada/gnatbind.o \ ada/gnatvsn.o \ ada/hostparm.o \ + ada/json_utils.o \ ada/lib.o \ ada/link.o \ ada/namet.o \ @@ -710,6 +697,7 @@ GNATBIND_OBJS += \ ada/libgnat/s-assert.o \ ada/libgnat/s-carun8.o \ ada/libgnat/s-casuti.o \ + ada/libgnat/s-cautns.o \ ada/libgnat/s-conca2.o \ ada/libgnat/s-conca3.o \ ada/libgnat/s-conca4.o \ @@ -1108,7 +1096,7 @@ check-ada-subtargets: check-acats-subtargets check-gnat-subtargets # No ada-specific selftests selftest-ada: -ACATSDIR = $(TESTSUITEDIR)/ada/acats +ACATSDIR = $(TESTSUITEDIR)/ada/acats-2 ACATSCMD = run_acats.sh check_acats_numbers0:=1 2 3 4 5 6 7 8 9 diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 4ffdc1e..8615b59 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -104,6 +104,8 @@ INSTALL_DATA_DATE = cp -p MAKEINFO = makeinfo TEXI2DVI = texi2dvi TEXI2PDF = texi2pdf + +GNATMAKE_FOR_BUILD = gnatmake GNATBIND_FLAGS = -static -x ADA_CFLAGS = ADAFLAGS = -W -Wall -gnatpg -gnata -gnatU @@ -321,23 +323,18 @@ GNATMAKE_OBJS = a-except.o ali.o ali-util.o aspects.o s-casuti.o alloc.o \ erroutc.o errutil.o err_vars.o fmap.o fname.o fname-uf.o fname-sf.o \ gnatmake.o gnatvsn.o hostparm.o interfac.o i-c.o i-cstrin.o krunch.o lib.o \ make.o makeusg.o make_util.o namet.o nlists.o opt.o osint.o osint-m.o \ - output.o restrict.o rident.o s-exctab.o \ + output.o restrict.o rident.o s-exctab.o s-cautns.o \ s-secsta.o s-stalib.o s-stoele.o scans.o scng.o sdefault.o sfn_scan.o \ s-purexc.o s-htable.o scil_ll.o sem_aux.o sinfo.o sinput.o sinput-c.o \ snames.o stand.o stringt.o styleg.o stylesw.o system.o validsw.o \ switch.o switch-m.o table.o targparm.o tempdir.o types.o uintp.o \ uname.o urealp.o usage.o widechar.o warnsw.o \ seinfo.o einfo-entities.o einfo-utils.o sinfo-nodes.o sinfo-utils.o \ - diagnostics-brief_emitter.o \ - diagnostics-constructors.o \ - diagnostics-converter.o \ - diagnostics-json_utils.o \ - diagnostics-pretty_emitter.o \ - diagnostics-repository.o \ - diagnostics-sarif_emitter.o \ - diagnostics-switch_repository.o \ - diagnostics-utils.o \ - diagnostics.o \ + errid.o \ + errsw.o \ + erroutc-pretty_emitter.o \ + erroutc-sarif_emitter.o \ + json_utils.o $(EXTRA_GNATMAKE_OBJS) # Make arch match the current multilib so that the RTS selection code @@ -634,7 +631,7 @@ OSCONS_EXTRACT=$(GCC_FOR_ADA_RTS) $(GNATLIBCFLAGS_FOR_C) -S s-oscons-tmplt.i -$(MKDIR) ./bldtools/oscons $(RM) $(addprefix ./bldtools/oscons/,$(notdir $^)) $(CP) $^ ./bldtools/oscons - (cd ./bldtools/oscons ; gnatmake -q xoscons) + (cd ./bldtools/oscons ; $(GNATMAKE_FOR_BUILD) xoscons) $(RTSDIR)/s-oscons.ads: ../stamp-gnatlib1-$(RTSDIR) s-oscons-tmplt.c gsocket.h ./bldtools/oscons/xoscons $(RM) $(RTSDIR)/s-oscons-tmplt.i $(RTSDIR)/s-oscons-tmplt.s @@ -843,35 +840,6 @@ gnatlib-shared: PICFLAG_FOR_TARGET="$(PICFLAG_FOR_TARGET)" \ $(GNATLIB_SHARED) -# When building a SJLJ runtime for VxWorks, we need to ensure that the extra -# linker options needed for ZCX are not passed to prevent the inclusion of -# useless objects and potential troubles from the presence of extra symbols -# and references in some configurations. The inhibition is performed by -# commenting the pragma instead of deleting the line, as the latter might -# result in getting multiple blank lines, hence possible style check errors. -gnatlib-sjlj: - $(MAKE) $(FLAGS_TO_PASS) \ - EH_MECHANISM="" \ - MULTISUBDIR="$(MULTISUBDIR)" \ - THREAD_KIND="$(THREAD_KIND)" \ - LN_S="$(LN_S)" \ - ../stamp-gnatlib1-$(RTSDIR) - sed \ - -e 's/Frontend_Exceptions.*/Frontend_Exceptions : constant Boolean := True;/' \ - -e 's/ZCX_By_Default.*/ZCX_By_Default : constant Boolean := False;/' \ - $(RTSDIR)/system.ads > $(RTSDIR)/s.ads - $(MV) $(RTSDIR)/s.ads $(RTSDIR)/system.ads - $(MAKE) $(FLAGS_TO_PASS) \ - EH_MECHANISM="" \ - GNATLIBFLAGS="$(GNATLIBFLAGS)" \ - GNATLIBCFLAGS="$(GNATLIBCFLAGS)" \ - GNATLIBCFLAGS_FOR_C="$(GNATLIBCFLAGS_FOR_C)" \ - FORCE_DEBUG_ADAFLAGS="$(FORCE_DEBUG_ADAFLAGS)" \ - MULTISUBDIR="$(MULTISUBDIR)" \ - THREAD_KIND="$(THREAD_KIND)" \ - LN_S="$(LN_S)" \ - gnatlib - gnatlib-zcx: $(MAKE) $(FLAGS_TO_PASS) \ EH_MECHANISM="-gcc" \ @@ -880,7 +848,6 @@ gnatlib-zcx: LN_S="$(LN_S)" \ ../stamp-gnatlib1-$(RTSDIR) sed \ - -e 's/Frontend_Exceptions.*/Frontend_Exceptions : constant Boolean := False;/' \ -e 's/ZCX_By_Default.*/ZCX_By_Default : constant Boolean := True;/' \ $(RTSDIR)/system.ads > $(RTSDIR)/s.ads $(MV) $(RTSDIR)/s.ads $(RTSDIR)/system.ads diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index 1694b4e..903ec84 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -1228,6 +1228,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) gnu_expr = gnat_build_constructor (gnu_type, v); } + /* If we are allocating the anonymous object of a small aggregate on + the stack, zero-initialize it so that the entire object is assigned + and the subsequent assignments need not preserve unknown bits, but + do it only when optimization is enabled for the sake of consistency + with the gimplifier which does the same for CONSTRUCTORs. */ + else if (definition + && !imported_p + && !static_flag + && !gnu_expr + && TREE_CODE (gnu_type) == RECORD_TYPE + && TREE_CODE (gnu_object_size) == INTEGER_CST + && compare_tree_int (gnu_object_size, MAX_FIXED_MODE_SIZE) <= 0 + && Present (Related_Expression (gnat_entity)) + && Nkind (Original_Node (Related_Expression (gnat_entity))) + == N_Aggregate + && optimize) + gnu_expr = build_constructor (gnu_type, NULL); + /* Convert the expression to the type of the object if need be. */ if (gnu_expr && initial_value_needs_conversion (gnu_type, gnu_expr)) gnu_expr = convert (gnu_type, gnu_expr); @@ -4484,7 +4502,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) if (Known_Esize (gnat_entity)) gnu_size = validate_size (Esize (gnat_entity), gnu_type, gnat_entity, - VAR_DECL, false, false, size_s, type_s); + VAR_DECL, false, false, NULL, NULL); /* ??? The test on Has_Size_Clause must be removed when "unknown" is no longer represented as Uint_0 (i.e. Use_New_Unknown_Rep). */ @@ -5251,7 +5269,7 @@ inline_status_for_subprog (Entity_Id subprog) && Is_Record_Type (Etype (First_Formal (subprog))) && (gnu_type = gnat_to_gnu_type (Etype (First_Formal (subprog)))) && !TYPE_IS_BY_REFERENCE_P (gnu_type) - && tree_fits_uhwi_p (TYPE_SIZE (gnu_type)) + && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST && compare_tree_int (TYPE_SIZE (gnu_type), MAX_FIXED_MODE_SIZE) <= 0) return is_prescribed; @@ -5426,7 +5444,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, const bool is_bit_packed = Is_Bit_Packed_Array (gnat_array); tree gnu_type = gnat_to_gnu_type (gnat_type); tree gnu_comp_size; - bool has_packed_components; + bool has_packed_component; unsigned int max_align; /* If an alignment is specified, use it as a cap on the component type @@ -5447,16 +5465,22 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, && !TYPE_FAT_POINTER_P (gnu_type) && tree_fits_uhwi_p (TYPE_SIZE (gnu_type))) { - gnu_type = make_packable_type (gnu_type, false, max_align); - has_packed_components = true; + tree gnu_packable_type = make_packable_type (gnu_type, false, max_align); + if (gnu_packable_type != gnu_type) + { + gnu_type = gnu_packable_type; + has_packed_component = true; + } + else + has_packed_component = false; } else - has_packed_components = is_bit_packed; + has_packed_component = is_bit_packed; /* Get and validate any specified Component_Size. */ gnu_comp_size = validate_size (Component_Size (gnat_array), gnu_type, gnat_array, - has_packed_components ? TYPE_DECL : VAR_DECL, true, + has_packed_component ? TYPE_DECL : VAR_DECL, true, Has_Component_Size_Clause (gnat_array), NULL, NULL); /* If the component type is a RECORD_TYPE that has a self-referential size, @@ -5998,7 +6022,8 @@ gnat_to_gnu_profile_type (Entity_Id gnat_type) return gnu_type; } -/* Return true if TYPE contains only integral data, recursively if need be. */ +/* Return true if TYPE contains only integral data, recursively if need be. + (integral data is to be understood as not floating-point data here). */ static bool type_contains_only_integral_data (tree type) @@ -6018,7 +6043,7 @@ type_contains_only_integral_data (tree type) return type_contains_only_integral_data (TREE_TYPE (type)); default: - return INTEGRAL_TYPE_P (type); + return INTEGRAL_TYPE_P (type) || POINTER_TYPE_P (type); } gcc_unreachable (); @@ -9672,6 +9697,20 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object, return NULL_TREE; } + /* The size of stand-alone objects is always a multiple of the alignment, + but that's already enforced for elementary types by the front-end. */ + if (kind == VAR_DECL + && !component_p + && RECORD_OR_UNION_TYPE_P (gnu_type) + && !TYPE_FAT_POINTER_P (gnu_type) + && !integer_zerop (size_binop (TRUNC_MOD_EXPR, size, + bitsize_int (TYPE_ALIGN (gnu_type))))) + { + post_error_ne_num ("size for& must be multiple of alignment ^", + gnat_error_node, gnat_object, TYPE_ALIGN (gnu_type)); + return NULL_TREE; + } + return size; } diff --git a/gcc/ada/gcc-interface/misc.cc b/gcc/ada/gcc-interface/misc.cc index ca5c9a2..128040e 100644 --- a/gcc/ada/gcc-interface/misc.cc +++ b/gcc/ada/gcc-interface/misc.cc @@ -377,7 +377,7 @@ gnat_init (void) line_table->default_range_bits = 0; /* Register our internal error function. */ - global_dc->m_internal_error = &internal_error_function; + global_dc->set_internal_error_callback (&internal_error_function); return true; } diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index 23fc814..e02804b 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -257,7 +257,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_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id); static tree convert_with_check (Entity_Id, tree, bool, bool, Node_Id); -static bool addressable_p (tree, tree); +static bool addressable_p (tree, tree, bool); static bool aliasable_p (tree, tree); static tree assoc_to_constructor (Entity_Id, Node_Id, tree); static tree pos_to_constructor (Node_Id, tree); @@ -4876,6 +4876,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, tree gnu_formal = present_gnu_tree (gnat_formal) ? get_gnu_tree (gnat_formal) : NULL_TREE; tree gnu_actual_type = gnat_to_gnu_type (Etype (gnat_actual)); + const bool is_init_proc + = Is_Entity_Name (gnat_subprog) && Is_Init_Proc (Entity (gnat_subprog)); const bool in_param = (Ekind (gnat_formal) == E_In_Parameter); const bool is_true_formal_parm = gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL; @@ -4925,7 +4927,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, copy to avoid breaking strict aliasing rules. */ if (is_by_ref_formal_parm && (gnu_name_type = gnat_to_gnu_type (Etype (gnat_name))) - && (!addressable_p (gnu_name, gnu_name_type) + && (!addressable_p (gnu_name, gnu_name_type, is_init_proc) || (node_is_type_conversion (gnat_actual) && (aliasing = !aliasable_p (gnu_name, gnu_actual_type))))) { @@ -5051,9 +5053,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, /* Do not initialize it for the _Init parameter of an initialization procedure since no data is meant to be passed in. */ - if (Ekind (gnat_formal) == E_Out_Parameter - && Is_Entity_Name (gnat_subprog) - && Is_Init_Proc (Entity (gnat_subprog))) + if (Ekind (gnat_formal) == E_Out_Parameter && is_init_proc) gnu_name = gnu_temp = create_temporary ("A", TREE_TYPE (gnu_name)); /* Initialize it on the fly like for an implicit temporary in the @@ -7590,6 +7590,10 @@ gnat_to_gnu (Node_Id gnat_node) case N_Allocator: { + const Entity_Id gnat_desig_type + = Designated_Type (Underlying_Type (Etype (gnat_node))); + const Entity_Id gnat_pool = Storage_Pool (gnat_node); + tree gnu_type, gnu_init; bool ignore_init_type; @@ -7608,9 +7612,6 @@ gnat_to_gnu (Node_Id gnat_node) else if (Nkind (gnat_temp) == N_Qualified_Expression) { - const 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)); @@ -7637,11 +7638,24 @@ gnat_to_gnu (Node_Id gnat_node) else gcc_unreachable (); - gnu_result_type = get_unpadded_type (Etype (gnat_node)); + /* If this is an array allocated with its bounds, use the thin pointer + as the result type to trigger the machinery in build_allocator, but + make sure not to do it for allocations on the return and secondary + stacks (see build_call_alloc_dealloc_proc for more details). */ + if (Is_Constr_Array_Subt_With_Bounds (gnat_desig_type) + && Is_Record_Type (Underlying_Type (Etype (gnat_pool))) + && !type_annotate_only) + { + tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_desig_type)); + gnu_result_type + = build_pointer_type (TYPE_OBJECT_RECORD_TYPE (gnu_array)); + } + else + 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, - ignore_init_type); + gnat_pool, gnat_node, ignore_init_type); } break; @@ -8577,6 +8591,18 @@ gnat_to_gnu (Node_Id gnat_node) (void) gnat_to_gnu_entity (gnat_desig_type, NULL_TREE, false); gnu_ptr = gnat_to_gnu (gnat_temp); + + /* If this is an array allocated with its bounds, first convert to + the thin pointer to trigger the special machinery below. */ + if (Is_Constr_Array_Subt_With_Bounds (gnat_desig_type)) + { + tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_desig_type)); + gnu_ptr + = convert (build_pointer_type + (TYPE_OBJECT_RECORD_TYPE (gnu_array)), + gnu_ptr); + } + gnu_ptr_type = TREE_TYPE (gnu_ptr); /* If this is a thin pointer, we must first dereference it to create @@ -10353,7 +10379,8 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p, unless it is an expression involving computation or if it involves a reference to a bitfield or to an object not sufficiently aligned for its type. If GNU_TYPE is non-null, return true only if GNU_EXPR can - be directly addressed as an object of this type. + be directly addressed as an object of this type. COMPG is true when + the predicate is invoked for compiler-generated code. *** Notes on addressability issues in the Ada compiler *** @@ -10410,7 +10437,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p, generated to connect everything together. */ static bool -addressable_p (tree gnu_expr, tree gnu_type) +addressable_p (tree gnu_expr, tree gnu_type, bool compg) { /* For an integral type, the size of the actual type of the object may not be greater than that of the expected type, otherwise an indirect access @@ -10471,13 +10498,13 @@ addressable_p (tree gnu_expr, tree gnu_type) case COMPOUND_EXPR: /* The address of a compound expression is that of its 2nd operand. */ - return addressable_p (TREE_OPERAND (gnu_expr, 1), gnu_type); + return addressable_p (TREE_OPERAND (gnu_expr, 1), gnu_type, compg); case COND_EXPR: /* We accept &COND_EXPR as soon as both operands are addressable and expect the outcome to be the address of the selected operand. */ - return (addressable_p (TREE_OPERAND (gnu_expr, 1), NULL_TREE) - && addressable_p (TREE_OPERAND (gnu_expr, 2), NULL_TREE)); + return (addressable_p (TREE_OPERAND (gnu_expr, 1), NULL_TREE, compg) + && addressable_p (TREE_OPERAND (gnu_expr, 2), NULL_TREE, compg)); case COMPONENT_REF: return (((!DECL_BIT_FIELD (TREE_OPERAND (gnu_expr, 1)) @@ -10491,23 +10518,26 @@ addressable_p (tree gnu_expr, tree gnu_type) && (DECL_ALIGN (TREE_OPERAND (gnu_expr, 1)) >= default_field_alignment (TREE_OPERAND (gnu_expr, 1), TREE_TYPE (gnu_expr)) - /* We do not enforce this on strict-alignment platforms for - internal fields in order to keep supporting misalignment - of tagged types in legacy code. */ + /* But this was historically not enforced for targets that + do not require strict alignment, so we keep not doing + it for 1) internal fields in order to keep supporting + misalignment of tagged types and 2) compiler-generated + code in order to avoid creating useless temporaries. */ || (!STRICT_ALIGNMENT - && DECL_INTERNAL_P (TREE_OPERAND (gnu_expr, 1))))) + && (DECL_INTERNAL_P (TREE_OPERAND (gnu_expr, 1)) + || compg)))) /* The field of a padding record is always addressable. */ || TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))) - && addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE)); + && addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE, compg)); case ARRAY_REF: case ARRAY_RANGE_REF: case REALPART_EXPR: case IMAGPART_EXPR: case NOP_EXPR: - return addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE); + return addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE, compg); case CONVERT_EXPR: return (AGGREGATE_TYPE_P (TREE_TYPE (gnu_expr)) - && addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE)); + && addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE, compg)); case VIEW_CONVERT_EXPR: { @@ -10525,7 +10555,8 @@ addressable_p (tree gnu_expr, tree gnu_type) || TYPE_ALIGN (inner_type) >= BIGGEST_ALIGNMENT || TYPE_ALIGN_OK (type) || TYPE_ALIGN_OK (inner_type)))) - && addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE)); + && addressable_p (TREE_OPERAND (gnu_expr, 0), NULL_TREE, + compg)); } default: |