diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 2 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Makefile.in | 38 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.cc | 27 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/misc.cc | 4 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.cc | 52 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.cc | 35 |
6 files changed, 87 insertions, 71 deletions
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 1c93816..bbbd697 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -1096,7 +1096,7 @@ check-ada-subtargets: check-acats-subtargets check-gnat-subtargets # No ada-specific selftests selftest-ada: -ACATSDIR = $(TESTSUITEDIR)/ada/acats-2 +ACATSDIR = $(TESTSUITEDIR)/ada/acats-4 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 3557b46..d456ac1 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -314,16 +314,16 @@ Makefile: ../config.status $(srcdir)/ada/gcc-interface/Makefile.in $(srcdir)/ada GNATLINK_OBJS = gnatlink.o \ a-except.o ali.o alloc.o butil.o casing.o csets.o debug.o fmap.o fname.o \ gnatvsn.o hostparm.o indepsw.o interfac.o i-c.o i-cstrin.o namet.o opt.o \ - osint.o output.o rident.o s-exctab.o s-secsta.o s-stalib.o s-stoele.o \ - sdefault.o snames.o stylesw.o switch.o system.o table.o targparm.o \ - types.o validsw.o widechar.o + osint.o output.o rident.o s-excmac.o s-exctab.o s-secsta.o s-stalib.o \ + s-stoele.o sdefault.o snames.o stylesw.o switch.o system.o table.o \ + targparm.o types.o validsw.o widechar.o GNATMAKE_OBJS = a-except.o ali.o ali-util.o aspects.o s-casuti.o alloc.o \ atree.o binderr.o butil.o casing.o csets.o debug.o elists.o einfo.o errout.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 s-cautns.o \ + output.o restrict.o rident.o s-cautns.o s-excmac.o s-exctab.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 \ @@ -840,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" \ @@ -877,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 903ec84..86cbf5b 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -6421,6 +6421,33 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, since structures are incomplete for the back-end. */ else if (Convention (gnat_subprog) != Convention_Stubbed) { + /* If we have two entries that may be returned in integer registers, + the larger has power-of-2 size and the smaller is integer, then + extend the smaller to this power-of-2 size to get a return type + with power-of-2 size and no holes, again to speed up accesses. */ + if (list_length (gnu_cico_field_list) == 2 + && gnu_cico_only_integral_type) + { + tree typ1 = TREE_TYPE (gnu_cico_field_list); + tree typ2 = TREE_TYPE (DECL_CHAIN (gnu_cico_field_list)); + if (TREE_CODE (typ1) == INTEGER_TYPE + && integer_pow2p (TYPE_SIZE (typ2)) + && compare_tree_int (TYPE_SIZE (typ2), + MAX_FIXED_MODE_SIZE) <= 0 + && tree_int_cst_lt (TYPE_SIZE (typ1), TYPE_SIZE (typ2))) + TREE_TYPE (gnu_cico_field_list) + = gnat_type_for_size (TREE_INT_CST_LOW (TYPE_SIZE (typ2)), + TYPE_UNSIGNED (typ1)); + else if (TREE_CODE (typ2) == INTEGER_TYPE + && integer_pow2p (TYPE_SIZE (typ1)) + && compare_tree_int (TYPE_SIZE (typ1), + MAX_FIXED_MODE_SIZE) <= 0 + && tree_int_cst_lt (TYPE_SIZE (typ2), TYPE_SIZE (typ1))) + TREE_TYPE (DECL_CHAIN (gnu_cico_field_list)) + = gnat_type_for_size (TREE_INT_CST_LOW (TYPE_SIZE (typ1)), + TYPE_UNSIGNED (typ2)); + } + finish_record_type (gnu_cico_return_type, nreverse (gnu_cico_field_list), 0, false); diff --git a/gcc/ada/gcc-interface/misc.cc b/gcc/ada/gcc-interface/misc.cc index 128040e..7711f8b 100644 --- a/gcc/ada/gcc-interface/misc.cc +++ b/gcc/ada/gcc-interface/misc.cc @@ -271,7 +271,7 @@ gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED) /* No caret by default for Ada. */ if (!OPTION_SET_P (flag_diagnostics_show_caret)) - global_dc->m_source_printing.enabled = false; + global_dc->get_source_printing_options ().enabled = false; /* Copy global settings to local versions. */ gnat_encodings = global_options.x_gnat_encodings; @@ -292,7 +292,7 @@ gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED) /* Here is the function to handle the compiler error processing in GCC. */ static void -internal_error_function (diagnostic_context *context, const char *msgid, +internal_error_function (diagnostics::context *context, const char *msgid, va_list *ap) { char *buffer, *p, *loc; diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index e02804b..fd1d39c 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -1510,7 +1510,7 @@ Pragma_to_gnu (Node_Id gnat_node) const location_t location = input_location; struct cl_option_handlers handlers; unsigned int option_index; - diagnostic_t kind; + enum diagnostics::kind kind; bool imply; gnat_temp = First (Pragma_Argument_Associations (gnat_node)); @@ -1521,12 +1521,12 @@ Pragma_to_gnu (Node_Id gnat_node) switch (id) { case Pragma_Warning_As_Error: - kind = DK_ERROR; + kind = diagnostics::kind::error; imply = false; break; case Pragma_Warnings: - kind = DK_WARNING; + kind = diagnostics::kind::warning; imply = true; break; @@ -1543,11 +1543,11 @@ Pragma_to_gnu (Node_Id gnat_node) switch (Chars (Expression (gnat_temp))) { case Name_Off: - kind = DK_IGNORED; + kind = diagnostics::kind::ignored; break; case Name_On: - kind = DK_WARNING; + kind = diagnostics::kind::warning; break; default: @@ -1569,7 +1569,7 @@ Pragma_to_gnu (Node_Id gnat_node) gnat_expr = Empty; /* For pragma Warnings (Off), we save the current state... */ - if (kind == DK_IGNORED) + if (kind == diagnostics::kind::ignored) diagnostic_push_diagnostics (global_dc, location); /* ...so that, for pragma Warnings (On), we do not enable all @@ -4049,7 +4049,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) tree gnu_decl; /* Skip any entries that have been already filled in; they must - correspond to In Out parameters. */ + correspond to In Out parameters or previous Out parameters. */ while (gnu_cico_entry && TREE_VALUE (gnu_cico_entry)) gnu_cico_entry = TREE_CHAIN (gnu_cico_entry); @@ -4059,11 +4059,22 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) if (DECL_BY_REF_P (gnu_decl)) gnu_decl = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_decl); - /* Do any needed references for padded types. */ - TREE_VALUE (gnu_cico_entry) - = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_entry)), gnu_decl); + TREE_VALUE (gnu_cico_entry) = gnu_decl; } + + /* Finally, ensure type consistency between TREE_PURPOSE and TREE_VALUE + so that the assignment of the latter to the former can be done. */ + tree gnu_cico_entry = gnu_cico_list; + while (gnu_cico_entry) + { + if (!VOID_TYPE_P (TREE_VALUE (gnu_cico_entry))) + TREE_VALUE (gnu_cico_entry) + = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_entry)), + TREE_VALUE (gnu_cico_entry)); + gnu_cico_entry = TREE_CHAIN (gnu_cico_entry); + } } + else vec_safe_push (gnu_return_label_stack, NULL_TREE); @@ -4161,9 +4172,13 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) } } - /* Otherwise, if this is a procedure or a function which does not return - by invisible reference, we can do a direct block-copy out. */ - else + /* Otherwise, if this is a procedure or a function that does not return + by invisible reference, we can do a direct block-copy out, but we do + not need to do it for a null initialization procedure when the _Init + parameter is not passed in since we would copy uninitialized bits. */ + else if (!(Is_Null_Init_Proc (gnat_subprog) + && list_length (gnu_cico_list) == 1 + && TREE_CODE (TREE_VALUE (gnu_cico_list)) == VAR_DECL)) { tree gnu_retval; @@ -8461,7 +8476,8 @@ gnat_to_gnu (Node_Id gnat_node) oconstraints[i] = constraint; if (parse_output_constraint (&constraint, i, ninputs, noutputs, - &allows_mem, &allows_reg, &fake)) + &allows_mem, &allows_reg, &fake, + nullptr)) { /* If the operand is going to end up in memory, mark it addressable. Note that we don't test @@ -8489,9 +8505,9 @@ gnat_to_gnu (Node_Id gnat_node) constraint = TREE_STRING_POINTER (TREE_VALUE (TREE_PURPOSE (tail))); - if (parse_input_constraint (&constraint, i, ninputs, noutputs, - 0, oconstraints, - &allows_mem, &allows_reg)) + if (parse_input_constraint (&constraint, i, ninputs, noutputs, 0, + oconstraints, &allows_mem, + &allows_reg, nullptr)) { /* If the operand is going to end up in memory, mark it addressable. */ @@ -8737,7 +8753,7 @@ gnat_to_gnu (Node_Id gnat_node) /* Set the location information on the result if it's not a simple name or something that contains a simple name, for example a tag, because - we don"t want all the references to get the location of the first use. + we don't want all the references to get the location of the first use. Note that we may have no result if we tried to build a CALL_EXPR node to a procedure with no side-effects and optimization is enabled. */ else if (kind != N_Identifier diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc index 23737c3..f501915 100644 --- a/gcc/ada/gcc-interface/utils.cc +++ b/gcc/ada/gcc-interface/utils.cc @@ -1225,7 +1225,6 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) Note that we rely on the pointer equality created here for TYPE_NAME to look through conversions in various places. */ TYPE_NAME (new_type) = TYPE_NAME (type); - TYPE_PACKED (new_type) = 1; TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type); TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type); TYPE_REVERSE_STORAGE_ORDER (new_type) = TYPE_REVERSE_STORAGE_ORDER (type); @@ -1240,6 +1239,8 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) new_size = ceil_pow2 (size); new_align = MIN (new_size, BIGGEST_ALIGNMENT); SET_TYPE_ALIGN (new_type, new_align); + /* build_aligned_type needs to be able to adjust back the alignment. */ + TYPE_PACKED (new_type) = 0; } else { @@ -1261,6 +1262,7 @@ make_packable_type (tree type, bool in_record, unsigned int max_align) if (max_align > 0 && new_align > max_align) new_align = max_align; SET_TYPE_ALIGN (new_type, MIN (align, new_align)); + TYPE_PACKED (new_type) = 1; } TYPE_USER_ALIGN (new_type) = 1; @@ -4508,8 +4510,8 @@ build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type, void update_pointer_to (tree old_type, tree new_type) { - tree ptr = TYPE_POINTER_TO (old_type); - tree ref = TYPE_REFERENCE_TO (old_type); + const tree old_ptr = TYPE_POINTER_TO (old_type); + const tree old_ref = TYPE_REFERENCE_TO (old_type); tree t; /* If this is the main variant, process all the other variants first. */ @@ -4518,7 +4520,7 @@ update_pointer_to (tree old_type, tree new_type) update_pointer_to (t, new_type); /* If no pointers and no references, we are done. */ - if (!ptr && !ref) + if (!old_ptr && !old_ref) return; /* Merge the old type qualifiers in the new type. @@ -4552,12 +4554,13 @@ update_pointer_to (tree old_type, tree new_type) if (TREE_CODE (new_type) != UNCONSTRAINED_ARRAY_TYPE) { tree new_ptr, new_ref; + tree ptr, ref; /* If pointer or reference already points to new type, nothing to do. This can happen as update_pointer_to can be invoked multiple times on the same couple of types because of the type variants. */ - if ((ptr && TREE_TYPE (ptr) == new_type) - || (ref && TREE_TYPE (ref) == new_type)) + if ((old_ptr && TREE_TYPE (old_ptr) == new_type) + || (old_ref && TREE_TYPE (old_ref) == new_type)) return; /* Chain PTR and its variants at the end. */ @@ -4566,13 +4569,13 @@ update_pointer_to (tree old_type, tree new_type) { while (TYPE_NEXT_PTR_TO (new_ptr)) new_ptr = TYPE_NEXT_PTR_TO (new_ptr); - TYPE_NEXT_PTR_TO (new_ptr) = ptr; + TYPE_NEXT_PTR_TO (new_ptr) = old_ptr; } else - TYPE_POINTER_TO (new_type) = ptr; + TYPE_POINTER_TO (new_type) = old_ptr; /* Now adjust them. */ - for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr)) + for (ptr = old_ptr; ptr; ptr = TYPE_NEXT_PTR_TO (ptr)) for (t = TYPE_MAIN_VARIANT (ptr); t; t = TYPE_NEXT_VARIANT (t)) { TREE_TYPE (t) = new_type; @@ -4587,13 +4590,13 @@ update_pointer_to (tree old_type, tree new_type) { while (TYPE_NEXT_REF_TO (new_ref)) new_ref = TYPE_NEXT_REF_TO (new_ref); - TYPE_NEXT_REF_TO (new_ref) = ref; + TYPE_NEXT_REF_TO (new_ref) = old_ref; } else - TYPE_REFERENCE_TO (new_type) = ref; + TYPE_REFERENCE_TO (new_type) = old_ref; /* Now adjust them. */ - for (; ref; ref = TYPE_NEXT_REF_TO (ref)) + for (ref = old_ref; ref; ref = TYPE_NEXT_REF_TO (ref)) for (t = TYPE_MAIN_VARIANT (ref); t; t = TYPE_NEXT_VARIANT (t)) { TREE_TYPE (t) = new_type; @@ -4612,20 +4615,20 @@ update_pointer_to (tree old_type, tree new_type) { tree new_ptr = TYPE_POINTER_TO (new_type); - gcc_assert (TYPE_IS_FAT_POINTER_P (ptr)); + gcc_assert (TYPE_IS_FAT_POINTER_P (old_ptr)); /* If PTR already points to NEW_TYPE, nothing to do. This can happen since update_pointer_to can be invoked multiple times on the same couple of types because of the type variants. */ - if (TYPE_UNCONSTRAINED_ARRAY (ptr) == new_type) + if (TYPE_UNCONSTRAINED_ARRAY (old_ptr) == new_type) return; update_pointer_to - (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (ptr))), + (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (old_ptr))), TREE_TYPE (TREE_TYPE (TYPE_FIELDS (new_ptr)))); update_pointer_to - (TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (ptr)))), + (TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (old_ptr)))), TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (new_ptr))))); update_pointer_to (TYPE_OBJECT_RECORD_TYPE (old_type), |