diff options
| author | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-08-04 13:51:43 +0000 |
|---|---|---|
| committer | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-08-04 13:51:43 +0000 |
| commit | 0c888ad177ad08a2bac14e762ddced0beed5647c (patch) | |
| tree | 828bbf6fbd489f2ef494e6151a1c4d1d49ecf151 | |
| parent | 8b407655ed1a6e1300b60482f455c32e8b662a8b (diff) | |
| download | gcc-0c888ad177ad08a2bac14e762ddced0beed5647c.tar.gz | |
2008-08-04 Basile Starynkevitch <basile@starynkevitch.net>
MELT branch merged with trunk r138620
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@138622 138bc75d-0d04-0410-961f-82ee72b054a4
176 files changed, 8632 insertions, 2882 deletions
diff --git a/config/ChangeLog b/config/ChangeLog index a35fe14673c..8662c7abaef 100644 --- a/config/ChangeLog +++ b/config/ChangeLog @@ -1,3 +1,13 @@ +2008-08-03 Alan Modra <amodra@bigpond.net.au> + + * mt-spu (all-ld): Update for ld Makefile changes. + +2008-08-02 Keith Seitz <keiths@redhat.com> + + * tcl.m4 (SC_PATH_TCLCONFIG): Add some simple logic to deal + with cygwin. + (SC_PATH_TKCONFIG): Likewise. + 2008-07-30 Paolo Bonzini <bonzini@gnu.org> * mh-pa: New, from gcc/config/pa/x-ada. diff --git a/config/mt-spu b/config/mt-spu index c2dbc66e999..7efa74ca41e 100644 --- a/config/mt-spu +++ b/config/mt-spu @@ -1,4 +1,2 @@ -# spu ld makefile invokes as-new in maintainer mode. -all-ld: $(MAINT) all-gas -# spu ld makefile invokes bin2c -all-ld: all-binutils +# spu ld makefile invokes as-new and bin2c in maintainer mode. +all-ld: $(MAINT) all-gas all-binutils diff --git a/config/tcl.m4 b/config/tcl.m4 index 51809fdc0bd..be0129b1bdf 100644 --- a/config/tcl.m4 +++ b/config/tcl.m4 @@ -32,6 +32,10 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ AC_CACHE_VAL(ac_cv_c_tclconfig,[ # First check to see if --with-tcl was specified. + case "${host}" in + *-*-cygwin*) platDir="win" ;; + *) platDir="unix" ;; + esac if test x"${with_tclconfig}" != x ; then if test -f "${with_tclconfig}/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)` @@ -55,8 +59,8 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do - if test -f "$i/unix/tclConfig.sh" ; then - ac_cv_c_tclconfig=`(cd $i/unix; pwd)` + if test -f "$i/$platDir/tclConfig.sh" ; then + ac_cv_c_tclconfig=`(cd $i/$platDir; pwd)` break fi done @@ -99,8 +103,8 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do - if test -f "$i/unix/tclConfig.sh" ; then - ac_cv_c_tclconfig=`(cd $i/unix; pwd)` + if test -f "$i/$platDir/tclConfig.sh" ; then + ac_cv_c_tclconfig=`(cd $i/$platDir; pwd)` break fi done @@ -161,6 +165,10 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ fi # then check for a private Tk library + case "${host}" in + *-*-cygwin*) platDir="win" ;; + *) platDir="unix" ;; + esac if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ../tk \ @@ -175,8 +183,8 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do - if test -f "$i/unix/tkConfig.sh" ; then - ac_cv_c_tkconfig=`(cd $i/unix; pwd)` + if test -f "$i/$platDir/tkConfig.sh" ; then + ac_cv_c_tkconfig=`(cd $i/$platDir; pwd)` break fi done @@ -218,8 +226,8 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do - if test -f "$i/unix/tkConfig.sh" ; then - ac_cv_c_tkconfig=`(cd $i/unix; pwd)` + if test -f "$i/$platDir/tkConfig.sh" ; then + ac_cv_c_tkconfig=`(cd $i/$platDir; pwd)` break fi done diff --git a/gcc/ChangeLog b/gcc/ChangeLog index cbaed89e428..2c30ecf5690 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,4 +1,151 @@ -2008-08-01 Basile Starynkevitch <basile@starynkevitch> +2008-08-04 H.J. Lu <hongjiu.lu@intel.com> + + * config/i386/i386.c (ix86_compute_frame_layout): Fix a typo + in comments. + +2008-08-03 Uros Bizjak <ubizjak@gmail.com> + + * config/i386/mmx.md (*mov<mode>_internal_rex64): Use Yi instead of x + to avoid inter-unit moves for !TARGET_INTER_UNIT_MOVES. + (*movv2sf_internal_rex64): Ditto. + +2008-08-03 Jan Hubicka <jh@suse.cz> + + * optabs.c (expand_binop, expand_builtin_pow, expand_builtin_powi, + expand_builtin_strcat): Upse optimize_insn_for_speed predicate. + * expmed.c (expand_smod_pow2): Likewise. + +2008-08-03 Uros Bizjak <ubizjak@gmail.com> + + PR target/36992 + * config/i386/sse.md (vec_concatv2di): Add Y2 constraint to + alternative 0 of operand 1. + (*vec_concatv2di_rex64_sse): Ditto. + (*vec_concatv2di_rex64_sse4_1): Add x constraint to alternative 0 + of operand 1. + (*sse2_storeq_rex64): Penalize allocation of "r" registers. + * config/i386/mmx.md (*mov<mode>_internal_rex64): Penalize allocation + of "Y2" registers to avoid SSE <-> MMX conversions for DImode moves. + (*movv2sf_internal_rex64): Ditto. + +2008-08-02 Richard Guenther <rguenther@suse.de> + + PR target/35252 + * config/i386/sse.md (SSEMODE4S, SSEMODE2D): New mode iterators. + (ssedoublesizemode): New mode attribute. + (sse_shufps): Call gen_sse_shufps_v4sf. + (sse_shufps_1): Macroize. + (sse2_shufpd): Call gen_Sse_shufpd_v2df. + (sse2_shufpd_1): Macroize. + (vec_extract_odd, vec_extract_even): New expanders. + (vec_interleave_highv4sf, vec_interleave_lowv4sf, + vec_interleave_highv2df, vec_interleave_lowv2df): Likewise. + * i386.c (ix86_expand_vector_init_one_nonzero): Call + gen_sse_shufps_v4sf instead of gen_sse_shufps_1. + (ix86_expand_vector_set): Likewise. + (ix86_expand_reduc_v4sf): Likewise. + +2008-08-01 Doug Kwan <dougkwan@google.com> + + * matrix-reorg.c: Re-enable all code. + (struct malloc_call_data): Change CALL_STMT to gimple type. + (collect_data_for_malloc_call): Tuplify. + (struct access_site_info): Change STMT to gimple type. + (struct matrix_info): Change MIN_INDIRECT_LEVEL_ESCAPE_STMT, + and MALLOC_FOR_LEVEL to gimple and gimple pointer type. + (struct free_info): Change STMT to gimple type. + (struct matrix_access_phi_node): Change PHI to gimple type. + (get_inner_of_cast_expr): Remove. + (may_flatten_matrices_1): Tuplify. + (may_flatten_matrices): Ditto. + (mark_min_matrix_escape_level): Ditto. + (ssa_accessed_in_tree): Refactor statement RHS related code into ... + (ssa_accessed_in_call_rhs): New + (ssa_accessed_in_assign_rhs): New + (record_access_alloc_site_info): Tuplify. + (add_allocation_site): Ditto. + (analyze_matrix_allocation_site): Ditto. + (analyze_transpose): Ditto. + (get_index_from_offset): Ditto. + (update_type_size): Ditto. + (analyze_accesses_for_call_expr): Tuplify and renamed into ... + (analyze_accesses_for_call_stmt): New. Also handle LHS of a call. + (analyze_accesses_for_phi_node): Tuplify. + (analyze_accesses_for_modify_stmt): Tuplify and renamed into ... + (analyze_accesses_for_assign_stmt): Remove code for handling call LHS. + (analyze_matrix_accesses): Tuplify. + (check_var_data): New call-back type for check_var_notmodified_p. + (check_var_notmodified_p): Tuplify and use call-back struct to + return statement found. + (can_calculate_expr_before_stmt): Factor out statement related code + into ... + (can_calculate_stmt_before_stmt): New. + (check_allocation_function): Tuplify. + (find_sites_in_func): Ditto. + (record_all_accesses_in_func): Ditto. + (transform_access_sites): Ditto. + (transform_allocation_sites): Ditto. + (matrix_reorg): Re-enable. + (gate_matrix_reorg): Re-enable. + +2008-08-01 Jakub Jelinek <jakub@redhat.com> + + * dwarf2out.c (compute_barrier_args_size): Set barrier_args_size + for labels for which it hasn't been set yet. If it has been set, + stop walking insns and continue with next worklist item. + (dwarf2out_stack_adjust): Don't call compute_barrier_args_size + if the only BARRIER is at the very end of a function. + +2008-08-01 H.J. Lu <hongjiu.lu@intel.com> + + * cfgexpand.c (expand_stack_alignment): Assert that + stack_realign_drap and drap_rtx must match. + + * function.c (instantiate_new_reg): If DRAP is used to realign + stack, replace virtual_incoming_args_rtx with internal arg + pointer. + +2008-08-01 Richard Guenther <rguenther@suse.de> + + * tree-ssa-pre.c (fini_pre): Take in_fre parameter. Free + loop information only if we initialized it. + (execute_pre): Call fini_pre with in_fre. + * tree-ssa-loop-ivcanon (try_unroll_loop_completely): Dump + if we do not unroll because we hit max-completely-peeled-insns. + Use our estimation for consistency, do allow shrinking. + +2008-08-01 H.J. Lu <hongjiu.lu@intel.com> + + * config/i386/i386.c (override_options): Replace ABI_STACK_BOUNDARY + with MIN_STACK_BOUNDARY. + (ix86_update_stack_boundary): Likewise. + (ix86_expand_prologue): Assert MIN_STACK_BOUNDARY instead of + STACK_BOUNDARY. + + * config/i386/i386.h (ABI_STACK_BOUNDARY): Renamed to ... + (MIN_STACK_BOUNDARY): This. + +2008-08-01 Richard Guenther <rguenther@suse.de> + + PR middle-end/36997 + * gimplify.c (gimplify_call_expr): Set error_mark_node on GS_ERROR. + +2008-08-01 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/36988 + * tree-ssa-ccp.c (ccp_fold): Conversions of constants only + do not matter if that doesn't change volatile qualification. + +2008-08-01 Paolo Bonzini <bonzini@gnu.org> + + * configure.ac: Do not generate libada-mk. Do not subst + host_cc_for_libada. + * libada-mk.in: Remove. + * Makefile.in: Pass TARGET_LIBGCC2_CFLAGS to libgcc.mvars. + * configure: Regenerate. + +2008-08-01 Basile Starynkevitch <basile@starynkevitch.net> + * tree-pass.h: Added comment about not dumping passes with name starting with star in struct opt_pass. * passes.c (register_dump_files_1): Don't do dump for a pass with @@ -44,13 +191,12 @@ * dwarf2out.c (based_loc_descr): Check crtl->stack_realign_tried for stack alignment. - * function.h (rtl_data): Add stack_realign_tried. Update - comments. + * function.h (rtl_data): Add stack_realign_tried. Update comments. 2008-07-31 Kaz Kojima <kkojima@gcc.gnu.org> * config/sh/sh.c (sh_canonical_va_list_type): Remove. - (TARGET_CANONICAL_VA_LIST_TYPE): Remove. + (TARGET_CANONICAL_VA_LIST_TYPE): Remove. 2008-07-31 Jakub Jelinek <jakub@redhat.com> @@ -76,7 +222,6 @@ (dwarf2out_stack_adjust): Use it. (dwarf2out_frame_debug_expr): Likewise. ->>>>>>> .r138449 2008-07-31 Richard Guenther <rguenther@suse.de> PR tree-optimization/36978 @@ -87,8 +232,7 @@ * passes.c (init_optimization_passes): Always call pass_early_warn_uninitialized. - * opts.c (decode_options): Do not warn about -Wuninitialized - at -O0. + * opts.c (decode_options): Do not warn about -Wuninitialized at -O0. * doc/invoke.texi (-Wuninitialized): Correct for enabling at -O0. * doc/passes.texi (Warn for uninitialized variables): Adjust. @@ -196,8 +340,7 @@ (TARGET_CALLS): Add TARGET_UPDATE_STACK_BOUNDARY and TARGET_GET_DRAP_RTX. - * target.h (gcc_target): Add update_stack_boundary and - get_drap_rtx. + * target.h (gcc_target): Add update_stack_boundary and get_drap_rtx. * tree-vectorizer.c (vect_can_force_dr_alignment_p): Replace STACK_BOUNDARY with MAX_STACK_ALIGNMENT. @@ -244,16 +387,14 @@ force_align_arg_pointer. (ix86_handle_cconv_attribute): Likewise. (ix86_function_regparm): Likewise. - (setup_incoming_varargs_64): Don't set stack_alignment_needed - here. + (setup_incoming_varargs_64): Don't set stack_alignment_needed here. (ix86_va_start): Replace virtual_incoming_args_rtx with crtl->args.internal_arg_pointer. (ix86_select_alt_pic_regnum): Check DRAP register. (ix86_save_reg): Replace force_align_arg_pointer with drap_reg. (ix86_compute_frame_layout): Compute frame layout wrt stack realignment. - (ix86_internal_arg_pointer): Just return - virtual_incoming_args_rtx. + (ix86_internal_arg_pointer): Just return virtual_incoming_args_rtx. (ix86_expand_prologue): Decide if stack realignment is needed and generate prologue code accordingly. (ix86_expand_epilogue): Generate epilogue code wrt stack @@ -332,8 +473,8 @@ 2008-07-30 Rafael Avila de Espindola <espindola@google.com> - * final.c (call_from_call_insn): New. - (final_scan_insn): Call assemble_external on FUNCTION_DECLs. + * final.c (call_from_call_insn): New. + (final_scan_insn): Call assemble_external on FUNCTION_DECLs. 2008-07-30 Paolo Bonzini <bonzini@gnu.org> @@ -406,8 +547,7 @@ 2008-07-29 Richard Guenther <rguenther@suse.de> - * gimplify.c (gimplify_expr): Clear TREE_SIDE_EFFECTS for - OBJ_TYPE_REF. + * gimplify.c (gimplify_expr): Clear TREE_SIDE_EFFECTS for OBJ_TYPE_REF. 2008-07-29 Jakub Jelinek <jakub@redhat.com> @@ -483,8 +623,7 @@ (insert_fake_stores): Remove. (realify_fake_stores): Likewise. (execute_pre): Remove dead code. - * tree-ssa-structalias.c (get_constraint_for_1): Remove tcc_unary - case. + * tree-ssa-structalias.c (get_constraint_for_1): Remove tcc_unary case. (find_func_aliases): Deal with it here instead. Re-enable gcc_unreachable call. @@ -722,7 +861,8 @@ 2008-07-25 Jan Hubicka <jh@suse.cz> - * cgraph.c (cgraph_function_possibly_inlined_p): Do not rely on DECL_INLINE. + * cgraph.c (cgraph_function_possibly_inlined_p): Do not rely on + DECL_INLINE. * cgraphunit.c (record_cdtor_fn): Do not initialize DECL_INLINE (cgraph_preserve_function_body_p): Do not rely on DECL_INLINE. * dojump.c (clear_pending_stack_adjust): Likewise. @@ -869,8 +1009,7 @@ * config/sh/sh.h (OPTIMIZATION_OPTIONS): Set flag_omit_frame_pointer to 2 instead of -1. - (OVERRIDE_OPTIONS): Check if flag_omit_frame_pointer is equal - to 2. + (OVERRIDE_OPTIONS): Check if flag_omit_frame_pointer is equal to 2. 2008-07-24 Kai Tietz <kai.tietz@onevision.com> @@ -1235,15 +1374,13 @@ (optimize_args): New static vector to remember the optimization arguments. (parse_optimize_options): New function to set up the optimization - arguments from either the optimize attribute or #pragma GCC - optimize. + arguments from either the optimize attribute or #pragma GCC optimize. * c-common.h (c_cpp_builtins_optimize_pragma): Add declaration. (builtin_define_std): Ditto. * config.gcc (i[3467]86-*-*): Add i386-c.o to C/C++ languages. - Add t-i386 Makefile fragment to add i386-c.o and i386.o - dependencies. + Add t-i386 Makefile fragment to add i386-c.o and i386.o dependencies. (x86_64-*-*): Ditto. * Makefile.in (TREE_H): Add options.h. @@ -1261,12 +1398,10 @@ (Save): Document Save option to create target specific options that can be saved/restored on a function specific context. - * doc/c-tree.texi (DECL_FUNCTION_SPECIFIC_TARGET): Document new - macro. + * doc/c-tree.texi (DECL_FUNCTION_SPECIFIC_TARGET): Document new macro. (DECL_FUNCTION_SPECIFIC_OPTIMIZATION): Ditto. - * doc/tm.texi (TARGET_VALID_OPTION_ATTRIBUTE_P): Document new - hook. + * doc/tm.texi (TARGET_VALID_OPTION_ATTRIBUTE_P): Document new hook. (TARGET_OPTION_SAVE): Ditto. (TARGET_OPTION_RESTORE): Ditto. (TARGET_OPTION_PRINT): Ditto. @@ -1280,8 +1415,7 @@ 2008-07-23 Michael Meissner <gnu@the-meissners.org> Karthik Kumar <karthikkumar@gmail.com> - * config/i386/i386.h (TARGET_ABM): Move switch into - ix86_isa_flags. + * config/i386/i386.h (TARGET_ABM): Move switch into ix86_isa_flags. (TARGET_POPCNT): Ditto. (TARGET_SAHF): Ditto. (TARGET_AES): Ditto. @@ -1296,8 +1430,7 @@ (REGISTER_TARGET_PRAGMAS): Define, call ix86_register_pragmas. * config/i386/i386.opt (arch): New TargetSave field to define - fields that need to be saved for function specific option - support. + fields that need to be saved for function specific option support. (tune): Ditto. (fpmath): Ditto. (branch_cost): Ditto. @@ -1368,8 +1501,7 @@ (i386.o): Make dependencies mirror the include files used. (i386-c.o): New file, add dependencies. - * config/i386/i386-protos.h (override_options): Add bool - argument. + * config/i386/i386-protos.h (override_options): Add bool argument. (ix86_valid_option_attribute_tree): Add declaration. (ix86_target_macros): Ditto. (ix86_register_macros): Ditto. @@ -1382,8 +1514,7 @@ masks for the tune variables. (ix86_arch_features): Move initialization of the target masks to initial_ix86_arch_features to allow functions to have different - target options. Make type unsigned char, instead of unsigned - int. + target options. Make type unsigned char, instead of unsigned int. (initial_ix86_arch_features): New static vector to hold processor masks for the arch variables. (enum ix86_function_specific_strings): New enum to describe the @@ -1393,8 +1524,7 @@ (ix86_debug_options): New function to print the current options in the debugger. (ix86_function_specific_save): New function hook to save the - function specific global variables in the cl_target_option - structure. + function specific global variables in the cl_target_option structure. (ix86_function_specific_restore): New function hook to restore the function specific variables from the cl_target_option structure to the global variables. @@ -1404,8 +1534,7 @@ attribute((option(...))) arguments. (ix86_valid_option_attribute_tree): New function that is common code between attribute((option(...))) and #pragma GCC option - support that parses the options and returns a tree holding the - options. + support that parses the options and returns a tree holding the options. (ix86_valid_option_attribute_inner_p): New helper function for ix86_valid_option_attribute_tree. (ix86_can_inline_p): New function hook to decide if one function @@ -1432,8 +1561,7 @@ (struct ptt): Move to static file scope from override_options. (processor_target_table): Ditto. (cpu_names): Ditto. - (ix86_handle_option): Add support for options that are now isa - options. + (ix86_handle_option): Add support for options that are now isa options. (override_options): Add support for declaring functions that support different target options than were specified on the command line. Move struct ptt, processor_target_table, cpu_names, @@ -1461,8 +1589,8 @@ 2008-07-22 Rafael Avila de Espindola <espindola@google.com> - * c-typeck.c (build_external_ref): Don't call assemble_external. - * final.c (output_operand): Call assemble_external. + * c-typeck.c (build_external_ref): Don't call assemble_external. + * final.c (output_operand): Call assemble_external. 2008-07-21 DJ Delorie <dj@redhat.com> @@ -1784,8 +1912,8 @@ 2007-07-16 Rafael Avila de Espindola <espindola@google.com> - * c-decl.c (merge_decls): Keep DECL_SOURCE_LOCATION and - DECL_IN_SYSTEM_HEADER in sync. + * c-decl.c (merge_decls): Keep DECL_SOURCE_LOCATION and + DECL_IN_SYSTEM_HEADER in sync. 2008-07-15 Daniel Berlin <dberlin@dberlin.org> @@ -12674,7 +12802,7 @@ (finish_optimization_passes): Update. (all_passes, all_ipa_passes, all_lowering_passes): Update declaration. (register_one_dump_file, register_dump_files_1, next_pass_1): - Update arguments. + Update arguments. (init_optimization_passes): Update handling of new types. (execute_one_pass, execute_pass_list, execute_ipa_pass_list): Update. * ipa-struct-reorg.c: Update tree_pass descriptors. @@ -12855,7 +12983,7 @@ * config/avr/avr.c (avr_arch_types): Add avr6 entry. (avr_arch): Add ARCH_AVR6. (avr_mcu_types): Add 'atmega2560' and 'atmega2561' entry. - (initial_elimination_offset): Initialize and use 'avr_pc_size' + (initial_elimination_offset): Initialize and use 'avr_pc_size' instead of fixed value 2. (print_operand_address): Use gs() asm specifier instead of pm(). (avr_assemble_integer): (Ditto.). @@ -16087,12 +16215,12 @@ 'have_elpm', 'have_elpmx', 'have_eijmp_eicall', 'reserved'. Rename 'mega' to 'have_jmp_call'. (TARGET_CPU_CPP_BUILTINS): Define "__AVR_HAVE_JMP_CALL__", - "__AVR_HAVE_RAMPZ__", "__AVR_HAVE_ELPM__" and "__AVR_HAVE_ELPMX__" + "__AVR_HAVE_RAMPZ__", "__AVR_HAVE_ELPM__" and "__AVR_HAVE_ELPMX__" macros. (LINK_SPEC, CRT_BINUTILS_SPECS, ASM_SPEC): Add 'avr31' and 'avr51' architectures. * config/avr/t-avr (MULTILIB_OPTIONS, MULTILIB_DIRNAMES, - MULTILIB_MATCHES): (Ditto.). + MULTILIB_MATCHES): Ditto. 2008-01-23 Richard Guenther <rguenther@suse.de> diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 197e40ff3ef..8760ad57ac7 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20080801 +20080804 diff --git a/gcc/Makefile.in b/gcc/Makefile.in index f82ad2bb61e..fc7bfe38e11 100644 --- a/gcc/Makefile.in +++ b/gcc/Makefile.in @@ -1720,6 +1720,7 @@ libgcc.mvars: config.status Makefile $(LIB2ADD) $(LIB2ADD_ST) specs \ echo SHLIB_MAPFILES = '$(call srcdirify,$(SHLIB_MAPFILES))' >> tmp-libgcc.mvars echo SHLIB_NM_FLAGS = '$(SHLIB_NM_FLAGS)' >> tmp-libgcc.mvars echo LIBGCC2_CFLAGS = '$(LIBGCC2_CFLAGS)' >> tmp-libgcc.mvars + echo TARGET_LIBGCC2_CFLAGS = '$(TARGET_LIBGCC2_CFLAGS)' >> tmp-libgcc.mvars echo LIBGCC_SYNC = '$(LIBGCC_SYNC)' >> tmp-libgcc.mvars echo LIBGCC_SYNC_CFLAGS = '$(LIBGCC_SYNC_CFLAGS)' >> tmp-libgcc.mvars echo CRTSTUFF_CFLAGS = '$(CRTSTUFF_CFLAGS)' >> tmp-libgcc.mvars diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fdb714c1cb7..e49c0cd7510 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,582 @@ +2008-08-04 Pascal Obry <obry@adacore.com> + + * adaint.h: Add missing prototype. + + * adaint.c: Refine support for Windows file attributes. + +2008-08-04 Robert Dewar <dewar@adacore.com> + + * sem_res.adb: + (Valid_Conversion): Catch case of designated types having different + sizes, even though they statically match. + +2008-08-04 Javier Miranda <miranda@adacore.com> + + * sem_eval.adb (Subtypes_Statically_Match): Remove superfluous patch + added in previous patch to handle access to subprograms. + +2008-08-04 Robert Dewar <dewar@adacore.com> + + * freeze.adb: + (Freeze_Entity): Only check No_Default_Initialization restriction for + constructs that come from source + +2008-08-04 Thomas Quinot <quinot@adacore.com> + + * exp_ch6.adb: Minor comment fix. + + * sem_ch4.adb: Minor reformatting. + +2008-08-04 Robert Dewar <dewar@adacore.com> + + * sem_res.adb: (Large_Storage_Type): Improve previous change. + +2008-08-04 Pascal Obry <obry@adacore.com> + + * adaint.c, s-os_lib.adb, s-os_lib.ads: Use Windows ACL to deal with + file attributes. + +2008-08-04 Javier Miranda <miranda@adacore.com> + + * sem_ch3.adb (Access_Subprogram_Declaration): Adding missing support + for N_Formal_Object_Declaration nodes. Adding kludge required by + First_Formal to provide its functionality with access to functions. + (Replace_Anonymous_Access_To_Protected_Subprogram): Add missing support + for anonymous access types returned by functions. + + * sem_ch5.adb (Analyze_Assignment): Code cleanup to avoid duplicate + conversion of null-excluding access types (required only once to force + the generation of the required runtime check). + + * sem_type.adb (Covers): minor reformating + + * checks.adb (Null_Exclusion_Static_Checks): Avoid reporting errors + with internally generated nodes. Avoid generating the error inside init + procs. + + * sem_res.adb (Resolve_Membership_Test): Minor reformating. + (Resolve_Null): Generate the null-excluding check in case of assignment + to a null-excluding object. + (Valid_Conversion): Add missing support for anonymous access to + subprograms. + + * sem_ch6.adb (Check_Return_Subtype_Indication): Add missing support for + anonymous access types whose designated type is an itype. This case + occurs with anonymous access to protected subprograms types. + (Analyze_Return_Type): Add missing support for anonymous access to + protected subprogram. + + * sem_eval.adb (Subtypes_Statically_Match): In case of access to + subprograms addition of missing check on matching convention. Required + to properly handle access to protected subprogram types. + + * exp_ch3 (Build_Assignment): Code cleanup removing duplicated check on + null excluding access types. + +2008-08-04 Ed Schonberg <schonberg@adacore.com> + + * sem_ch12.adb: Add comments + + * sem_ch4.adb (Analyze_Allocator): If the designated type is a non-null + access type and the allocator is not initialized, warn rather than + reporting an error. + +2008-08-04 Robert Dewar <dewar@adacore.com> + + * exp_ch4.adb: Minor reformatting + + * exp_dist.adb: Minor reformatting + + * g-comlin.adb: Minor reformatting + +2008-08-04 Gary Dismukes <dismukes@adacore.com> + + * exp_aggr.adb (Build_Record_Aggr_Code): Perform a conversion of the + target to the type of the aggregate in the case where the target object + is class-wide. + + * exp_ch5.adb (Expand_Simple_Function_Return): When the function's + result type is class-wide and inherently limited, and the expression + has a specific type, create a return object of the specific type, for + more efficient handling of returns of build-in-place aggregates (avoids + conversions of the class-wide return object to the specific type on + component assignments). + + * sem_ch6.adb (Check_Return_Subtype_Indication): Suppress the error + about a type mismatch for a class-wide function with a return object + having a specific type when the object declaration doesn't come from + source. Such an object can result from the expansion of a simple return. + +2008-08-04 Vasiliy Fofanov <fofanov@adacore.com> + + * g-soccon-mingw-64.ads, system-mingw-x86_64.ads: New files. + + * gcc-interface/Makefile.in: Use 64bit-specific system files when + compiling for 64bit windows. + +2008-08-04 Jerome Lambourg <lambourg@adacore.com> + + * g-comlin.adb (Group_Switches): Preserve the switch order when + grouping and allow switch grouping of switches with more than one + character extension (e.g. gnatw.x). + (Args_From_Expanded): Remove this now obsolete method. + +2008-08-04 Ed Schonberg <schonberg@adacore.com> + + * exp_ch4.adb (Get_Allocator_Final_List): Freeze anonymous type for + chain at once, to ensure that type is properly decorated for back-end, + when allocator appears within a loop. + +2008-08-04 Kevin Pouget <pouget@adacore.com> + + * snames.h, snames.adb, snames.ads: + Add Attr_To_Any, Attr_From_Any and Attr_TypeCode defines. + + * exp_dist.ads, exp_dist.adb: Add Build_From_Any_Call, + Build_To_Any_Call and Build_TypeCode_Call procedures. + + * exp_attr.adb, sem_attr.adb: Add corresponding cases. + + * rtsfind.ads: Add corresponding names. + + * tbuild.adb: Update prefix restrictions to allow '_' character. + +2008-08-04 Doug Rupp <rupp@adacore.com> + + * gigi.h (fill_vms_descriptor): Add third parameter gnat_actual + * trans.c (call_to_gnu): Call fill_vms_descriptor with new parameter. + * utils2.c (fill_vms_descriptor): Add third parameter for error sloc and + use it. Calculate pointer range overflow using 64bit types. + +2008-08-04 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Access_Definition): A formal object declaration is a + legal context for an anonymous access to subprogram. + + * sem_ch4.adb (Analyze_One_Call): If the call can be interpreted as an + indirect call, report success to the caller to include possible + interpretation. + + * sem_ch6.adb (Check_Return_Type_Indication): Apply proper conformance + check when the type + of the extended return is an anonymous access_to_subprogram type. + + * sem_res.adb: + (Resolve_Call): Insert a dereference if the type of the subprogram is an + access_to_subprogram and the context requires its return type, and a + dereference has not been introduced previously. + +2008-08-04 Arnaud Charlet <charlet@adacore.com> + + * usage.adb (Usage): Minor rewording of -gnatwz switch, to improve + gnatcheck support in GPS. + +2008-08-04 Vincent Celier <celier@adacore.com> + + * mlib.adb (Create_Sym_Links): Create relative symbolic links when + requested + +2008-08-04 Vincent Celier <celier@adacore.com> + + * gprep.adb (Process_One_File): Call Prep.Preprocess with a Boolean + variable, but don't check the resulting value as it has no impact on + the processing. + + * opt.ads: + (Generate_Processed_File): New Boolean flag, set to True in the compiler + when switch -gnateG is used. + + * prep.adb: + (Preprocess): new Boolean out parameter Source_Modified. Set it to True + when the source is modified by the preprocessor and there is no + preprocessing errors. + + * prep.ads (Preprocess): new Boolean out parameter Source_Modified + + * sinput-l.adb: + (Load_File): Output the result of preprocessing if the source text was + modified. + + * switch-c.adb (Scan_Front_End_Switches): Recognize switch -gnateG + + * switch-m.adb (Normalize_Compiler_Switches): Normalize switch -gnateG + + * ug_words: Add VMS equivalent for -gnateG + + * vms_data.ads: + Add VMS option /GENERATE_PROCESSED_SOURCE, equivalent to switch -gnateG + +2008-08-04 Doug Rupp <rupp@adacore.com> + + * gcc-interface/utils2.c: + (fill_vms_descriptor): Raise CE if attempt made to pass 64bit pointer + in 32bit descriptor. + +2008-08-04 Robert Dewar <dewar@adacore.com> + + * par-ch10.adb: Minor reformatting + + * i-cobol.adb: Minor reformatting. + +2008-08-04 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Access_Definition): Create an itype reference for an + anonymous access return type of a regular function that is not a + compilation unit. + +2008-08-04 Vincent Celier <celier@adacore.com> + + * prj-attr.adb: New Builder attribute Global_Compilation_Switches + + * snames.adb: New standard name Global_Compilation_Switches + + * snames.ads: New standard name Global_Compilation_Switches + + * make.adb: Correct spelling error in comment + +2008-08-04 Arnaud Charlet <charlet@adacore.com> + + * sem_prag.adb (Check_Form_Of_Interface_Name): Fix handling for CLI + target. + +2008-08-04 Thomas Quinot <quinot@adacore.com> + + * sem_ch10.adb: Minor comment fix. + +2008-08-04 Robert Dewar <dewar@adacore.com> + + * restrict.adb: Improved messages for restriction warnings + + * restrict.ads: Improved messages for restriction messages + + * s-rident.ads (Profile_Name): Add No_Profile + +2008-08-04 Robert Dewar <dewar@adacore.com> + + * system-darwin-x86.ads: Correct bad definition of Max_Nonbinary_Modulus + +2008-08-04 Robert Dewar <dewar@adacore.com> + + * freeze.adb (Freeze_Entity): Check for size clause for boolean warning + +2008-08-04 Vincent Celier <celier@adacore.com> + + * prj-proc.adb: + (Copy_Package_Declarations): When inheriting package Naming from a + project being extended, do not inherit source exception names. + +2008-08-04 Ed Schonberg <schonberg@adacore.com> + + * sem_prag.adb (Check_Precondition_Postcondition): When scanning the + list of declaration to find previous subprogram, do not go to the + original node of a generic unit. + +2008-08-02 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/utils2.c (build_binary_op) <PLUS_EXPR, MINUS_EXPR>: + New case. Convert BOOLEAN_TYPE operation to the default integer type. + +2008-08-01 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/ada-tree.h (DECL_PARM_ALT): Now DECL_PARM_ALT_TYPE. + * gcc-interface/decl.c (gnat_to_gnu_param): Fix formatting, simplify + and adjust for above renaming. + * gcc-interface/utils.c (convert_vms_descriptor): Likewise. Add new + gnu_expr_alt_type parameter. Convert the expression to it instead + of changing its type in place. + (build_function_stub): Adjust call to above function. + +2008-08-01 Eric Botcazou <ebotcazou@adacore.com> + + * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Constant>: Remove dead + code. Do not get full definition of deferred constants with address + clause for a use. Do not ignore deferred constant definitions with + address clause. Ignore constant definitions already marked with the + error node. + <object>: Remove obsolete comment. For a deferred constant with + address clause, get the initializer from the full view. + * gcc-interface/trans.c (gnat_to_gnu) <N_Attribute_Definition_Clause>: + Rework and remove obsolete comment. + <N_Object_Declaration>: For a deferred constant with address clause, + mark the full view with the error node. + * gcc-interface/utils.c (convert_to_fat_pointer): Rework and fix + formatting nits. + +2008-08-01 Hristian Kirtchev <kirtchev@adacore.com> + + * rtsfind.ads: Add block IO versions of stream routines for Strings. + + * bindgen.adb, gnat_rm.texi, gnat_ugn.texi, opt.ads, + sem_prag.adb, snames.adb, snames.ads, snames.h, + par-prag.adb: Undo previous stream related changes. + + * s-rident.ads: Add new restriction No_Stream_Optimizations. + + * s-ststop.ads, s-ststop.adb: Comment reformatting. + Define enumeration type to designate different IO mechanisms. + Enchance generic package Stream_Ops_Internal to include an + implementation of Input and Output. + + * exp_attr.adb (Find_Stream_Subprogram): If restriction + No_Stream_Optimization is active, choose the default byte IO + implementations of stream attributes for Strings. + Otherwise use the corresponding block IO version. + +2008-08-01 Olivier Hainque <hainque@adacore.com> + + * gcc-interface/decl.c (gnat_to_gnu_entity) <case E_Function>: Do not + turn Ada Pure into GCC const, now implicitely implying nothrow as well. + +2008-08-01 Robert Dewar <dewar@adacore.com> + + * par-ch3.adb (P_Defining_Identifier): Avoid repeated attempt to + convert plain identifier into defining identifier. + +2008-08-01 Robert Dewar <dewar@adacore.com> + + * sem_prag.adb (Check_Form_Of_Interface_Name): Refine and improve + warnings + + * lib-xref.adb: Add error defense. + +2008-08-01 Bob Duff <duff@adacore.com> + + * ioexcept.ads, sequenio.ads, directio.ads: Correct comment. + +2008-08-01 Gary Dismukes <dismukes@adacore.com> + + * exp_ch6.adb (Expand_Call): Adjustment to previous fix for passing + correct accessibility levels. In the "when others" case, retrieve the + access level of the Etype of Prev rather than Prev_Orig, because the + original exression has not always been analyzed. + +2008-08-01 Robert Dewar <dewar@adacore.com> + + * prj-nmsc.adb: Minor reformatting + + * sem_ch4.adb: Minor reformatting + Minor code reorganization + + * prj.ads: Minor reformatting + + * s-os_lib.adb: Minor reformatting + + * par-prag.adb (Prag, case Wide_Character_Encoding): Deal with upper + half encodings + + * scans.ads: Minor reformatting. + + * sem_prag.adb (Analyze_Pragma): Put entries in alpha order + (Analyze_Pragma): Make sure all GNAT pragmas call GNAT_Pragma + + * sem_res.adb: + (Resolve_Call): Check violation of No_Specific_Termination_Handlers + + * sem_ch12.adb: Minor comment reformatting + + * par-ch3.adb (P_Type_Declaration): Properly handle missing type + keyword + +2008-08-01 Robert Dewar <dewar@adacore.com> + + * sem_ch6.adb (Process_PPCs): Don't copy spec PPC to body if not + generating code + +2008-08-01 Ed Schonberg <schonberg@adacore.com> + + * checks.adb (Apply_Float_Conversion_Check): If the expression to be + converted is a real literal and the target type has static bounds, + perform the conversion exactly to prevent floating-point anomalies on + some targets. + +2008-08-01 Vincent Celier <celier@adacore.com> + + * prj-attr.adb: New attribute Compiler'Name_Syntax (<lang>) + + * prj-nmsc.adb (Process_Compiler): Recognize attribute Name_Syntax + + * prj.adb (Object_Exist_For): Use Object_Generated, not + Objects_Generated that is removed and was never modified anyway. + + * prj.ads: + (Path_Syntax_Kind): New enumeration type + (Language_Config): New component Path_Syntax, defaulted to Host. + Components PIC_Option and Objects_Generated removed, as they are not + used. + + * snames.adb: New standard name Path_Syntax + + * snames.ads: New standard name Path_Syntax + +2008-08-01 Vincent Celier <celier@adacore.com> + + * mlib-utl.adb: + (Adalib_Path): New variable to store the path of the adalib directory + when procedure Specify_Adalib_Dir is called. + (Lib_Directory): If Adalib_Path is not null, return its value + (Specify_Adalib_Dir): New procedure + + * mlib-utl.ads (Specify_Adalib_Dir): New procedure + +2008-08-01 Ed Schonberg <schonberg@adacore.com> + + * sem_prag.adb: + (Check_Precondition_Postcondition): If not generating code, analyze the + expression in a postcondition that appears in a subprogram body, so that + it is properly decorated for ASIS use. + +2008-08-01 Gary Dismukes <dismukes@adacore.com> + + * exp_ch6.adb (Expand_Call): Remove ugly special-case code that resets + Orig_Prev to Prev in the case where the actual is N_Function_Call or + N_Identifier. This was interfering with other cases that are rewritten + as N_Identifier, such as allocators, resulting in passing of the wrong + accessibility level, and based on testing this code is apparently no + longer needed at all. + +2008-08-01 Ed Schonberg <schonberg@adacore.com> + + * sem_ch4.adb (Analyze_One_Call): Handle complex overloading of a + procedure call whose prefix + is a parameterless function call that returns an access_to_procedure. + +2008-08-01 Jose Ruiz <ruiz@adacore.com> + + * adaint.c (__gnat_tmp_name): Refine the generation of temporary names + for RTX. Adding a suffix that is incremented at each iteration. + +2008-08-01 Robert Dewar <dewar@adacore.com> + + * sem_ch6.adb (Analyze_Subprogram_Body): Remove special casing of + Raise_Exception + +2008-08-01 Jerome Lambourg <lambourg@adacore.com> + + * s-os_lib.adb (Normalize_Pathname): Take care of double-quotes in + paths, which are authorized by Windows but can lead to errors when used + elsewhere. + +2008-08-01 Ed Schonberg <schonberg@adacore.com> + + * sem_ch12.ads (Need_Subprogram_Instance_Body): new function, to create + a pending instantiation for the body of a subprogram that is to be + inlined. + + * sem_ch12.adb: + (Analyze_Subprogram_Instantiation): use Need_Subprogram_Instance_Body. + + * sem_prag.adb (Make_Inline): If the pragma applies to an instance, + create a pending instance for its body, so that calls to the subprogram + can be inlined by the back-end. + +2008-08-01 Jose Ruiz <ruiz@adacore.com> + + * gnat_ugn.texi: Document the RTX run times (rts-rtx-rtss and + rts-rtx-w32). + +2008-08-01 Robert Dewar <dewar@adacore.com> + + * scng.adb (Error_Illegal_Wide_Character): Bump scan pointer + +2008-08-01 Doug Rupp <rupp@adacore.com> + + * gnat_rm.texi: Document new mechanism Short_Descriptor. + + * types.ads (Mechanism_Type): Modify range for new Short_Descriptor + mechanism values. + + * sem_prag.adb (Set_Mechanism_Value): Enhance for Short_Descriptor + mechanism and Short_Descriptor mechanism values. + + * snames.adb (preset_names): Add short_descriptor entry. + + * snames.ads: Add Name_Short_Descriptor. + + * types.h: Add new By_Short_Descriptor mechanism values. + + * sem_mech.adb (Set_Mechanism_Value): Enhance for Short_Descriptor + mechanism and Short_Descriptor mechanism values. + + * sem_mech.ads (Mechanism_Type): Add new By_Short_Descriptor mechanism + values. + (Descriptor_Codes): Modify range for new mechanism values. + + * treepr.adb (Print_Entity_Enfo): Handle new By_Short_Descriptor + mechanism values. + + * gcc-interface/decl.c (gnat_to_gnu_entity): Handle By_Short_Descriptor. + (gnat_to_gnu_param): Handle By_Short_Descriptor. + + * gcc-interface/gigi.h (build_vms_descriptor64): Remove prototype. + (build_vms_descriptor32): New prototype. + (fill_vms_descriptor): Remove unneeded gnat_actual parameter. + + * gcc-interface/trans.c (call_to_gnu): Removed unneeded gnat_actual + argument in call fill_vms_descriptor. + + * gcc-interface/utils.c (build_vms_descriptor32): Renamed from + build_vms_descriptor and enhanced to hande Short_Descriptor mechanism. + (build_vms_descriptor): Renamed from build_vms_descriptor64. + (convert_vms_descriptor32): New function. + (convert_vms_descriptor64): New function. + (convert_vms_descriptor): Rewrite to handle both 32bit and 64bit + descriptors. + + * gcc-interface/utils2.c (fill_vms_descriptor): Revert previous changes, + no longer needed. + +2008-08-01 Jose Ruiz <ruiz@adacore.com> + + * adaint.c (__gnat_tmp_name): RTSS applications do not support tempnam + nor tmpnam, so we always use c:\WINDOWS\Temp\gnat-XXXXXX as temporary + name. + +2008-08-01 Jose Ruiz <ruiz@adacore.com> + + * cstreams.c (__gnat_full_name): RTSS applications cannot ask for the + current directory so only fully qualified names are allowed. + +2008-08-01 Robert Dewar <dewar@adacore.com> + + * gnat_ugn.texi: + Minor editing, remove uncomfortable use of semicolon + + * s-ststop.adb: Add some ??? comments + + * sem_ch10.adb: Minor reformatting + + * snames.ads: + Minor comment fixes, some pragmas were not properly + categorized in the comments, documentation change only + + * xref_lib.adb: Minor reformatting + + * sinput.adb: Minor reformatting + + * gnatchop.adb: Minor reformatting + + * sem_util.ads: Minor reformatting. + + * opt.ads: Minor documentation fix + + * scng.adb: Minor reformatting + + * prj-part.adb: Update comments + +2008-08-01 Ed Schonberg <schonberg@adacore.com> + + * exp_disp.adb (Expand_Interface_Conversion): If the target type is a + tagged synchronized type, use corresponding record type. + +2008-08-01 Doug Rupp <rupp@adacore.com> + + * mlib-tgt-specific-vms-alpha.adb (Build_Dynamic_Library): Output a + dummy transfer address for debugging. + + * mlib-tgt-specific-vms-ia64.adb (Build_Dynamic_Library): Likewise. + + * vms_data.ads: vms_data.ads: New qualfier /MACHINE_CODE_LISTING + 2008-07-31 Eric Botcazou <ebotcazou@adacore.com> * gcc-interface/decl.c (gnat_to_gnu_entity): Fix formatting. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 29f649aa096..20f8d22ea21 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -187,6 +187,8 @@ struct vstring #if defined (_WIN32) #include <dir.h> #include <windows.h> +#include <accctrl.h> +#include <aclapi.h> #undef DIR_SEPARATOR #define DIR_SEPARATOR '\\' #endif @@ -982,7 +984,15 @@ __gnat_named_file_length (char *name) void __gnat_tmp_name (char *tmp_filename) { -#ifdef __MINGW32__ +#ifdef RTX + /* Variable used to create a series of unique names */ + static int counter = 0; + + /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */ + strcpy (tmp_filename, "c:\\WINDOWS\\Temp\\gnat-"); + sprintf (&tmp_filename[strlen (tmp_filename)], "%d\0", counter++); + +#elif defined (__MINGW32__) { char *pname; @@ -1504,10 +1514,6 @@ __gnat_set_file_time_name (char *name, time_t time_stamp) #endif } -#ifdef _WIN32 -#include <windows.h> -#endif - /* Get the list of installed standard libraries from the HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries key. */ @@ -1677,9 +1683,147 @@ __gnat_is_directory (char *name) return (!ret && S_ISDIR (statbuf.st_mode)); } +#if defined (_WIN32) && !defined (RTX) +/* This MingW section contains code to work with ACL. */ +static int +__gnat_check_OWNER_ACL +(TCHAR *wname, + DWORD CheckAccessDesired, + GENERIC_MAPPING CheckGenericMapping) +{ + DWORD dwAccessDesired, dwAccessAllowed; + PRIVILEGE_SET PrivilegeSet; + DWORD dwPrivSetSize = sizeof (PRIVILEGE_SET); + BOOL fAccessGranted = FALSE; + HANDLE hToken; + DWORD nLength; + SECURITY_DESCRIPTOR* pSD = NULL; + + GetFileSecurity + (wname, OWNER_SECURITY_INFORMATION | + GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION, + NULL, 0, &nLength); + + if ((pSD = (PSECURITY_DESCRIPTOR) HeapAlloc + (GetProcessHeap (), HEAP_ZERO_MEMORY, nLength)) == NULL) + return 0; + + /* Obtain the security descriptor. */ + + if (!GetFileSecurity + (wname, OWNER_SECURITY_INFORMATION | + GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION, + pSD, nLength, &nLength)) + return 0; + + if (!ImpersonateSelf (SecurityImpersonation)) + return 0; + + if (!OpenThreadToken + (GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) + return 0; + + /* Undoes the effect of ImpersonateSelf. */ + + RevertToSelf (); + + /* We want to test for write permissions. */ + + dwAccessDesired = CheckAccessDesired; + + MapGenericMask (&dwAccessDesired, &CheckGenericMapping); + + if (!AccessCheck + (pSD , /* security descriptor to check */ + hToken, /* impersonation token */ + dwAccessDesired, /* requested access rights */ + &CheckGenericMapping, /* pointer to GENERIC_MAPPING */ + &PrivilegeSet, /* receives privileges used in check */ + &dwPrivSetSize, /* size of PrivilegeSet buffer */ + &dwAccessAllowed, /* receives mask of allowed access rights */ + &fAccessGranted)) + return 0; + + return fAccessGranted; +} + +static void +__gnat_set_OWNER_ACL +(TCHAR *wname, + DWORD AccessMode, + DWORD AccessPermissions) +{ + ACL* pOldDACL = NULL; + ACL* pNewDACL = NULL; + SECURITY_DESCRIPTOR* pSD = NULL; + EXPLICIT_ACCESS ea; + TCHAR username [100]; + DWORD unsize = 100; + + HANDLE file = CreateFile + (wname, READ_CONTROL | WRITE_DAC, 0, NULL, + OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); + + if (file == INVALID_HANDLE_VALUE) + return; + + /* Get current user, he will act as the owner */ + + if (!GetUserName (username, &unsize)) + return; + + if (GetSecurityInfo + (file, + SE_FILE_OBJECT, + DACL_SECURITY_INFORMATION, + NULL, NULL, &pOldDACL, NULL, &pSD) != ERROR_SUCCESS) + return; + + ZeroMemory (&ea, sizeof (EXPLICIT_ACCESS)); + + ea.grfAccessMode = AccessMode; + ea.grfAccessPermissions = AccessPermissions; + ea.grfInheritance = CONTAINER_INHERIT_ACE | OBJECT_INHERIT_ACE; + ea.Trustee.TrusteeForm = TRUSTEE_IS_NAME; + ea.Trustee.TrusteeType = TRUSTEE_IS_USER; + ea.Trustee.ptstrName = username; + + if (AccessMode == SET_ACCESS) + { + /* SET_ACCESS, we want to set an explicte set of permissions, do not + merge with current DACL. */ + if (SetEntriesInAcl (1, &ea, NULL, &pNewDACL) != ERROR_SUCCESS) + return; + } + else + if (SetEntriesInAcl (1, &ea, pOldDACL, &pNewDACL) != ERROR_SUCCESS) + return; + + if (SetSecurityInfo + (file, SE_FILE_OBJECT, + DACL_SECURITY_INFORMATION, NULL, NULL, pNewDACL, NULL) != ERROR_SUCCESS) + return; + + LocalFree (pSD); + LocalFree (pNewDACL); + CloseHandle (file); +} +#endif /* defined (_WIN32) && !defined (RTX) */ + int __gnat_is_readable_file (char *name) { +#if defined (_WIN32) && !defined (RTX) + TCHAR wname [GNAT_MAX_PATH_LEN + 2]; + GENERIC_MAPPING GenericMapping; + + S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2); + + ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING)); + GenericMapping.GenericRead = GENERIC_READ; + + return __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping); +#else int ret; int mode; struct stat statbuf; @@ -1687,11 +1831,25 @@ __gnat_is_readable_file (char *name) ret = __gnat_stat (name, &statbuf); mode = statbuf.st_mode & S_IRUSR; return (!ret && mode); +#endif } int __gnat_is_writable_file (char *name) { +#if defined (_WIN32) && !defined (RTX) + TCHAR wname [GNAT_MAX_PATH_LEN + 2]; + GENERIC_MAPPING GenericMapping; + + S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2); + + ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING)); + GenericMapping.GenericWrite = GENERIC_WRITE; + + return __gnat_check_OWNER_ACL + (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping) + && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY); +#else int ret; int mode; struct stat statbuf; @@ -1699,12 +1857,45 @@ __gnat_is_writable_file (char *name) ret = __gnat_stat (name, &statbuf); mode = statbuf.st_mode & S_IWUSR; return (!ret && mode); +#endif +} + +int +__gnat_is_executable_file (char *name) +{ +#if defined (_WIN32) && !defined (RTX) + TCHAR wname [GNAT_MAX_PATH_LEN + 2]; + GENERIC_MAPPING GenericMapping; + + S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2); + + ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING)); + GenericMapping.GenericExecute = GENERIC_EXECUTE; + + return __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping); +#else + int ret; + int mode; + struct stat statbuf; + + ret = __gnat_stat (name, &statbuf); + mode = statbuf.st_mode & S_IXUSR; + return (!ret && mode); +#endif } void __gnat_set_writable (char *name) { -#if ! defined (__vxworks) && ! defined(__nucleus__) +#if defined (_WIN32) && !defined (RTX) + TCHAR wname [GNAT_MAX_PATH_LEN + 2]; + + S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2); + + __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, GENERIC_WRITE); + SetFileAttributes + (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY); +#elif ! defined (__vxworks) && ! defined(__nucleus__) struct stat statbuf; if (stat (name, &statbuf) == 0) @@ -1718,7 +1909,13 @@ __gnat_set_writable (char *name) void __gnat_set_executable (char *name) { -#if ! defined (__vxworks) && ! defined(__nucleus__) +#if defined (_WIN32) && !defined (RTX) + TCHAR wname [GNAT_MAX_PATH_LEN + 2]; + + S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2); + + __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, GENERIC_EXECUTE); +#elif ! defined (__vxworks) && ! defined(__nucleus__) struct stat statbuf; if (stat (name, &statbuf) == 0) @@ -1732,7 +1929,15 @@ __gnat_set_executable (char *name) void __gnat_set_readonly (char *name) { -#if ! defined (__vxworks) && ! defined(__nucleus__) +#if defined (_WIN32) && !defined (RTX) + TCHAR wname [GNAT_MAX_PATH_LEN + 2]; + + S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2); + + __gnat_set_OWNER_ACL (wname, SET_ACCESS, GENERIC_READ); + SetFileAttributes + (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY); +#elif ! defined (__vxworks) && ! defined(__nucleus__) struct stat statbuf; if (stat (name, &statbuf) == 0) diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h index 7b1e86df960..a447c0fa58a 100644 --- a/gcc/ada/adaint.h +++ b/gcc/ada/adaint.h @@ -101,6 +101,7 @@ extern int __gnat_is_absolute_path (char *,int); extern int __gnat_is_directory (char *); extern int __gnat_is_writable_file (char *); extern int __gnat_is_readable_file (char *name); +extern int __gnat_is_executable_file (char *name); extern void __gnat_set_readonly (char *name); extern void __gnat_set_writable (char *name); extern void __gnat_set_executable (char *name); diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 204496a9f11..070651cbd6a 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -126,7 +126,6 @@ package body Bindgen is -- Detect_Blocking : Integer; -- Default_Stack_Size : Integer; -- Leap_Seconds_Support : Integer; - -- Canonical_Streams : Integer; -- Main_Priority is the priority value set by pragma Priority in the main -- program. If no such pragma is present, the value is -1. @@ -212,10 +211,6 @@ package body Bindgen is -- disabled. A value of zero indicates that leap seconds are turned "off", -- while a value of one signifies "on" status. - -- Canonical_Streams indicates whether stream-related optimizations are - -- active. A value of zero indicates that all optimizations are active, - -- while a value of one signifies that they have been disabled. - ----------------------- -- Local Subprograms -- ----------------------- @@ -596,9 +591,6 @@ package body Bindgen is WBI (" Leap_Seconds_Support : Integer;"); WBI (" pragma Import (C, Leap_Seconds_Support, " & """__gl_leap_seconds_support"");"); - WBI (" Canonical_Streams : Integer;"); - WBI (" pragma Import (C, Canonical_Streams, " & - """__gl_canonical_streams"");"); -- Import entry point for elaboration time signal handler -- installation, and indication of if it's been called previously. @@ -767,17 +759,6 @@ package body Bindgen is Set_String (";"); Write_Statement_Buffer; - Set_String (" Canonical_Streams := "); - - if Canonical_Streams then - Set_Int (1); - else - Set_Int (0); - end if; - - Set_String (";"); - Write_Statement_Buffer; - -- Generate call to Install_Handler WBI (""); @@ -1059,18 +1040,6 @@ package body Bindgen is Set_String (";"); Write_Statement_Buffer; - WBI (" extern int __gl_canonical_streams;"); - Set_String (" __gl_canonical_streams = "); - - if Canonical_Streams then - Set_Int (1); - else - Set_Int (0); - end if; - - Set_String (";"); - Write_Statement_Buffer; - WBI (""); -- Install elaboration time signal handler diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 6eb7ebbbbc3..38b1a07e409 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1633,11 +1633,36 @@ package body Checks is end; end if; - -- Get the bounds of the target type + -- Get the (static) bounds of the target type Ifirst := Expr_Value (LB); Ilast := Expr_Value (HB); + -- A simple optimization: if the expression is a universal literal, + -- we can do the comparison with the bounds and the conversion to + -- an integer type statically. The range checks are unchanged. + + if Nkind (Ck_Node) = N_Real_Literal + and then Etype (Ck_Node) = Universal_Real + and then Is_Integer_Type (Target_Typ) + and then Nkind (Parent (Ck_Node)) = N_Type_Conversion + then + declare + Int_Val : constant Uint := UR_To_Uint (Realval (Ck_Node)); + + begin + if Int_Val <= Ilast and then Int_Val >= Ifirst then + + -- Conversion is safe. + + Rewrite (Parent (Ck_Node), + Make_Integer_Literal (Loc, UI_To_Int (Int_Val))); + Analyze_And_Resolve (Parent (Ck_Node), Target_Typ); + return; + end if; + end; + end if; + -- Check against lower bound if Truncate and then Ifirst > 0 then @@ -2846,11 +2871,7 @@ package body Checks is -- be applied to a [sub]type that does not exclude null already. elsif Can_Never_Be_Null (Typ) - - -- No need to check itypes that have a null exclusion because - -- they are already examined at their point of creation. - - and then not Is_Itype (Typ) + and then Comes_From_Source (Typ) then Error_Msg_NE ("`NOT NULL` not allowed (& already excludes null)", @@ -5281,10 +5302,20 @@ package body Checks is -- If known to be null, here is where we generate a compile time check if Known_Null (N) then - Apply_Compile_Time_Constraint_Error - (N, - "null value not allowed here?", - CE_Access_Check_Failed); + + -- Avoid generating warning message inside init procs + + if not Inside_Init_Proc then + Apply_Compile_Time_Constraint_Error + (N, + "null value not allowed here?", + CE_Access_Check_Failed); + else + Insert_Action (N, + Make_Raise_Constraint_Error (Loc, + Reason => CE_Access_Check_Failed)); + end if; + Mark_Non_Null; return; end if; diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c index fe81bcbe97e..79dde9331c0 100644 --- a/gcc/ada/cstreams.c +++ b/gcc/ada/cstreams.c @@ -6,7 +6,7 @@ * * * Auxiliary C functions for Interfaces.C.Streams * * * - * Copyright (C) 1992-2007, Free Software Foundation, Inc. * + * Copyright (C) 1992-2008, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -156,7 +156,18 @@ __gnat_constant_stdout (void) char * __gnat_full_name (char *nam, char *buffer) { -#if defined(__EMX__) || defined (__MINGW32__) +#ifdef RTSS + /* RTSS applications have no current-directory notion, so RTSS file I/O + requests must use fully qualified path names, such as: + c:\temp\MyFile.txt (for a file system object) + \\.\MyDevice0 (for a device object) + */ + if (nam[1] == ':' || nam[0] == '\\') + strcpy (buffer, nam); + else + buffer[0] = '\0'; + +#elif defined(__EMX__) || defined (__MINGW32__) /* If this is a device file return it as is; under Windows NT and OS/2 a device file end with ":". */ if (nam[strlen (nam) - 1] == ':') diff --git a/gcc/ada/directio.ads b/gcc/ada/directio.ads index b69ca4467e1..c09f77270b9 100644 --- a/gcc/ada/directio.ads +++ b/gcc/ada/directio.ads @@ -15,9 +15,9 @@ pragma Ada_2005; -- Explicit setting of Ada 2005 mode is required here, since we want to with a --- child unit (not possible in Ada 83 mode), and Text_IO is not considered to --- be an internal unit that is automatically compiled in Ada 2005 mode (since --- a user is allowed to redeclare Direct_IO). +-- child unit (not possible in Ada 83 mode), and Direct_IO is not considered +-- to be an internal unit that is automatically compiled in Ada 2005 mode +-- (since a user is allowed to redeclare Direct_IO). with Ada.Direct_IO; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index eaff8e89a9e..bc3b954fb6c 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -2436,8 +2436,12 @@ package body Exp_Aggr is -- to the actual type of the aggregate, so that the proper components -- are visible. We know already that the types are compatible. + -- There should also be a comment here explaining why the conversion + -- is needed in the case of interfaces.??? + if Present (Etype (Lhs)) - and then Is_Interface (Etype (Lhs)) + and then (Is_Interface (Etype (Lhs)) + or else Is_Class_Wide_Type (Etype (Lhs))) then Target := Unchecked_Convert_To (Typ, Lhs); else diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 84bc808b86f..890f09b1d82 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -33,6 +33,7 @@ with Exp_Ch2; use Exp_Ch2; with Exp_Ch3; use Exp_Ch3; with Exp_Ch6; use Exp_Ch6; with Exp_Ch9; use Exp_Ch9; +with Exp_Dist; use Exp_Dist; with Exp_Imgv; use Exp_Imgv; with Exp_Pakd; use Exp_Pakd; with Exp_Strm; use Exp_Strm; @@ -2075,6 +2076,22 @@ package body Exp_Attr is Expand_Fpt_Attribute_R (N); -------------- + -- From_Any -- + -------------- + + when Attribute_From_Any => From_Any : declare + P_Type : constant Entity_Id := Etype (Pref); + Decls : constant List_Id := New_List; + begin + Rewrite (N, + Build_From_Any_Call (P_Type, + Relocate_Node (First (Exprs)), + Decls)); + Insert_Actions (N, Decls); + Analyze_And_Resolve (N, P_Type); + end From_Any; + + -------------- -- Identity -- -------------- @@ -4396,6 +4413,22 @@ package body Exp_Attr is Relocate_Node (First (Exprs)))); Analyze_And_Resolve (N, RTE (RE_Address)); + ------------ + -- To_Any -- + ------------ + + when Attribute_To_Any => To_Any : declare + P_Type : constant Entity_Id := Etype (Pref); + Decls : constant List_Id := New_List; + begin + Rewrite (N, + Build_To_Any_Call + (Convert_To (P_Type, + Relocate_Node (First (Exprs))), Decls)); + Insert_Actions (N, Decls); + Analyze_And_Resolve (N, RTE (RE_Any)); + end To_Any; + ---------------- -- Truncation -- ---------------- @@ -4409,6 +4442,19 @@ package body Exp_Attr is Expand_Fpt_Attribute_R (N); end if; + -------------- + -- TypeCode -- + -------------- + + when Attribute_TypeCode => TypeCode : declare + P_Type : constant Entity_Id := Etype (Pref); + Decls : constant List_Id := New_List; + begin + Rewrite (N, Build_TypeCode_Call (Loc, P_Type, Decls)); + Insert_Actions (N, Decls); + Analyze_And_Resolve (N, RTE (RE_TypeCode)); + end TypeCode; + ----------------------- -- Unbiased_Rounding -- ----------------------- @@ -5365,53 +5411,100 @@ package body Exp_Attr is and then not Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) then - -- String as defined in package Ada if Base_Typ = Standard_String then - if Nam = TSS_Stream_Input then - return RTE (RE_String_Input); + if Restriction_Active (No_Stream_Optimizations) then + if Nam = TSS_Stream_Input then + return RTE (RE_String_Input); + + elsif Nam = TSS_Stream_Output then + return RTE (RE_String_Output); - elsif Nam = TSS_Stream_Output then - return RTE (RE_String_Output); + elsif Nam = TSS_Stream_Read then + return RTE (RE_String_Read); - elsif Nam = TSS_Stream_Read then - return RTE (RE_String_Read); + else pragma Assert (Nam = TSS_Stream_Write); + return RTE (RE_String_Write); + end if; + + else + if Nam = TSS_Stream_Input then + return RTE (RE_String_Input_Blk_IO); + + elsif Nam = TSS_Stream_Output then + return RTE (RE_String_Output_Blk_IO); + + elsif Nam = TSS_Stream_Read then + return RTE (RE_String_Read_Blk_IO); - else pragma Assert (Nam = TSS_Stream_Write); - return RTE (RE_String_Write); + else pragma Assert (Nam = TSS_Stream_Write); + return RTE (RE_String_Write_Blk_IO); + end if; end if; -- Wide_String as defined in package Ada elsif Base_Typ = Standard_Wide_String then - if Nam = TSS_Stream_Input then - return RTE (RE_Wide_String_Input); + if Restriction_Active (No_Stream_Optimizations) then + if Nam = TSS_Stream_Input then + return RTE (RE_Wide_String_Input); + + elsif Nam = TSS_Stream_Output then + return RTE (RE_Wide_String_Output); + + elsif Nam = TSS_Stream_Read then + return RTE (RE_Wide_String_Read); + + else pragma Assert (Nam = TSS_Stream_Write); + return RTE (RE_Wide_String_Write); + end if; - elsif Nam = TSS_Stream_Output then - return RTE (RE_Wide_String_Output); + else + if Nam = TSS_Stream_Input then + return RTE (RE_Wide_String_Input_Blk_IO); + + elsif Nam = TSS_Stream_Output then + return RTE (RE_Wide_String_Output_Blk_IO); - elsif Nam = TSS_Stream_Read then - return RTE (RE_Wide_String_Read); + elsif Nam = TSS_Stream_Read then + return RTE (RE_Wide_String_Read_Blk_IO); - else pragma Assert (Nam = TSS_Stream_Write); - return RTE (RE_Wide_String_Write); + else pragma Assert (Nam = TSS_Stream_Write); + return RTE (RE_Wide_String_Write_Blk_IO); + end if; end if; -- Wide_Wide_String as defined in package Ada elsif Base_Typ = Standard_Wide_Wide_String then - if Nam = TSS_Stream_Input then - return RTE (RE_Wide_Wide_String_Input); + if Restriction_Active (No_Stream_Optimizations) then + if Nam = TSS_Stream_Input then + return RTE (RE_Wide_Wide_String_Input); + + elsif Nam = TSS_Stream_Output then + return RTE (RE_Wide_Wide_String_Output); + + elsif Nam = TSS_Stream_Read then + return RTE (RE_Wide_Wide_String_Read); - elsif Nam = TSS_Stream_Output then - return RTE (RE_Wide_Wide_String_Output); + else pragma Assert (Nam = TSS_Stream_Write); + return RTE (RE_Wide_Wide_String_Write); + end if; + + else + if Nam = TSS_Stream_Input then + return RTE (RE_Wide_Wide_String_Input_Blk_IO); - elsif Nam = TSS_Stream_Read then - return RTE (RE_Wide_Wide_String_Read); + elsif Nam = TSS_Stream_Output then + return RTE (RE_Wide_Wide_String_Output_Blk_IO); - else pragma Assert (Nam = TSS_Stream_Write); - return RTE (RE_Wide_Wide_String_Write); + elsif Nam = TSS_Stream_Read then + return RTE (RE_Wide_Wide_String_Read_Blk_IO); + + else pragma Assert (Nam = TSS_Stream_Write); + return RTE (RE_Wide_Wide_String_Write_Blk_IO); + end if; end if; end if; end if; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index b110121bc5e..92a5f8c3b60 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1826,23 +1826,6 @@ package body Exp_Ch3 is Attribute_Name => Name_Unrestricted_Access); end if; - -- Ada 2005 (AI-231): Add the run-time check if required - - if Ada_Version >= Ada_05 - and then Can_Never_Be_Null (Etype (Id)) -- Lhs - then - if Known_Null (Exp) then - return New_List ( - Make_Raise_Constraint_Error (Sloc (Exp), - Reason => CE_Null_Not_Allowed)); - - elsif Present (Etype (Exp)) - and then not Can_Never_Be_Null (Etype (Exp)) - then - Install_Null_Excluding_Check (Exp); - end if; - end if; - -- Take a copy of Exp to ensure that later copies of this component -- declaration in derived types see the original tree, not a node -- rewritten during expansion of the init_proc. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index ba09aa69807..b1243d7a280 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -977,8 +977,7 @@ package body Exp_Ch4 is -- not allow sliding, but this check does (a relaxation from Ada 83). if Is_Constrained (DesigT) - and then not Subtypes_Statically_Match - (T, DesigT) + and then not Subtypes_Statically_Match (T, DesigT) then Apply_Constraint_Check (Exp, DesigT, No_Sliding => False); @@ -8354,7 +8353,9 @@ package body Exp_Ch4 is -- chain. The Final_Chain that is thus created is shared by the -- access parameter. The access type is tested against the result -- type of the function to exclude allocators whose type is an - -- anonymous access result type. + -- anonymous access result type. We freeze the type at once to + -- ensure that it is properly decorated for the back-end, even + -- if the context and current scope is a loop. if Nkind (Associated_Node_For_Itype (PtrT)) in N_Subprogram_Specification @@ -8371,6 +8372,7 @@ package body Exp_Ch4 is Subtype_Indication => New_Occurrence_Of (T, Loc)))); + Freeze_Before (N, Owner); Build_Final_List (N, Owner); Set_Associated_Final_Chain (PtrT, Associated_Final_Chain (Owner)); diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 18ea8fe44db..729c126f4d6 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3695,22 +3695,39 @@ package body Exp_Ch5 is Return_Object_Entity : constant Entity_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); + Subtype_Ind : Node_Id; - Subtype_Ind : constant Node_Id := New_Occurrence_Of (R_Type, Loc); + begin + -- If the result type of the function is class-wide and the + -- expression has a specific type, then we use the expression's + -- type as the type of the return object. In cases where the + -- expression is an aggregate that is built in place, this avoids + -- the need for an expensive conversion of the return object to + -- the specific type on assignments to the individual components. + + if Is_Class_Wide_Type (R_Type) + and then not Is_Class_Wide_Type (Etype (Exp)) + then + Subtype_Ind := New_Occurrence_Of (Etype (Exp), Loc); + else + Subtype_Ind := New_Occurrence_Of (R_Type, Loc); + end if; - Obj_Decl : constant Node_Id := - Make_Object_Declaration (Loc, - Defining_Identifier => Return_Object_Entity, - Object_Definition => Subtype_Ind, - Expression => Exp); + declare + Obj_Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => Return_Object_Entity, + Object_Definition => Subtype_Ind, + Expression => Exp); - Ext : constant Node_Id := Make_Extended_Return_Statement (Loc, - Return_Object_Declarations => New_List (Obj_Decl)); + Ext : constant Node_Id := Make_Extended_Return_Statement (Loc, + Return_Object_Declarations => New_List (Obj_Decl)); - begin - Rewrite (N, Ext); - Analyze (N); - return; + begin + Rewrite (N, Ext); + Analyze (N); + return; + end; end; end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index d1d43cf3974..4c3f3da63f9 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2034,15 +2034,6 @@ package body Exp_Ch6 is Prev := Actual; Prev_Orig := Original_Node (Prev); - -- The original actual may have been a call written in prefix - -- form, and rewritten before analysis. - - if not Analyzed (Prev_Orig) - and then Nkind_In (Actual, N_Function_Call, N_Identifier) - then - Prev_Orig := Prev; - end if; - -- Ada 2005 (AI-251): Check if any formal is a class-wide interface -- to expand it in a further round. @@ -2293,13 +2284,15 @@ package body Exp_Ch6 is Intval => Scope_Depth (Current_Scope) + 1), Extra_Accessibility (Formal)); - -- For other cases we simply pass the level of the - -- actual's access type. + -- For other cases we simply pass the level of the actual's + -- access type. The type is retrieved from Prev rather than + -- Prev_Orig, because in some cases Prev_Orig denotes an + -- original expression that has not been analyzed. when others => Add_Extra_Actual (Make_Integer_Literal (Loc, - Intval => Type_Access_Level (Etype (Prev_Orig))), + Intval => Type_Access_Level (Etype (Prev))), Extra_Accessibility (Formal)); end case; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index ac25171abf7..461edc75a3d 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -766,6 +766,13 @@ package body Exp_Disp is Iface_Typ := Root_Type (Iface_Typ); end if; + -- If the target type is a tagged synchronized type, the dispatch table + -- info is in the correspondoing record type. + + if Is_Concurrent_Type (Iface_Typ) then + Iface_Typ := Corresponding_Record_Type (Iface_Typ); + end if; + pragma Assert (not Is_Static or else (not Is_Class_Wide_Type (Iface_Typ) and then Is_Interface (Iface_Typ))); diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index c22239277bf..38693f13b6a 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -858,6 +858,25 @@ package body Exp_Dist is end PolyORB_Support; + -- The following PolyORB-specific subprograms are made visible to Exp_Attr: + + function Build_From_Any_Call + (Typ : Entity_Id; + N : Node_Id; + Decls : List_Id) return Node_Id + renames PolyORB_Support.Helpers.Build_From_Any_Call; + + function Build_To_Any_Call + (N : Node_Id; + Decls : List_Id) return Node_Id + renames PolyORB_Support.Helpers.Build_To_Any_Call; + + function Build_TypeCode_Call + (Loc : Source_Ptr; + Typ : Entity_Id; + Decls : List_Id) return Node_Id + renames PolyORB_Support.Helpers.Build_TypeCode_Call; + ------------------------------------ -- Local variables and structures -- ------------------------------------ @@ -8218,12 +8237,11 @@ package body Exp_Dist is -- point type from Standard, or the smallest unsigned (modular) type -- from System.Unsigned_Types, whose range encompasses that of Typ. - function Make_Stream_Procedure_Function_Name + function Make_Helper_Function_Name (Loc : Source_Ptr; Typ : Entity_Id; Nam : Name_Id) return Entity_Id; - -- Return the name to be assigned for stream subprogram Nam of Typ. - -- (copied from exp_strm.adb, should be shared???) + -- Return the name to be assigned for helper subprogram Nam of Typ ------------------------------------------------------------ -- Common subprograms for building various tree fragments -- @@ -8432,6 +8450,11 @@ package body Exp_Dist is elsif U_Type = Standard_String then Lib_RE := RE_FA_String; + -- Special DSA types + + elsif Is_RTE (U_Type, RE_Any_Content_Ptr) then + Lib_RE := RE_FA_A; + -- Other (non-primitive) types else @@ -8493,8 +8516,7 @@ package body Exp_Dist is return; end if; - Fnam := - Make_Stream_Procedure_Function_Name (Loc, Typ, Name_uFrom_Any); + Fnam := Make_Helper_Function_Name (Loc, Typ, Name_From_Any); Spec := Make_Function_Specification (Loc, @@ -9293,7 +9315,13 @@ package body Exp_Dist is elsif U_Type = Standard_String then Lib_RE := RE_TA_String; + -- Special DSA types + + elsif Is_RTE (U_Type, RE_Any_Content_Ptr) then + Lib_RE := RE_TA_A; + elsif U_Type = Underlying_Type (RTE (RE_TypeCode)) then + -- No corresponding FA_TC ??? Lib_RE := RE_TA_TC; -- Other (non-primitive) types @@ -9358,8 +9386,7 @@ package body Exp_Dist is return; end if; - Fnam := - Make_Stream_Procedure_Function_Name (Loc, Typ, Name_uTo_Any); + Fnam := Make_Helper_Function_Name (Loc, Typ, Name_To_Any); Spec := Make_Function_Specification (Loc, @@ -9976,7 +10003,7 @@ package body Exp_Dist is -- not been set yet, so can't call Find_Inherited_TSS. if Typ = RTE (RE_Any) then - Fnam := RTE (RE_TC_Any); + Fnam := RTE (RE_TC_A); else -- First simple case where the TypeCode is present @@ -10057,6 +10084,11 @@ package body Exp_Dist is elsif U_Type = Standard_String then Lib_RE := RE_TC_String; + -- Special DSA types + + elsif Is_RTE (U_Type, RE_Any_Content_Ptr) then + Lib_RE := RE_TC_A; + -- Other (non-primitive) types else @@ -10100,8 +10132,7 @@ package body Exp_Dist is Stms : constant List_Id := New_List; TCNam : constant Entity_Id := - Make_Stream_Procedure_Function_Name (Loc, - Typ, Name_uTypeCode); + Make_Helper_Function_Name (Loc, Typ, Name_TypeCode); Parameters : List_Id; @@ -10964,30 +10995,40 @@ package body Exp_Dist is end; end Append_Array_Traversal; - ----------------------------------------- - -- Make_Stream_Procedure_Function_Name -- - ----------------------------------------- + ------------------------------- + -- Make_Helper_Function_Name -- + ------------------------------- - function Make_Stream_Procedure_Function_Name + function Make_Helper_Function_Name (Loc : Source_Ptr; Typ : Entity_Id; Nam : Name_Id) return Entity_Id is begin - -- For tagged types, we use a canonical name so that it matches - -- the primitive spec. For all other cases, we use a serialized - -- name so that multiple generations of the same procedure do not - -- clash. + declare + Serial : Nat := 0; + -- For tagged types, we use a canonical name so that it matches + -- the primitive spec. For all other cases, we use a serialized + -- name so that multiple generations of the same procedure do + -- not clash. + + begin + if not Is_Tagged_Type (Typ) then + Serial := Increment_Serial_Number; + end if; + + -- Use prefixed underscore to avoid potential clash with used + -- identifier (we use attribute names for Nam). - if Is_Tagged_Type (Typ) then - return Make_Defining_Identifier (Loc, Nam); - else return Make_Defining_Identifier (Loc, Chars => - New_External_Name (Nam, ' ', Increment_Serial_Number)); - end if; - end Make_Stream_Procedure_Function_Name; + New_External_Name + (Related_Id => Nam, + Suffix => ' ', Suffix_Index => Serial, + Prefix => '_')); + end; + end Make_Helper_Function_Name; end Helpers; ----------------------------------- diff --git a/gcc/ada/exp_dist.ads b/gcc/ada/exp_dist.ads index a1418d3f6bb..26995a8b9f9 100644 --- a/gcc/ada/exp_dist.ads +++ b/gcc/ada/exp_dist.ads @@ -129,4 +129,37 @@ package Exp_Dist is -- a remote call) satisfies the requirements for being transportable -- across partitions, raising Program_Error if it does not. + ---------------------------------------------------------------- + -- Functions for expansion of PolyORB/DSA specific attributes -- + ---------------------------------------------------------------- + + function Build_From_Any_Call + (Typ : Entity_Id; + N : Node_Id; + Decls : List_Id) return Node_Id; + -- Build call to From_Any attribute function of type Typ with expression + -- N as actual parameter. Decls is the declarations list for an appropriate + -- enclosing scope of the point where the call will be inserted; if the + -- From_Any attribute for Typ needs to be generated at this point, its + -- declaration is appended to Decls. + + function Build_To_Any_Call + (N : Node_Id; + Decls : List_Id) return Node_Id; + -- Build call to To_Any attribute function with expression as actual + -- parameter. Decls is the declarations list for an appropriate + -- enclosing scope of the point where the call will be inserted; if + -- the To_Any attribute for Typ needs to be generated at this point, + -- its declaration is appended to Decls. + + function Build_TypeCode_Call + (Loc : Source_Ptr; + Typ : Entity_Id; + Decls : List_Id) return Node_Id; + -- Build call to TypeCode attribute function for Typ. Decls is the + -- declarations list for an appropriate enclosing scope of the point + -- where the call will be inserted; if the To_Any attribute for Typ + -- needs to be generated at this point, its declaration is appended + -- to Decls. + end Exp_Dist; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 31f93985c44..dffcbaf3b40 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2398,6 +2398,8 @@ package body Freeze is elsif Root_Type (F_Type) = Standard_Boolean and then Convention (F_Type) = Convention_Ada + and then not Has_Warnings_Off (F_Type) + and then not Has_Size_Clause (F_Type) then Error_Msg_N ("?& is an 8-bit Ada Boolean, " @@ -2543,6 +2545,7 @@ package body Freeze is and then Convention (R_Type) = Convention_Ada and then not Has_Warnings_Off (E) and then not Has_Warnings_Off (R_Type) + and then not Has_Size_Clause (R_Type) then Error_Msg_N ("?return type of & is an 8-bit " @@ -2662,7 +2665,8 @@ package body Freeze is -- ever default initialized, and is why the check is deferred -- until freezing, at which point we know if Import applies. - if not Is_Imported (E) + if Comes_From_Source (E) + and then not Is_Imported (E) and then not Has_Init_Expression (Declaration_Node (E)) and then ((Has_Non_Null_Base_Init_Proc (Etype (E)) diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index c9cb4dbad25..32460c0599b 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -32,7 +32,9 @@ ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; -with GNAT.OS_Lib; use GNAT.OS_Lib; +with Ada.Strings.Unbounded; + +with GNAT.OS_Lib; use GNAT.OS_Lib; package body GNAT.Command_Line is @@ -101,8 +103,6 @@ package body GNAT.Command_Line is procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Command_Line_Configuration_Record, Command_Line_Configuration); - type Boolean_Chars is array (Character) of Boolean; - procedure Remove (Line : in out Argument_List_Access; Index : Integer); -- Remove a specific element from Line @@ -111,9 +111,6 @@ package body GNAT.Command_Line is Str : String_Access); -- Append a new element to Line - function Args_From_Expanded (Args : Boolean_Chars) return String; - -- Return the string made of all characters with True in Args - generic with procedure Callback (Simple_Switch : String); procedure For_Each_Simple_Switch @@ -1050,25 +1047,6 @@ package body GNAT.Command_Line is end if; end Free; - ------------------------ - -- Args_From_Expanded -- - ------------------------ - - function Args_From_Expanded (Args : Boolean_Chars) return String is - Result : String (1 .. Args'Length); - Index : Natural := Result'First; - - begin - for A in Args'Range loop - if Args (A) then - Result (Index) := A; - Index := Index + 1; - end if; - end loop; - - return Result (1 .. Index - 1); - end Args_From_Expanded; - ------------------ -- Define_Alias -- ------------------ @@ -1470,12 +1448,9 @@ package body GNAT.Command_Line is Result : Argument_List_Access; Params : Argument_List_Access) is - type Boolean_Array is array (Result'Range) of Boolean; - - Matched : Boolean_Array; - Count : Natural; + Group : Ada.Strings.Unbounded.Unbounded_String; First : Natural; - From_Args : Boolean_Chars; + use type Ada.Strings.Unbounded.Unbounded_String; begin if Cmd.Config = null @@ -1485,8 +1460,8 @@ package body GNAT.Command_Line is end if; for P in Cmd.Config.Prefixes'Range loop - Matched := (others => False); - Count := 0; + Group := Ada.Strings.Unbounded.Null_Unbounded_String; + First := 0; for C in Result'Range loop if Result (C) /= null @@ -1494,32 +1469,25 @@ package body GNAT.Command_Line is and then Looking_At (Result (C).all, Result (C)'First, Cmd.Config.Prefixes (P).all) then - Matched (C) := True; - Count := Count + 1; + Group := + Group & + Result (C) + (Result (C)'First + Cmd.Config.Prefixes (P)'Length .. + Result (C)'Last); + + if First = 0 then + First := C; + end if; + + Free (Result (C)); end if; end loop; - if Count > 1 then - From_Args := (others => False); - First := 0; - - for M in Matched'Range loop - if Matched (M) then - if First = 0 then - First := M; - end if; - - for A in Result (M)'First + Cmd.Config.Prefixes (P)'Length - .. Result (M)'Last - loop - From_Args (Result (M)(A)) := True; - end loop; - Free (Result (M)); - end if; - end loop; - - Result (First) := new String' - (Cmd.Config.Prefixes (P).all & Args_From_Expanded (From_Args)); + if First > 0 then + Result (First) := + new String' + (Cmd.Config.Prefixes (P).all & + Ada.Strings.Unbounded.To_String (Group)); end if; end loop; end Group_Switches; diff --git a/gcc/ada/g-soccon-mingw-64.ads b/gcc/ada/g-soccon-mingw-64.ads new file mode 100644 index 00000000000..cc84740b15f --- /dev/null +++ b/gcc/ada/g-soccon-mingw-64.ads @@ -0,0 +1,220 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . S O C K E T S . C O N S T A N T S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2000-2008, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides target dependent definitions of constant for use +-- by the GNAT.Sockets package (g-socket.ads). This package should not be +-- directly with'ed by an applications program. + +-- This is the version for x86_64-mingw32msv +-- This file is generated automatically, do not modify it by hand! Instead, +-- make changes to gen-soccon.c and re-run it on each target. + +with Interfaces.C; +package GNAT.Sockets.Constants is + + -------------- + -- Families -- + -------------- + + AF_INET : constant := 2; -- IPv4 address family + AF_INET6 : constant := 23; -- IPv6 address family + + ----------- + -- Modes -- + ----------- + + SOCK_STREAM : constant := 1; -- Stream socket + SOCK_DGRAM : constant := 2; -- Datagram socket + + ------------------- + -- Socket errors -- + ------------------- + + EACCES : constant := 10013; -- Permission denied + EADDRINUSE : constant := 10048; -- Address already in use + EADDRNOTAVAIL : constant := 10049; -- Cannot assign address + EAFNOSUPPORT : constant := 10047; -- Addr family not supported + EALREADY : constant := 10037; -- Operation in progress + EBADF : constant := 10009; -- Bad file descriptor + ECONNABORTED : constant := 10053; -- Connection aborted + ECONNREFUSED : constant := 10061; -- Connection refused + ECONNRESET : constant := 10054; -- Connection reset by peer + EDESTADDRREQ : constant := 10039; -- Destination addr required + EFAULT : constant := 10014; -- Bad address + EHOSTDOWN : constant := 10064; -- Host is down + EHOSTUNREACH : constant := 10065; -- No route to host + EINPROGRESS : constant := 10036; -- Operation now in progress + EINTR : constant := 10004; -- Interrupted system call + EINVAL : constant := 10022; -- Invalid argument + EIO : constant := 10101; -- Input output error + EISCONN : constant := 10056; -- Socket already connected + ELOOP : constant := 10062; -- Too many symbolic links + EMFILE : constant := 10024; -- Too many open files + EMSGSIZE : constant := 10040; -- Message too long + ENAMETOOLONG : constant := 10063; -- Name too long + ENETDOWN : constant := 10050; -- Network is down + ENETRESET : constant := 10052; -- Disconn. on network reset + ENETUNREACH : constant := 10051; -- Network is unreachable + ENOBUFS : constant := 10055; -- No buffer space available + ENOPROTOOPT : constant := 10042; -- Protocol not available + ENOTCONN : constant := 10057; -- Socket not connected + ENOTSOCK : constant := 10038; -- Operation on non socket + EOPNOTSUPP : constant := 10045; -- Operation not supported + EPFNOSUPPORT : constant := 10046; -- Unknown protocol family + EPROTONOSUPPORT : constant := 10043; -- Unknown protocol + EPROTOTYPE : constant := 10041; -- Unknown protocol type + ESHUTDOWN : constant := 10058; -- Cannot send once shutdown + ESOCKTNOSUPPORT : constant := 10044; -- Socket type not supported + ETIMEDOUT : constant := 10060; -- Connection timed out + ETOOMANYREFS : constant := 10059; -- Too many references + EWOULDBLOCK : constant := 10035; -- Operation would block + + ----------------- + -- Host errors -- + ----------------- + + HOST_NOT_FOUND : constant := 11001; -- Unknown host + TRY_AGAIN : constant := 11002; -- Host name lookup failure + NO_DATA : constant := 11004; -- No data record for name + NO_RECOVERY : constant := 11003; -- Non recoverable errors + + ------------------- + -- Control flags -- + ------------------- + + FIONBIO : constant := -2147195266; -- Set/clear non-blocking io + FIONREAD : constant := 1074030207; -- How many bytes to read + + -------------------- + -- Shutdown modes -- + -------------------- + + SHUT_RD : constant := 0; -- No more recv + SHUT_WR : constant := 1; -- No more send + SHUT_RDWR : constant := 2; -- No more recv/send + + --------------------- + -- Protocol levels -- + --------------------- + + SOL_SOCKET : constant := 65535; -- Options for socket level + IPPROTO_IP : constant := 0; -- Dummy protocol for IP + IPPROTO_UDP : constant := 17; -- UDP + IPPROTO_TCP : constant := 6; -- TCP + + ------------------- + -- Request flags -- + ------------------- + + MSG_OOB : constant := 1; -- Process out-of-band data + MSG_PEEK : constant := 2; -- Peek at incoming data + MSG_EOR : constant := -1; -- Send end of record + MSG_WAITALL : constant := 8; -- Wait for full reception + MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send + MSG_Forced_Flags : constant := 0; + -- Flags set on all send(2) calls + + -------------------- + -- Socket options -- + -------------------- + + TCP_NODELAY : constant := 1; -- Do not coalesce packets + SO_REUSEADDR : constant := 4; -- Bind reuse local address + SO_REUSEPORT : constant := -1; -- Bind reuse port number + SO_KEEPALIVE : constant := 8; -- Enable keep-alive msgs + SO_LINGER : constant := 128; -- Defer close to flush data + SO_BROADCAST : constant := 32; -- Can send broadcast msgs + SO_SNDBUF : constant := 4097; -- Set/get send buffer size + SO_RCVBUF : constant := 4098; -- Set/get recv buffer size + SO_SNDTIMEO : constant := 4101; -- Emission timeout + SO_RCVTIMEO : constant := 4102; -- Reception timeout + SO_ERROR : constant := 4103; -- Get/clear error status + IP_MULTICAST_IF : constant := 9; -- Set/get mcast interface + IP_MULTICAST_TTL : constant := 10; -- Set/get multicast TTL + IP_MULTICAST_LOOP : constant := 11; -- Set/get mcast loopback + IP_ADD_MEMBERSHIP : constant := 12; -- Join a multicast group + IP_DROP_MEMBERSHIP : constant := 13; -- Leave a multicast group + IP_PKTINFO : constant := 19; -- Get datagram info + + ------------------- + -- System limits -- + ------------------- + + IOV_MAX : constant := 2147483647; -- Maximum writev iovcnt + + ---------------------- + -- Type definitions -- + ---------------------- + + -- Sizes (in bytes) of the components of struct timeval + + SIZEOF_tv_sec : constant := 4; -- tv_sec + SIZEOF_tv_usec : constant := 4; -- tv_usec + + -- Sizes of protocol specific address types (for sockaddr.sa_len) + + SIZEOF_sockaddr_in : constant := 16; -- struct sockaddr_in + SIZEOF_sockaddr_in6 : constant := 28; -- struct sockaddr_in6 + + -- Size of file descriptor sets + + SIZEOF_fd_set : constant := 8200; -- fd_set + + -- Fields of struct hostent + + subtype H_Addrtype_T is Interfaces.C.short; + subtype H_Length_T is Interfaces.C.short; + + ---------------------------------------- + -- Properties of supported interfaces -- + ---------------------------------------- + + Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops + Has_Sockaddr_Len : constant := 0; -- Sockaddr has sa_len field + + Thread_Blocking_IO : constant Boolean := True; + -- Set False for contexts where socket i/o are process blocking + + ------------------------------ + -- MinGW-specific constants -- + ------------------------------ + + -- These constants may be used only within the MinGW version of + -- GNAT.Sockets.Thin. + + WSASYSNOTREADY : constant := 10091; -- System not ready + WSAVERNOTSUPPORTED : constant := 10092; -- Version not supported + WSANOTINITIALISED : constant := 10093; -- Winsock not initialized + WSAEDISCON : constant := 10101; -- Disconnected + +end GNAT.Sockets.Constants; diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index acc523d8abb..ff8ebbe52b1 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -1318,11 +1318,11 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),) g-socthi.ads<g-socthi-mingw.ads \ g-socthi.adb<g-socthi-mingw.adb \ g-stsifd.adb<g-stsifd-sockets.adb \ - g-soccon.ads<g-soccon-mingw.ads \ g-soliop.ads<g-soliop-mingw.ads ifeq ($(strip $(filter-out rtx_w32 rtx_rtss,$(THREAD_KIND))),) LIBGNAT_TARGET_PAIRS += \ + g-soccon.ads<g-soccon-mingw.ads \ s-intman.adb<s-intman-dummy.adb \ s-osinte.ads<s-osinte-rtx.ads \ s-osprim.adb<s-osprim-rtx.adb \ @@ -1352,10 +1352,19 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),) s-intman.adb<s-intman-mingw.adb \ s-osinte.ads<s-osinte-mingw.ads \ s-osprim.adb<s-osprim-mingw.adb \ - s-taprop.adb<s-taprop-mingw.adb \ - system.ads<system-mingw.ads + s-taprop.adb<s-taprop-mingw.adb - EXTRA_GNATRTL_NONTASKING_OBJS = s-win32.o s-winext.o g-regist.o + ifeq ($(strip $(filter-out x86_64%,$(arch))),) + LIBGNAT_TARGET_PAIRS += \ + g-soccon.ads<g-soccon-mingw-64.ads \ + system.ads<system-mingw-x86_64.ads + else + LIBGNAT_TARGET_PAIRS += \ + g-soccon.ads<g-soccon-mingw.ads \ + system.ads<system-mingw.ads + endif + + EXTRA_GNATRTL_NONTASKING_OBJS = s-win32.o s-win32.o g-regist.o EXTRA_GNATRTL_TASKING_OBJS = a-exetim.o MISCLIB = -lwsock32 diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 9472995effc..1db5ce28ecf 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -294,10 +294,10 @@ struct lang_type GTY(()) {tree t; }; #define SET_DECL_FUNCTION_STUB(NODE, X) \ SET_DECL_LANG_SPECIFIC (FUNCTION_DECL_CHECK (NODE), X) -/* In a PARM_DECL, points to the alternate TREE_TYPE */ -#define DECL_PARM_ALT(NODE) \ +/* In a PARM_DECL, points to the alternate TREE_TYPE. */ +#define DECL_PARM_ALT_TYPE(NODE) \ GET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE)) -#define SET_DECL_PARM_ALT(NODE, X) \ +#define SET_DECL_PARM_ALT_TYPE(NODE, X) \ SET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE), X) /* In a FIELD_DECL corresponding to a discriminant, contains the diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index f8ebf5a58be..c9e90457803 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -367,12 +367,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) switch (kind) { case E_Constant: - /* If this is a use of a deferred constant, get its full - declaration. */ - if (!definition && Present (Full_View (gnat_entity))) + /* If this is a use of a deferred constant without address clause, + get its full definition. */ + if (!definition + && No (Address_Clause (gnat_entity)) + && Present (Full_View (gnat_entity))) { - gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity), - gnu_expr, 0); + gnu_decl + = gnat_to_gnu_entity (Full_View (gnat_entity), gnu_expr, 0); saved = true; break; } @@ -391,12 +393,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) != N_Allocator)) gnu_expr = gnat_to_gnu (Expression (Declaration_Node (gnat_entity))); - /* Ignore deferred constant definitions; they are processed fully in the - front-end. For deferred constant references get the full definition. - On the other hand, constants that are renamings are handled like - variable renamings. If No_Initialization is set, this is not a - deferred constant but a constant whose value is built manually. */ - if (definition && !gnu_expr + /* Ignore deferred constant definitions without address clause since + they are processed fully in the front-end. If No_Initialization + is set, this is not a deferred constant but a constant whose value + is built manually. And constants that are renamings are handled + like variables. */ + if (definition + && !gnu_expr + && No (Address_Clause (gnat_entity)) && !No_Initialization (Declaration_Node (gnat_entity)) && No (Renamed_Object (gnat_entity))) { @@ -404,12 +408,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) saved = true; break; } - else if (!definition && IN (kind, Incomplete_Or_Private_Kind) - && Present (Full_View (gnat_entity))) + + /* Ignore constant definitions already marked with the error node. See + the N_Object_Declaration case of gnat_to_gnu for the rationale. */ + if (definition + && gnu_expr + && present_gnu_tree (gnat_entity) + && get_gnu_tree (gnat_entity) == error_mark_node) { - gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity), - NULL_TREE, 0); - saved = true; + maybe_present = true; break; } @@ -1037,17 +1044,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !Is_Imported (gnat_entity) && !gnu_expr) gnu_expr = integer_zero_node; - /* If we are defining the object and it has an Address clause we must - get the address expression from the saved GCC tree for the - object if the object has a Freeze_Node. Otherwise, we elaborate - the address expression here since the front-end has guaranteed - in that case that the elaboration has no effects. Note that - only the latter mechanism is currently in use. */ + /* If we are defining the object and it has an Address clause, we must + either get the address expression from the saved GCC tree for the + object if it has a Freeze node, or elaborate the address expression + here since the front-end has guaranteed that the elaboration has no + effects in this case. */ if (definition && Present (Address_Clause (gnat_entity))) { tree gnu_address - = (present_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity) - : gnat_to_gnu (Expression (Address_Clause (gnat_entity)))); + = present_gnu_tree (gnat_entity) + ? get_gnu_tree (gnat_entity) + : gnat_to_gnu (Expression (Address_Clause (gnat_entity))); save_gnu_tree (gnat_entity, NULL_TREE, false); @@ -1064,6 +1071,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || compile_time_known_address_p (Expression (Address_Clause (gnat_entity))); + /* If this is a deferred constant, the initializer is attached to + the full view. */ + if (kind == E_Constant && Present (Full_View (gnat_entity))) + gnu_expr + = gnat_to_gnu + (Expression (Declaration_Node (Full_View (gnat_entity)))); + /* If we don't have an initializing expression for the underlying variable, the initializing expression for the pointer is the specified address. Otherwise, we have to make a COMPOUND_EXPR @@ -3872,6 +3886,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ; else if (By_Descriptor_Last <= mech && mech <= By_Descriptor) mech = By_Descriptor; + + else if (By_Short_Descriptor_Last <= mech && + mech <= By_Short_Descriptor) + mech = By_Short_Descriptor; + else if (mech > 0) { if (TREE_CODE (gnu_param_type) == UNCONSTRAINED_ARRAY_TYPE @@ -3913,7 +3932,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = chainon (gnu_param, gnu_stub_param_list); /* Change By_Descriptor parameter to By_Reference for the internal version of an exported subprogram. */ - if (mech == By_Descriptor) + if (mech == By_Descriptor || mech == By_Short_Descriptor) { gnu_param = gnat_to_gnu_param (gnat_param, By_Reference, @@ -4020,19 +4039,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (TREE_CODE (gnu_return_type) == VOID_TYPE) pure_flag = false; - /* The semantics of "pure" in Ada essentially matches that of "const" - in the back-end. In particular, both properties are orthogonal to - the "nothrow" property. But this is true only if the EH circuitry - is explicit in the internal representation of the back-end. If we - are to completely hide the EH circuitry from it, we need to declare - that calls to pure Ada subprograms that can throw have side effects - since they can trigger an "abnormal" transfer of control flow; thus - they can be neither "const" nor "pure" in the back-end sense. */ + /* The semantics of "pure" in Ada used to essentially match that of + "const" in the middle-end. In particular, both properties were + orthogonal to the "nothrow" property. This is not true in the + middle-end any more and we have no choice but to ignore the hint + at this stage. */ + gnu_type = build_qualified_type (gnu_type, TYPE_QUALS (gnu_type) - | (Exception_Mechanism == Back_End_Exceptions - ? TYPE_QUAL_CONST * pure_flag : 0) | (TYPE_QUAL_VOLATILE * volatile_flag)); Sloc_to_locus (Sloc (gnat_entity), &input_location); @@ -4826,13 +4841,13 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, gnu_param_type = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_param_type)))); - /* VMS descriptors are themselves passed by reference. - Build both a 32bit and 64bit descriptor, one of which will be chosen - in fill_vms_descriptor based on the allocator size */ + /* VMS descriptors are themselves passed by reference. */ if (mech == By_Descriptor) { + /* Build both a 32-bit and 64-bit descriptor, one of which will be + chosen in fill_vms_descriptor. */ gnu_param_type_alt - = build_pointer_type (build_vms_descriptor64 (gnu_param_type, + = build_pointer_type (build_vms_descriptor32 (gnu_param_type, Mechanism (gnat_param), gnat_subprog)); gnu_param_type @@ -4840,6 +4855,11 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, Mechanism (gnat_param), gnat_subprog)); } + else if (mech == By_Short_Descriptor) + gnu_param_type + = build_pointer_type (build_vms_descriptor32 (gnu_param_type, + Mechanism (gnat_param), + gnat_subprog)); /* Arrays are passed as pointers to element type for foreign conventions. */ else if (foreign @@ -4920,6 +4940,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, && !by_ref && (by_return || (mech != By_Descriptor + && mech != By_Short_Descriptor && !POINTER_TYPE_P (gnu_param_type) && !AGGREGATE_TYPE_P (gnu_param_type))) && !(Is_Array_Type (Etype (gnat_param)) @@ -4931,12 +4952,14 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, ro_param || by_ref || by_component_ptr); DECL_BY_REF_P (gnu_param) = by_ref; DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr; - DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor); + DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor || + mech == By_Short_Descriptor); DECL_POINTS_TO_READONLY_P (gnu_param) = (ro_param && (by_ref || by_component_ptr)); - /* Save the 64bit descriptor for later. */ - SET_DECL_PARM_ALT (gnu_param, gnu_param_type_alt); + /* Save the alternate descriptor type, if any. */ + if (gnu_param_type_alt) + SET_DECL_PARM_ALT_TYPE (gnu_param, gnu_param_type_alt); /* If no Mechanism was specified, indicate what we're using, then back-annotate it. */ diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index f44fec89abd..1b3fa24137c 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -683,7 +683,7 @@ extern void end_subprog_body (tree body, bool elab_p); Return a constructor for the template. */ extern tree build_template (tree template_type, tree array_type, tree expr); -/* Build a 32bit VMS descriptor from a Mechanism_Type, which must specify +/* Build a 64bit VMS descriptor from a Mechanism_Type, which must specify a descriptor type, and the GCC type of an object. Each FIELD_DECL in the type contains in its DECL_INITIAL the expression to use when a constructor is made for the type. GNAT_ENTITY is a gnat node used @@ -692,8 +692,8 @@ extern tree build_template (tree template_type, tree array_type, tree expr); extern tree build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity); -/* Build a 64bit VMS descriptor from a Mechanism_Type. See above. */ -extern tree build_vms_descriptor64 (tree type, Mechanism_Type mech, +/* Build a 32bit VMS descriptor from a Mechanism_Type. See above. */ +extern tree build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity); /* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG @@ -853,9 +853,10 @@ extern tree build_allocator (tree type, tree init, tree result_type, 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. GNAT_ACTUAL is how we - find the size of the allocator. */ -extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual); + GNAT_FORMAL is how we find the descriptor record. GNAT_ACTUAL is how + we derive the source location on a C_E */ +extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal, + Node_Id gnat_actual); /* Indicate that we need to make the address of EXPR_NODE and it therefore should not be allocated in a register. Return true if successful. */ diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index f8e1d49eaa2..97ff3bd2269 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -3398,6 +3398,15 @@ gnat_to_gnu (Node_Id gnat_node) if (type_annotate_only && gnu_expr && TREE_CODE (gnu_expr) == ERROR_MARK) gnu_expr = NULL_TREE; + /* If this is a deferred constant with an address clause, we ignore the + full view since the clause is on the partial view and we cannot have + 2 different GCC trees for the object. The only bits of the full view + we will use is the initializer, but it will be directly fetched. */ + if (Ekind(gnat_temp) == E_Constant + && Present (Address_Clause (gnat_temp)) + && Present (Full_View (gnat_temp))) + save_gnu_tree (Full_View (gnat_temp), error_mark_node, true); + if (No (Freeze_Node (gnat_temp))) gnat_to_gnu_entity (gnat_temp, gnu_expr, 1); break; @@ -4542,21 +4551,22 @@ gnat_to_gnu (Node_Id gnat_node) /***************************************************/ case N_Attribute_Definition_Clause: - gnu_result = alloc_stmt_list (); - /* The only one we need deal with is for 'Address. For the others, SEM - puts the information elsewhere. We need only deal with 'Address - if the object has a Freeze_Node (which it never will currently). */ - if (Get_Attribute_Id (Chars (gnat_node)) != Attr_Address - || No (Freeze_Node (Entity (Name (gnat_node))))) + /* The only one we need to deal with is 'Address since, for the others, + the front-end puts the information elsewhere. */ + if (Get_Attribute_Id (Chars (gnat_node)) != Attr_Address) + break; + + /* And we only deal with 'Address if the object has a Freeze node. */ + gnat_temp = Entity (Name (gnat_node)); + if (No (Freeze_Node (gnat_temp))) break; - /* Get the value to use as the address and save it as the - equivalent for GNAT_TEMP. When the object is frozen, - gnat_to_gnu_entity will do the right thing. */ - save_gnu_tree (Entity (Name (gnat_node)), - gnat_to_gnu (Expression (gnat_node)), true); + /* Get the value to use as the address and save it as the equivalent + for the object. When it is frozen, gnat_to_gnu_entity will do the + right thing. */ + save_gnu_tree (gnat_temp, gnat_to_gnu (Expression (gnat_node)), true); break; case N_Enumeration_Representation_Clause: @@ -5910,7 +5920,7 @@ build_unary_op_trapv (enum tree_code code, { gcc_assert ((code == NEGATE_EXPR) || (code == ABS_EXPR)); - operand = save_expr (operand); + operand = protect_multiple_eval (operand); return emit_check (build_binary_op (EQ_EXPR, integer_type_node, operand, TYPE_MIN_VALUE (gnu_type)), @@ -5929,8 +5939,8 @@ build_binary_op_trapv (enum tree_code code, tree left, tree right) { - tree lhs = save_expr (left); - tree rhs = save_expr (right); + tree lhs = protect_multiple_eval (left); + tree rhs = protect_multiple_eval (right); tree type_max = TYPE_MAX_VALUE (gnu_type); tree type_min = TYPE_MIN_VALUE (gnu_type); tree gnu_expr; diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 2105abdcb29..dcf0558ec9d 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -2659,7 +2659,7 @@ build_template (tree template_type, tree array_type, tree expr) an object of that type and also for the name. */ tree -build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) +build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) { tree record_type = make_node (RECORD_TYPE); tree pointer32_type; @@ -2689,7 +2689,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) idx_arr = (tree *) alloca (ndim * sizeof (tree)); - if (mech != By_Descriptor_NCA + if (mech != By_Descriptor_NCA && mech != By_Short_Descriptor_NCA && TREE_CODE (type) == ARRAY_TYPE && TYPE_CONVENTION_FORTRAN_P (type)) for (i = ndim - 1, inner_type = type; i >= 0; @@ -2775,16 +2775,21 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) switch (mech) { case By_Descriptor_A: + case By_Short_Descriptor_A: class = 4; break; case By_Descriptor_NCA: + case By_Short_Descriptor_NCA: class = 10; break; case By_Descriptor_SB: + case By_Short_Descriptor_SB: class = 15; break; case By_Descriptor: + case By_Short_Descriptor: case By_Descriptor_S: + case By_Short_Descriptor_S: default: class = 1; break; @@ -2797,7 +2802,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) = chainon (field_list, make_descriptor_field ("LENGTH", gnat_type_for_size (16, 1), record_type, - size_in_bytes (mech == By_Descriptor_A ? inner_type : type))); + size_in_bytes ((mech == By_Descriptor_A || + mech == By_Short_Descriptor_A) + ? inner_type : type))); field_list = chainon (field_list, make_descriptor_field ("DTYPE", @@ -2823,10 +2830,13 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) switch (mech) { case By_Descriptor: + case By_Short_Descriptor: case By_Descriptor_S: + case By_Short_Descriptor_S: break; case By_Descriptor_SB: + case By_Short_Descriptor_SB: field_list = chainon (field_list, make_descriptor_field @@ -2842,7 +2852,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) break; case By_Descriptor_A: + case By_Short_Descriptor_A: case By_Descriptor_NCA: + case By_Short_Descriptor_NCA: field_list = chainon (field_list, make_descriptor_field ("SCALE", gnat_type_for_size (8, 1), @@ -2859,7 +2871,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) = chainon (field_list, make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1), record_type, - size_int (mech == By_Descriptor_NCA + size_int ((mech == By_Descriptor_NCA || + mech == By_Short_Descriptor_NCA) ? 0 /* Set FL_COLUMN, FL_COEFF, and FL_BOUNDS. */ : (TREE_CODE (type) == ARRAY_TYPE @@ -2910,7 +2923,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) TYPE_MIN_VALUE (idx_arr[i])), size_int (1))); - fname[0] = (mech == By_Descriptor_NCA ? 'S' : 'M'); + fname[0] = ((mech == By_Descriptor_NCA || + mech == By_Short_Descriptor_NCA) ? 'S' : 'M'); fname[1] = '0' + i, fname[2] = 0; field_list = chainon (field_list, @@ -2918,7 +2932,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) gnat_type_for_size (32, 1), record_type, idx_length)); - if (mech == By_Descriptor_NCA) + if (mech == By_Descriptor_NCA || mech == By_Short_Descriptor_NCA) tem = idx_length; } @@ -2962,7 +2976,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) an object of that type and also for the name. */ tree -build_vms_descriptor64 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) +build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) { tree record64_type = make_node (RECORD_TYPE); tree pointer64_type; @@ -3283,12 +3297,160 @@ make_descriptor_field (const char *name, tree type, return field; } -/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a regular - pointer or fat pointer type. GNAT_SUBPROG is the subprogram to which - the VMS descriptor is passed. */ +/* Convert GNU_EXPR, a pointer to a 64bit VMS descriptor, to GNU_TYPE, a + regular pointer or fat pointer type. GNAT_SUBPROG is the subprogram to + which the VMS descriptor is passed. */ + +static tree +convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) +{ + tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr)); + tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr); + /* The CLASS field is the 3rd field in the descriptor. */ + tree class = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type))); + /* The POINTER field is the 6th field in the descriptor. */ + tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (class))); + + /* Retrieve the value of the POINTER field. */ + tree gnu_expr64 + = build3 (COMPONENT_REF, TREE_TYPE (pointer64), desc, pointer64, NULL_TREE); + + if (POINTER_TYPE_P (gnu_type)) + return convert (gnu_type, gnu_expr64); + + else if (TYPE_FAT_POINTER_P (gnu_type)) + { + tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type)); + tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))); + tree template_type = TREE_TYPE (p_bounds_type); + tree min_field = TYPE_FIELDS (template_type); + tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type)); + tree template, template_addr, aflags, dimct, t, u; + /* See the head comment of build_vms_descriptor. */ + int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class)); + tree lfield, ufield; + + /* Convert POINTER to the type of the P_ARRAY field. */ + gnu_expr64 = convert (p_array_type, gnu_expr64); + + switch (iclass) + { + case 1: /* Class S */ + case 15: /* Class SB */ + /* Build {1, LENGTH} template; LENGTH64 is the 5th field. */ + t = TREE_CHAIN (TREE_CHAIN (class)); + t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); + t = tree_cons (min_field, + convert (TREE_TYPE (min_field), integer_one_node), + tree_cons (max_field, + convert (TREE_TYPE (max_field), t), + NULL_TREE)); + template = gnat_build_constructor (template_type, t); + template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template); + + /* For class S, we are done. */ + if (iclass == 1) + break; + + /* Test that we really have a SB descriptor, like DEC Ada. */ + t = build3 (COMPONENT_REF, TREE_TYPE (class), desc, class, NULL); + u = convert (TREE_TYPE (class), DECL_INITIAL (class)); + u = build_binary_op (EQ_EXPR, integer_type_node, t, u); + /* If so, there is already a template in the descriptor and + it is located right after the POINTER field. The fields are + 64bits so they must be repacked. */ + t = TREE_CHAIN (pointer64); + lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); + lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield); + + t = TREE_CHAIN (t); + ufield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); + ufield = convert + (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield); + + /* Build the template in the form of a constructor. */ + t = tree_cons (TYPE_FIELDS (template_type), lfield, + tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)), + ufield, NULL_TREE)); + template = gnat_build_constructor (template_type, t); + + /* Otherwise use the {1, LENGTH} template we build above. */ + template_addr = build3 (COND_EXPR, p_bounds_type, u, + build_unary_op (ADDR_EXPR, p_bounds_type, + template), + template_addr); + break; + + case 4: /* Class A */ + /* The AFLAGS field is the 3rd field after the pointer in the + descriptor. */ + t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer64))); + aflags = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); + /* The DIMCT field is the next field in the descriptor after + aflags. */ + t = TREE_CHAIN (t); + dimct = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); + /* Raise CONSTRAINT_ERROR if either more than 1 dimension + or FL_COEFF or FL_BOUNDS not set. */ + u = build_int_cst (TREE_TYPE (aflags), 192); + u = build_binary_op (TRUTH_OR_EXPR, integer_type_node, + build_binary_op (NE_EXPR, integer_type_node, + dimct, + convert (TREE_TYPE (dimct), + size_one_node)), + build_binary_op (NE_EXPR, integer_type_node, + build2 (BIT_AND_EXPR, + TREE_TYPE (aflags), + aflags, u), + u)); + /* There is already a template in the descriptor and it is located + in block 3. The fields are 64bits so they must be repacked. */ + t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN + (t))))); + lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); + lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield); + + t = TREE_CHAIN (t); + ufield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); + ufield = convert + (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield); + + /* Build the template in the form of a constructor. */ + t = tree_cons (TYPE_FIELDS (template_type), lfield, + tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)), + ufield, NULL_TREE)); + template = gnat_build_constructor (template_type, t); + template = build3 (COND_EXPR, p_bounds_type, u, + build_call_raise (CE_Length_Check_Failed, Empty, + N_Raise_Constraint_Error), + template); + template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template); + break; + + case 10: /* Class NCA */ + default: + post_error ("unsupported descriptor type for &", gnat_subprog); + template_addr = integer_zero_node; + break; + } + + /* Build the fat pointer in the form of a constructor. */ + t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr64, + tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)), + template_addr, NULL_TREE)); + return gnat_build_constructor (gnu_type, t); + } + + else + gcc_unreachable (); +} + +/* Convert GNU_EXPR, a pointer to a 32bit VMS descriptor, to GNU_TYPE, a + regular pointer or fat pointer type. GNAT_SUBPROG is the subprogram to + which the VMS descriptor is passed. */ static tree -convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) +convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) { tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr)); tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr); @@ -3298,11 +3460,11 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) tree pointer = TREE_CHAIN (class); /* Retrieve the value of the POINTER field. */ - gnu_expr + tree gnu_expr32 = build3 (COMPONENT_REF, TREE_TYPE (pointer), desc, pointer, NULL_TREE); if (POINTER_TYPE_P (gnu_type)) - return convert (gnu_type, gnu_expr); + return convert (gnu_type, gnu_expr32); else if (TYPE_FAT_POINTER_P (gnu_type)) { @@ -3316,7 +3478,7 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class)); /* Convert POINTER to the type of the P_ARRAY field. */ - gnu_expr = convert (p_array_type, gnu_expr); + gnu_expr32 = convert (p_array_type, gnu_expr32); switch (iclass) { @@ -3372,14 +3534,14 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) TREE_TYPE (aflags), aflags, u), u)); - add_stmt (build3 (COND_EXPR, void_type_node, u, - build_call_raise (CE_Length_Check_Failed, Empty, - N_Raise_Constraint_Error), - NULL_TREE)); /* There is already a template in the descriptor and it is located at the start of block 3 (12th field). */ t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t)))); template = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); + template = build3 (COND_EXPR, p_bounds_type, u, + build_call_raise (CE_Length_Check_Failed, Empty, + N_Raise_Constraint_Error), + template); template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template); break; @@ -3391,9 +3553,10 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) } /* Build the fat pointer in the form of a constructor. */ - t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr, + t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr32, tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)), template_addr, NULL_TREE)); + return gnat_build_constructor (gnu_type, t); } @@ -3401,6 +3564,47 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) gcc_unreachable (); } +/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a regular + pointer or fat pointer type. GNU_EXPR_ALT_TYPE is the alternate (32-bit) + pointer type of GNU_EXPR. GNAT_SUBPROG is the subprogram to which the + VMS descriptor is passed. */ + +static tree +convert_vms_descriptor (tree gnu_type, tree gnu_expr, tree gnu_expr_alt_type, + Entity_Id gnat_subprog) +{ + tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr)); + tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr); + tree mbo = TYPE_FIELDS (desc_type); + const char *mbostr = IDENTIFIER_POINTER (DECL_NAME (mbo)); + tree mbmo = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (mbo))); + tree is64bit, gnu_expr32, gnu_expr64; + + /* If the field name is not MBO, it must be 32-bit and no alternate. + Otherwise primary must be 64-bit and alternate 32-bit. */ + if (strcmp (mbostr, "MBO") != 0) + return convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog); + + /* Build the test for 64-bit descriptor. */ + mbo = build3 (COMPONENT_REF, TREE_TYPE (mbo), desc, mbo, NULL_TREE); + mbmo = build3 (COMPONENT_REF, TREE_TYPE (mbmo), desc, mbmo, NULL_TREE); + is64bit + = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node, + build_binary_op (EQ_EXPR, integer_type_node, + convert (integer_type_node, mbo), + integer_one_node), + build_binary_op (EQ_EXPR, integer_type_node, + convert (integer_type_node, mbmo), + integer_minus_one_node)); + + /* Build the 2 possible end results. */ + gnu_expr64 = convert_vms_descriptor64 (gnu_type, gnu_expr, gnat_subprog); + gnu_expr = fold_convert (gnu_expr_alt_type, gnu_expr); + gnu_expr32 = convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog); + + return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32); +} + /* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG and the GNAT node GNAT_SUBPROG. */ @@ -3429,8 +3633,11 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog) gnu_arg_types = TREE_CHAIN (gnu_arg_types)) { if (DECL_BY_DESCRIPTOR_P (gnu_stub_param)) - gnu_param = convert_vms_descriptor (TREE_VALUE (gnu_arg_types), - gnu_stub_param, gnat_subprog); + gnu_param + = convert_vms_descriptor (TREE_VALUE (gnu_arg_types), + gnu_stub_param, + DECL_PARM_ALT_TYPE (gnu_stub_param), + gnat_subprog); else gnu_param = gnu_stub_param; @@ -3662,31 +3869,31 @@ update_pointer_to (tree old_type, tree new_type) } } -/* Convert a pointer to a constrained array into a pointer to a fat - pointer. This involves making or finding a template. */ +/* Convert EXPR, a pointer to a constrained array, into a pointer to an + unconstrained one. This involves making or finding a template. */ static tree convert_to_fat_pointer (tree type, tree expr) { tree template_type = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)))); - tree template, template_addr; + tree p_array_type = TREE_TYPE (TYPE_FIELDS (type)); tree etype = TREE_TYPE (expr); + tree template; - /* If EXPR is a constant of zero, we make a fat pointer that has a null - pointer to the template and array. */ + /* If EXPR is null, make a fat pointer that contains null pointers to the + template and array. */ if (integer_zerop (expr)) return gnat_build_constructor (type, tree_cons (TYPE_FIELDS (type), - convert (TREE_TYPE (TYPE_FIELDS (type)), expr), + convert (p_array_type, expr), tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), convert (build_pointer_type (template_type), expr), NULL_TREE))); - /* If EXPR is a thin pointer, make the template and data from the record. */ - + /* If EXPR is a thin pointer, make template and data from the record.. */ else if (TYPE_THIN_POINTER_P (etype)) { tree fields = TYPE_FIELDS (TREE_TYPE (etype)); @@ -3702,30 +3909,31 @@ convert_to_fat_pointer (tree type, tree expr) build_component_ref (expr, NULL_TREE, TREE_CHAIN (fields), false)); } + + /* Otherwise, build the constructor for the template. */ else - /* Otherwise, build the constructor for the template. */ template = build_template (template_type, TREE_TYPE (etype), expr); - template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template); - - /* The result is a CONSTRUCTOR for the fat pointer. + /* The final result is a constructor for the fat pointer. - If expr is an argument of a foreign convention subprogram, the type it - points to is directly the component type. In this case, the expression + If EXPR is an argument of a foreign convention subprogram, the type it + points to is directly the component type. In this case, the expression type may not match the corresponding FIELD_DECL type at this point, so we - call "convert" here to fix that up if necessary. This type consistency is + call "convert" here to fix that up if necessary. This type consistency is required, for instance because it ensures that possible later folding of - component_refs against this constructor always yields something of the + COMPONENT_REFs against this constructor always yields something of the same type as the initial reference. - Note that the call to "build_template" above is still fine, because it - will only refer to the provided template_type in this case. */ - return - gnat_build_constructor - (type, tree_cons (TYPE_FIELDS (type), - convert (TREE_TYPE (TYPE_FIELDS (type)), expr), - tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), - template_addr, NULL_TREE))); + Note that the call to "build_template" above is still fine because it + will only refer to the provided TEMPLATE_TYPE in this case. */ + return + gnat_build_constructor + (type, + tree_cons (TYPE_FIELDS (type), + convert (p_array_type, expr), + tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), + build_unary_op (ADDR_EXPR, NULL_TREE, template), + NULL_TREE))); } /* Convert to a thin pointer type, TYPE. The only thing we know how to convert diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index 1ed1b9f9cdb..89fb5f0f419 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -986,7 +986,6 @@ build_binary_op (enum tree_code op_code, tree result_type, outputs. */ if (modulus && integer_pow2p (modulus)) modulus = NULL_TREE; - goto common; case COMPLEX_EXPR: @@ -1011,6 +1010,15 @@ build_binary_op (enum tree_code op_code, tree result_type, right_operand = convert (sizetype, right_operand); break; + case PLUS_EXPR: + case MINUS_EXPR: + /* Avoid doing arithmetics in BOOLEAN_TYPE like the other compilers. + Contrary to C, Ada doesn't allow arithmetics in Standard.Boolean + but we can generate addition or subtraction for 'Succ and 'Pred. */ + if (operation_type && TREE_CODE (operation_type) == BOOLEAN_TYPE) + operation_type = left_base_type = right_base_type = integer_type_node; + goto common; + default: common: /* The result type should be the same as the base types of the @@ -2152,8 +2160,8 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, /* Fill in a VMS descriptor for EXPR and return a constructor for it. GNAT_FORMAL is how we find the descriptor record. GNAT_ACTUAL is - how we find the allocator size which determines whether to use the - alternate 64bit descriptor. */ + how we derive the source location to raise C_E on an out of range + pointer. */ tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual) @@ -2161,43 +2169,42 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual) tree field; tree parm_decl = get_gnu_tree (gnat_formal); tree const_list = NULL_TREE; - int size; - tree record_type; - - /* A string literal will always be in 32bit space on VMS. Where - will it be on other 64bit systems??? - An identifier's allocation may be unknown at compile time. - An explicit dereference could be either in 32bit or 64bit space. - Don't know about other possibilities, so assume unknown which - will result in fetching the 64bit descriptor. ??? */ - if (Nkind (gnat_actual) == N_String_Literal) - size = 32; - else if (Nkind (gnat_actual) == N_Identifier) - size = UI_To_Int (Esize (Etype (gnat_actual))); - else if (Nkind (gnat_actual) == N_Explicit_Dereference) - size = UI_To_Int (Esize (Etype (Prefix (gnat_actual)))); - else - size = 0; - - /* If size is unknown, make it POINTER_SIZE */ - if (size == 0) - size = POINTER_SIZE; - - /* If size is 64bits grab the alternate 64bit descriptor. */ - if (size == 64) - TREE_TYPE (parm_decl) = DECL_PARM_ALT (parm_decl); + tree record_type = TREE_TYPE (TREE_TYPE (parm_decl)); + int do_range_check = + strcmp ("MBO", + IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type)))); - record_type = TREE_TYPE (TREE_TYPE (parm_decl)); expr = maybe_unconstrained_array (expr); gnat_mark_addressable (expr); for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field)) - const_list - = tree_cons (field, - convert (TREE_TYPE (field), - SUBSTITUTE_PLACEHOLDER_IN_EXPR - (DECL_INITIAL (field), expr)), - const_list); + { + tree conexpr = convert (TREE_TYPE (field), + SUBSTITUTE_PLACEHOLDER_IN_EXPR + (DECL_INITIAL (field), expr)); + + /* Check to ensure that only 32bit pointers are passed in + 32bit descriptors */ + if (do_range_check && + strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0) + { + tree pointer64type = + build_pointer_type_for_mode (void_type_node, DImode, false); + tree addr64expr = build_unary_op (ADDR_EXPR, pointer64type, expr); + tree malloc64low = + build_int_cstu (long_integer_type_node, 0x80000000); + + add_stmt (build3 (COND_EXPR, void_type_node, + build_binary_op (GE_EXPR, long_integer_type_node, + convert (long_integer_type_node, + addr64expr), + malloc64low), + build_call_raise (CE_Range_Check_Failed, gnat_actual, + N_Raise_Constraint_Error), + NULL_TREE)); + } + const_list = tree_cons (field, conexpr, const_list); + } return gnat_build_constructor (record_type, nreverse (const_list)); } diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 8c1759471ef..29c1aec6dae 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -104,7 +104,6 @@ Implementation Defined Pragmas * Pragma Assert:: * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: -* Pragma Canonical_Streams:: * Pragma Check:: * Pragma Check_Name:: * Pragma Check_Policy:: @@ -706,7 +705,6 @@ consideration, the use of these pragmas should be minimized. * Pragma Assert:: * Pragma Ast_Entry:: * Pragma C_Pass_By_Copy:: -* Pragma Canonical_Streams:: * Pragma Check:: * Pragma Check_Name:: * Pragma Check_Policy:: @@ -1059,27 +1057,6 @@ You can also pass records by copy by specifying the convention @code{Import} and @code{Export} pragmas, which allow specification of passing mechanisms on a parameter by parameter basis. -@node Pragma Canonical_Streams -@unnumberedsec Canonical Streams -@cindex Canonical streams -@findex Canonical_Streams -@noindent -Syntax: -@smallexample @c ada -pragma Canonical_Streams; -@end smallexample - -@noindent -This configuration pragma affects the behavior of stream attributes of any -@code{String}, @code{Wide_String} or @code{Wide_Wide_String} based type. When -this pragma is present, @code{'Input}, @code{'Output}, @code{'Read} and -@code{'Write} exibit Ada 95 canonical behavior, in other words, streaming of -values is done character by character. - -@noindent -The use of this pragma is intended to bypass any implementation-related -optimizations allowed by Ada 2005 RM 13.13.2 (56/2) Implementation Permission. - @node Pragma Check @unnumberedsec Pragma Check @cindex Assertions @@ -1852,6 +1829,7 @@ MECHANISM_NAME ::= Value | Reference | Descriptor [([Class =>] CLASS_NAME)] +| Short_Descriptor [([Class =>] CLASS_NAME)] CLASS_NAME ::= ubs | ubsb | uba | s | sb | a @end smallexample @@ -1884,6 +1862,9 @@ anonymous access parameter. @cindex OpenVMS @cindex Passing by descriptor Passing by descriptor is supported only on the OpenVMS ports of GNAT@. +The default behavior for Export_Function is to accept either 64bit or +32bit descriptors unless short_descriptor is specified, then only 32bit +descriptors are accepted. @cindex Suppressing external name Special treatment is given if the EXTERNAL is an explicit null @@ -1953,6 +1934,7 @@ MECHANISM_NAME ::= Value | Reference | Descriptor [([Class =>] CLASS_NAME)] +| Short_Descriptor [([Class =>] CLASS_NAME)] CLASS_NAME ::= ubs | ubsb | uba | s | sb | a @end smallexample @@ -1970,6 +1952,9 @@ pragma that specifies the desired foreign convention. @cindex OpenVMS @cindex Passing by descriptor Passing by descriptor is supported only on the OpenVMS ports of GNAT@. +The default behavior for Export_Procedure is to accept either 64bit or +32bit descriptors unless short_descriptor is specified, then only 32bit +descriptors are accepted. @cindex Suppressing external name Special treatment is given if the EXTERNAL is an explicit null @@ -2035,6 +2020,7 @@ MECHANISM_NAME ::= Value | Reference | Descriptor [([Class =>] CLASS_NAME)] +| Short_Descriptor [([Class =>] CLASS_NAME)] CLASS_NAME ::= ubs | ubsb | uba | s | sb | a @end smallexample @@ -2057,6 +2043,9 @@ pragma that specifies the desired foreign convention. @cindex OpenVMS @cindex Passing by descriptor Passing by descriptor is supported only on the OpenVMS ports of GNAT@. +The default behavior for Export_Valued_Procedure is to accept either 64bit or +32bit descriptors unless short_descriptor is specified, then only 32bit +descriptors are accepted. @cindex Suppressing external name Special treatment is given if the EXTERNAL is an explicit null @@ -2483,6 +2472,7 @@ MECHANISM_NAME ::= Value | Reference | Descriptor [([Class =>] CLASS_NAME)] +| Short_Descriptor [([Class =>] CLASS_NAME)] CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca @end smallexample @@ -2516,6 +2506,8 @@ is used. @cindex OpenVMS @cindex Passing by descriptor Passing by descriptor is supported only on the OpenVMS ports of GNAT@. +The default behavior for Import_Function is to pass a 64bit descriptor +unless short_descriptor is specified, then a 32bit descriptor is passed. @code{First_Optional_Parameter} applies only to OpenVMS ports of GNAT@. It specifies that the designated parameter and all following parameters @@ -2589,6 +2581,7 @@ MECHANISM_NAME ::= Value | Reference | Descriptor [([Class =>] CLASS_NAME)] +| Short_Descriptor [([Class =>] CLASS_NAME)] CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca @end smallexample @@ -2635,6 +2628,7 @@ MECHANISM_NAME ::= Value | Reference | Descriptor [([Class =>] CLASS_NAME)] +| Short_Descriptor [([Class =>] CLASS_NAME)] CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca @end smallexample diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index e64cebfb32e..99df83f9918 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4034,11 +4034,11 @@ details. @item -gnatq @cindex @option{-gnatq} (@command{gcc}) -Don't quit; try semantics, even if parse errors. +Don't quit. Try semantics, even if parse errors. @item -gnatQ @cindex @option{-gnatQ} (@command{gcc}) -Don't quit; generate @file{ALI} and tree files even if illegalities. +Don't quit. Generate @file{ALI} and tree files even if illegalities. @item -gnatr @cindex @option{-gnatr} (@command{gcc}) @@ -10925,7 +10925,6 @@ recognized by GNAT: Ada_2005 Assertion_Policy C_Pass_By_Copy - Canonical_Streams Check_Name Check_Policy Compile_Time_Error @@ -25509,6 +25508,7 @@ information about several specific platforms. * Linux-Specific Considerations:: * AIX-Specific Considerations:: * Irix-Specific Considerations:: +* RTX-Specific Considerations:: @end menu @node Summary of Run-Time Configurations @@ -25619,6 +25619,15 @@ information about several specific platforms. @item @code{@ @ @ @ }Tasking @tab native Win32 threads @item @code{@ @ @ @ }Exceptions @tab SJLJ @* +@item @b{x86-windows-rtx} +@item @code{@ @ }@i{rts-rtx-rtss (default)} +@item @code{@ @ @ @ }Tasking @tab RTX real-time subsystem RTSS threads (kernel mode) +@item @code{@ @ @ @ }Exceptions @tab SJLJ +@* +@item @code{@ @ }@i{rts-rtx-w32} +@item @code{@ @ @ @ }Tasking @tab RTX Win32 threads (user mode) +@item @code{@ @ @ @ }Exceptions @tab ZCX +@* @item @b{x86_64-linux} @item @code{@ @ }@i{rts-native (default)} @item @code{@ @ @ @ }Tasking @tab pthread library @@ -25843,6 +25852,26 @@ $ LD_LIBRARY_PATH=$LD_LIBRARY_PATH:`dirname \`gcc --print-file-name=libgcc_s.so @end group @end smallexample +@node RTX-Specific Considerations +@section RTX-Specific Considerations +@cindex RTX libraries + +@noindent +The Real-time Extension (RTX) to Windows is based on the Windows Win32 +API. Applications can be built to work in two different modes: + +@itemize @bullet +@item +Windows executables that run in Ring 3 to utilize memory protection +(@emph{rts-rtx-w32}). + +@item +Real-time subsystem (RTSS) executables that run in Ring 0, where +performance can be optimized with RTSS applications taking precedent +over all Windows applications (@emph{rts-rtx-rtss}). + +@end itemize + @c ******************************* @node Example of Binder Output File @appendix Example of Binder Output File diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 766a474afbf..7c17beb5802 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -63,9 +63,9 @@ procedure Gnatchop is -- Arguments used in Gnat_Cmd call EOF : constant Character := Character'Val (26); - -- Special character to signal end of file. Not required in input - -- files, but properly treated if present. Not generated in output - -- files except as a result of copying input file. + -- Special character to signal end of file. Not required in input files, + -- but properly treated if present. Not generated in output files except + -- as a result of copying input file. -------------------- -- File arguments -- @@ -152,8 +152,8 @@ procedure Gnatchop is -- Index of unit in sorted unit list Bufferg : String_Access; - -- Pointer to buffer containing configuration pragmas to be - -- prepended. Null if no pragmas to be prepended. + -- Pointer to buffer containing configuration pragmas to be prepended. + -- Null if no pragmas to be prepended. end record; -- The following table stores the unit offset information @@ -1018,9 +1018,9 @@ procedure Gnatchop is Contents := new String (1 .. Read_Ptr); Contents.all := Buffer (1 .. Read_Ptr); - -- Things aren't simple on VMS due to the plethora of file types - -- and organizations. It seems clear that there shouldn't be more - -- bytes read than are contained in the file though. + -- Things aren't simple on VMS due to the plethora of file types and + -- organizations. It seems clear that there shouldn't be more bytes + -- read than are contained in the file though. if Hostparm.OpenVMS then Success := Read_Ptr <= Length + 1; @@ -1249,7 +1249,6 @@ procedure Gnatchop is F : constant String := File.Table (File_Num).Name.all; begin - if Is_Directory (F) then Error_Msg (F & " is a directory, cannot be chopped"); return False; @@ -1277,7 +1276,6 @@ procedure Gnatchop is end if; return False; - end Scan_Arguments; ---------------- @@ -1636,11 +1634,11 @@ procedure Gnatchop is -- Returns in OS_Name the proper name for the OS when used with the -- returned Encoding value. For example on Windows this will return the -- UTF-8 encoded name into OS_Name and set Encoding to encoding=utf8 - -- (form parameter Stream_IO). + -- (the form parameter for Stream_IO). + -- -- Name is the filename and W_Name the same filename in Unicode 16 bits - -- (this corresponds to Win32 Unicode ISO/IEC 10646). N_Length and - -- E_Length are the length returned in OS_Name and Encoding - -- respectively. + -- (this corresponds to Win32 Unicode ISO/IEC 10646). N_Length/E_Length + -- are the length returned in OS_Name/Encoding respectively. Info : Unit_Info renames Unit.Table (Num); Name : aliased constant String := Info.File_Name.all & ASCII.NUL; @@ -1676,6 +1674,7 @@ procedure Gnatchop is C_Name : aliased constant String := E_Name & ASCII.NUL; OS_Encoding : constant String := Encoding (1 .. E_Length); File : Stream_IO.File_Type; + begin begin if not Overwrite_Files and then Exists (E_Name) then @@ -1685,6 +1684,7 @@ procedure Gnatchop is (File, Stream_IO.Out_File, E_Name, OS_Encoding); Success := True; end if; + exception when Stream_IO.Name_Error | Stream_IO.Use_Error => Error_Msg ("cannot create " & Info.File_Name.all); @@ -1705,7 +1705,6 @@ procedure Gnatchop is if Success and then Info.Bufferg /= null then Write_Source_Reference_Pragma (Info, 1, File, EOL, Success); - String'Write (Stream_IO.Stream (File), Info.Bufferg.all); end if; @@ -1742,10 +1741,9 @@ procedure Gnatchop is -- Start of processing for gnatchop begin - -- Add the directory where gnatchop is invoked in front of the - -- path, if gnatchop is invoked with directory information. - -- Only do this if the platform is not VMS, where the notion of path - -- does not really exist. + -- Add the directory where gnatchop is invoked in front of the path, if + -- gnatchop is invoked with directory information. Only do this if the + -- platform is not VMS, where the notion of path does not really exist. if not Hostparm.OpenVMS then declare @@ -1758,12 +1756,10 @@ begin Absolute_Dir : constant String := Normalize_Pathname (Command (Command'First .. Index)); - PATH : constant String := - Absolute_Dir & - Path_Separator & - Getenv ("PATH").all; - + Absolute_Dir + & Path_Separator + & Getenv ("PATH").all; begin Setenv ("PATH", PATH); end; @@ -1813,26 +1809,24 @@ begin Sort_Units; - -- Check if any duplicate files would be created. If so, emit - -- a warning if Overwrite_Files is true, otherwise generate an error. + -- Check if any duplicate files would be created. If so, emit a warning if + -- Overwrite_Files is true, otherwise generate an error. if Report_Duplicate_Units and then not Overwrite_Files then goto No_Files_Written; end if; - -- Check if any files exist, if so do not write anything - -- Because all files have been parsed and checked already, - -- there won't be any duplicates + -- Check if any files exist, if so do not write anything Because all files + -- have been parsed and checked already, there won't be any duplicates if not Overwrite_Files and then Files_Exist then goto No_Files_Written; end if; - -- After this point, all source files are read in succession - -- and chopped into their destination files. + -- After this point, all source files are read in succession and chopped + -- into their destination files. - -- As the Source_File_Name pragmas are handled as logical file 0, - -- write it first. + -- Source_File_Name pragmas are handled as logical file 0 so write it first for F in 1 .. File.Last loop if not Write_Chopped_Files (F) then diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb index 040a726f572..44633b9c902 100644 --- a/gcc/ada/gprep.adb +++ b/gcc/ada/gprep.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -475,6 +475,9 @@ package body GPrep is procedure Process_One_File is Infile : Source_File_Index; + Modified : Boolean; + pragma Warnings (Off, Modified); + begin -- Create the output file (fails if this does not work) @@ -515,7 +518,7 @@ package body GPrep is -- Preprocess the input file - Prep.Preprocess; + Prep.Preprocess (Modified); -- In verbose mode, if there is no error, report it diff --git a/gcc/ada/i-cobol.adb b/gcc/ada/i-cobol.adb index f9f696b9eee..3b46385ada2 100644 --- a/gcc/ada/i-cobol.adb +++ b/gcc/ada/i-cobol.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -337,7 +337,7 @@ package body Interfaces.COBOL is -- Here a swap is needed declare - Len : constant Natural := B'Length; + Len : constant Natural := B'Length; begin for J in 1 .. Len / 2 loop @@ -452,10 +452,15 @@ package body Interfaces.COBOL is -- Used for the nonseparate formats to embed the appropriate sign -- at the specified location (i.e. at Result (Loc)) + ------------- + -- Convert -- + ------------- + procedure Convert (First, Last : Natural) is - J : Natural := Last; + J : Natural; begin + J := Last; while J >= First loop Result (J) := COBOL_Character'Val @@ -478,6 +483,10 @@ package body Interfaces.COBOL is raise Conversion_Error; end Convert; + ---------------- + -- Embed_Sign -- + ---------------- + procedure Embed_Sign (Loc : Natural) is Digit : Natural range 0 .. 9; @@ -559,6 +568,10 @@ package body Interfaces.COBOL is -- storing the result in Result (First .. Last). Raise Conversion_Error -- if the value is too large to fit. + ------------- + -- Convert -- + ------------- + procedure Convert (First, Last : Natural) is J : Natural := Last; diff --git a/gcc/ada/ioexcept.ads b/gcc/ada/ioexcept.ads index 0473ff32bdf..efdadc713c9 100644 --- a/gcc/ada/ioexcept.ads +++ b/gcc/ada/ioexcept.ads @@ -15,9 +15,9 @@ pragma Ada_2005; -- Explicit setting of Ada 2005 mode is required here, since we want to with a --- child unit (not possible in Ada 83 mode), and Text_IO is not considered to --- be an internal unit that is automatically compiled in Ada 2005 mode (since --- a user is allowed to redeclare IO_Exceptions). +-- child unit (not possible in Ada 83 mode), and IO_Exceptions is not +-- considered to be an internal unit that is automatically compiled in Ada +-- 2005 mode (since a user is allowed to redeclare IO_Exceptions). with Ada.IO_Exceptions; diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index c6dec0aa379..d4dcd3cb201 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -83,16 +83,16 @@ package body Layout is Left_Opnd : Node_Id; Right_Opnd : Node_Id) return Node_Id; -- This is like Make_Op_Multiply except that it optimizes some cases - -- knowing that associative rearrangement is allowed for constant - -- folding if one of the operands is a compile time known value + -- knowing that associative rearrangement is allowed for constant folding + -- if one of the operands is a compile time known value function Assoc_Subtract (Loc : Source_Ptr; Left_Opnd : Node_Id; Right_Opnd : Node_Id) return Node_Id; -- This is like Make_Op_Subtract except that it optimizes some cases - -- knowing that associative rearrangement is allowed for constant - -- folding if one of the operands is a compile time known value + -- knowing that associative rearrangement is allowed for constant folding + -- if one of the operands is a compile time known value function Bits_To_SU (N : Node_Id) return Node_Id; -- This is used when we cross the boundary from static sizes in bits to @@ -159,21 +159,20 @@ package body Layout is -- Front-end layout of record type procedure Rewrite_Integer (N : Node_Id; V : Uint); - -- Rewrite node N with an integer literal whose value is V. The Sloc - -- for the new node is taken from N, and the type of the literal is - -- set to a copy of the type of N on entry. + -- Rewrite node N with an integer literal whose value is V. The Sloc for + -- the new node is taken from N, and the type of the literal is set to a + -- copy of the type of N on entry. procedure Set_And_Check_Static_Size (E : Entity_Id; Esiz : SO_Ref; RM_Siz : SO_Ref); - -- This procedure is called to check explicit given sizes (possibly - -- stored in the Esize and RM_Size fields of E) against computed - -- Object_Size (Esiz) and Value_Size (RM_Siz) values. Appropriate - -- errors and warnings are posted if specified sizes are inconsistent - -- with specified sizes. On return, the Esize and RM_Size fields of - -- E are set (either from previously given values, or from the newly - -- computed values, as appropriate). + -- This procedure is called to check explicit given sizes (possibly stored + -- in the Esize and RM_Size fields of E) against computed Object_Size + -- (Esiz) and Value_Size (RM_Siz) values. Appropriate errors and warnings + -- are posted if specified sizes are inconsistent with specified sizes. On + -- return, Esize and RM_Size fields of E are set (either from previously + -- given values, or from the newly computed values, as appropriate). procedure Set_Composite_Alignment (E : Entity_Id); -- This procedure is called for record types and subtypes, and also for @@ -200,8 +199,8 @@ package body Layout is -- which must be obeyed. If so, we cannot increase the size in this -- routine. - -- For a type, the issue is whether an object size clause has been - -- set. A normal size clause constrains only the value size (RM_Size) + -- For a type, the issue is whether an object size clause has been set. + -- A normal size clause constrains only the value size (RM_Size) if Is_Type (E) then Esize_Set := Has_Object_Size_Clause (E); @@ -247,14 +246,14 @@ package body Layout is return; end if; - -- Here we have a situation where the Esize is not a multiple of - -- the alignment. We must either increase Esize or reduce the - -- alignment to correct this situation. + -- Here we have a situation where the Esize is not a multiple of the + -- alignment. We must either increase Esize or reduce the alignment to + -- correct this situation. -- The case in which we can decrease the alignment is where the -- alignment was not set by an alignment clause, and the type in - -- question is a discrete type, where it is definitely safe to - -- reduce the alignment. For example: + -- question is a discrete type, where it is definitely safe to reduce + -- the alignment. For example: -- t : integer range 1 .. 2; -- for t'size use 8; @@ -275,8 +274,8 @@ package body Layout is return; end if; - -- Now the only possible approach left is to increase the Esize - -- but we can't do that if the size was set by a specific clause. + -- Now the only possible approach left is to increase the Esize but we + -- can't do that if the size was set by a specific clause. if Esize_Set then Error_Msg_NE @@ -606,9 +605,10 @@ package body Layout is Ent := Get_Dynamic_SO_Entity (D); if Is_Discrim_SO_Function (Ent) then - -- If a component is passed in whose type matches the type - -- of the function formal, then select that component from - -- the "V" parameter rather than passing "V" directly. + + -- If a component is passed in whose type matches the type of + -- the function formal, then select that component from the "V" + -- parameter rather than passing "V" directly. if Present (Comp) and then Base_Type (Etype (Comp)) @@ -661,18 +661,18 @@ package body Layout is when Dynamic => Nod : Node_Id; end case; end record; - -- Shows the status of the value so far. Const means that the value - -- is constant, and Val is the current constant value. Dynamic means - -- that the value is dynamic, and in this case Nod is the Node_Id of - -- the expression to compute the value. + -- Shows the status of the value so far. Const means that the value is + -- constant, and Val is the current constant value. Dynamic means that + -- the value is dynamic, and in this case Nod is the Node_Id of the + -- expression to compute the value. Size : Val_Type; -- Calculated value so far if Size.Status = Const, -- or expression value so far if Size.Status = Dynamic. SU_Convert_Required : Boolean := False; - -- This is set to True if the final result must be converted from - -- bits to storage units (rounding up to a storage unit boundary). + -- This is set to True if the final result must be converted from bits + -- to storage units (rounding up to a storage unit boundary). ----------------------- -- Local Subprograms -- @@ -799,9 +799,9 @@ package body Layout is (Dynamic, Make_Integer_Literal (Loc, Size.Val / SSU)); SU_Convert_Required := False; - -- Otherwise, we go ahead and convert the value in bits, - -- and set SU_Convert_Required to True to ensure that the - -- final value is indeed properly converted. + -- Otherwise, we go ahead and convert the value in bits, and + -- set SU_Convert_Required to True to ensure that the final + -- value is indeed properly converted. else Size := (Dynamic, Make_Integer_Literal (Loc, Size.Val)); @@ -827,8 +827,8 @@ package body Layout is Len := Convert_To (Standard_Unsigned, Len); - -- If we cannot verify that range cannot be super-flat, - -- we need a max with zero, since length must be non-neg. + -- If we cannot verify that range cannot be super-flat, we need + -- a max with zero, since length must be non-negative. if not OK or else LLo < 0 then Len := @@ -846,8 +846,8 @@ package body Layout is Next_Index (Indx); end loop; - -- Here after processing all bounds to set sizes. If the value is - -- a constant, then it is bits, so we convert to storage units. + -- Here after processing all bounds to set sizes. If the value is a + -- constant, then it is bits, so we convert to storage units. if Size.Status = Const then return Bits_To_SU (Make_Integer_Literal (Loc, Size.Val)); @@ -900,10 +900,10 @@ package body Layout is -- How An Array Type is Laid Out -- ------------------------------------ - -- Here is what goes on. We need to multiply the component size of - -- the array (which has already been set) by the length of each of - -- the indexes. If all these values are known at compile time, then - -- the resulting size of the array is the appropriate constant value. + -- Here is what goes on. We need to multiply the component size of the + -- array (which has already been set) by the length of each of the + -- indexes. If all these values are known at compile time, then the + -- resulting size of the array is the appropriate constant value. -- If the component size or at least one bound is dynamic (but no -- discriminants are present), then the size will be computed as an @@ -941,8 +941,8 @@ package body Layout is -- Value of size computed so far. See comments above Vtyp : Entity_Id := Empty; - -- Variant record type for the formal parameter of the - -- discriminant function V if Status = Discrim. + -- Variant record type for the formal parameter of the discriminant + -- function V if Status = Discrim. SU_Convert_Required : Boolean := False; -- This is set to True if the final result must be converted from @@ -1064,7 +1064,7 @@ package body Layout is while Present (Indx) loop Ityp := Etype (Indx); - -- If an index of the array is a generic formal type then there's + -- If an index of the array is a generic formal type then there is -- no point in determining a size for the array type. if Is_Generic_Type (Ityp) then @@ -1139,18 +1139,18 @@ package body Layout is (Dynamic, Make_Integer_Literal (Loc, Size.Val / SSU)); SU_Convert_Required := False; - -- If the current value is a factor of the storage unit, - -- then we can use a value of one for the size and reduce - -- the strength of the later division. + -- If the current value is a factor of the storage unit, then + -- we can use a value of one for the size and reduce the + -- strength of the later division. elsif SSU mod Size.Val = 0 then Storage_Divisor := SSU / Size.Val; Size := (Dynamic, Make_Integer_Literal (Loc, Uint_1)); SU_Convert_Required := True; - -- Otherwise, we go ahead and convert the value in bits, - -- and set SU_Convert_Required to True to ensure that the - -- final value is indeed properly converted. + -- Otherwise, we go ahead and convert the value in bits, and + -- set SU_Convert_Required to True to ensure that the final + -- value is indeed properly converted. else Size := (Dynamic, Make_Integer_Literal (Loc, Size.Val)); @@ -1165,8 +1165,8 @@ package body Layout is Len := Compute_Length (Lo, Hi); - -- If Len isn't a Length attribute, then its range needs to - -- be checked a possible Max with zero needs to be computed. + -- If Len isn't a Length attribute, then its range needs to be + -- checked a possible Max with zero needs to be computed. if Nkind (Len) /= N_Attribute_Reference or else Attribute_Name (Len) /= Name_Length @@ -1193,9 +1193,8 @@ package body Layout is return; end if; - -- If we cannot verify that range cannot be super-flat, - -- we need a maximum with zero, since length cannot be - -- negative. + -- If we cannot verify that range cannot be super-flat, we + -- need a max with zero, since length cannot be negative. if not OK or else LLo < 0 then Len := @@ -1221,9 +1220,9 @@ package body Layout is Next_Index (Indx); end loop; - -- Here after processing all bounds to set sizes. If the value is - -- a constant, then it is bits, and the only thing we need to do - -- is to check against explicit given size and do alignment adjust. + -- Here after processing all bounds to set sizes. If the value is a + -- constant, then it is bits, and the only thing we need to do is to + -- check against explicit given size and do alignment adjust. if Size.Status = Const then Set_And_Check_Static_Size (E, Size.Val, Size.Val); @@ -1303,8 +1302,8 @@ package body Layout is return; end if; - -- Set size if not set for object and known for type. Use the - -- RM_Size if that is known for the type and Esize is not. + -- Set size if not set for object and known for type. Use the RM_Size if + -- that is known for the type and Esize is not. if Unknown_Esize (E) then if Known_Esize (T) then @@ -1325,9 +1324,9 @@ package body Layout is Adjust_Esize_Alignment (E); - -- Final adjustment, if we don't know the alignment, and the Esize - -- was not set by an explicit Object_Size attribute clause, then - -- we reset the Esize to unknown, since we really don't know it. + -- Final adjustment, if we don't know the alignment, and the Esize was + -- not set by an explicit Object_Size attribute clause, then we reset + -- the Esize to unknown, since we really don't know it. if Unknown_Alignment (E) and then not Has_Size_Clause (E) @@ -1505,8 +1504,8 @@ package body Layout is New_Fbit := (New_Fbit + SSU - 1) / SSU * SSU; end if; - -- If old normalized position is static, we can go ahead - -- and compute the new normalized position directly. + -- If old normalized position is static, we can go ahead and + -- compute the new normalized position directly. if Known_Static_Normalized_Position (Prev_Comp) then New_Npos := Old_Npos; @@ -1619,11 +1618,11 @@ package body Layout is return; end if; - -- Check case of type of component has a scope of the record we - -- are laying out. When this happens, the type in question is an - -- Itype that has not yet been laid out (that's because such - -- types do not get frozen in the normal manner, because there - -- is no place for the freeze nodes). + -- Check case of type of component has a scope of the record we are + -- laying out. When this happens, the type in question is an Itype + -- that has not yet been laid out (that's because such types do not + -- get frozen in the normal manner, because there is no place for + -- the freeze nodes). if Scope (Ctyp) = E then Layout_Type (Ctyp); @@ -1636,9 +1635,8 @@ package body Layout is end if; -- Set size of component from type. We use the Esize except in a - -- packed record, where we use the RM_Size (since that is exactly - -- what the RM_Size value, as distinct from the Object_Size is - -- useful for!) + -- packed record, where we use the RM_Size (since that is what the + -- RM_Size value, as distinct from the Object_Size is useful for!) if Is_Packed (E) then Set_Esize (Comp, RM_Size (Ctyp)); @@ -1915,10 +1913,10 @@ package body Layout is RM_Siz_Expr : Node_Id := Empty; -- Expression for the evolving RM_Siz value. This is typically a - -- conditional expression which involves tests of discriminant - -- values that are formed as references to the entity V. At - -- the end of scanning all the components, a suitable function - -- is constructed in which V is the parameter. + -- conditional expression which involves tests of discriminant values + -- that are formed as references to the entity V. At the end of + -- scanning all the components, a suitable function is constructed + -- in which V is the parameter. ----------------------- -- Local Subprograms -- @@ -1928,14 +1926,14 @@ package body Layout is (Clist : Node_Id; Esiz : out SO_Ref; RM_Siz_Expr : out Node_Id); - -- Recursive procedure, called to lay out one component list - -- Esiz and RM_Siz_Expr are set to the Object_Size and Value_Size - -- values respectively representing the record size up to and - -- including the last component in the component list (including - -- any variants in this component list). RM_Siz_Expr is returned - -- as an expression which may in the general case involve some - -- references to the discriminants of the current record value, - -- referenced by selecting from the entity V. + -- Recursive procedure, called to lay out one component list Esiz + -- and RM_Siz_Expr are set to the Object_Size and Value_Size values + -- respectively representing the record size up to and including the + -- last component in the component list (including any variants in + -- this component list). RM_Siz_Expr is returned as an expression + -- which may in the general case involve some references to the + -- discriminants of the current record value, referenced by selecting + -- from the entity V. --------------------------- -- Layout_Component_List -- @@ -1982,9 +1980,9 @@ package body Layout is else RMS_Ent := Get_Dynamic_SO_Entity (RM_Siz); - -- If the size is represented by a function, then we - -- create an appropriate function call using V as - -- the parameter to the call. + -- If the size is represented by a function, then we create + -- an appropriate function call using V as the parameter to + -- the call. if Is_Discrim_SO_Function (RMS_Ent) then RM_Siz_Expr := @@ -2080,9 +2078,9 @@ package body Layout is -- individual variants, and xxDx are the discriminant -- checking functions generated for the variant type. - -- If this is the first variant, we simply set the - -- result as the expression. Note that this takes - -- care of the others case. + -- If this is the first variant, we simply set the result + -- as the expression. Note that this takes care of the + -- others case. if No (RM_Siz_Expr) then RM_Siz_Expr := Bits_To_SU (RM_SizV); @@ -2236,17 +2234,17 @@ package body Layout is -- All other cases else - -- Initialize alignment conservatively to 1. This value will - -- be increased as necessary during processing of the record. + -- Initialize alignment conservatively to 1. This value will be + -- increased as necessary during processing of the record. if Unknown_Alignment (E) then Set_Alignment (E, Uint_1); end if; - -- Initialize previous component. This is Empty unless there - -- are components which have already been laid out by component - -- clauses. If there are such components, we start our lay out of - -- the remaining components following the last such component. + -- Initialize previous component. This is Empty unless there are + -- components which have already been laid out by component clauses. + -- If there are such components, we start our lay out of the + -- remaining components following the last such component. Prev_Comp := Empty; @@ -2303,8 +2301,8 @@ package body Layout is Desig_Type : Entity_Id; begin - -- For string literal types, for now, kill the size always, this - -- is because gigi does not like or need the size to be set ??? + -- For string literal types, for now, kill the size always, this is + -- because gigi does not like or need the size to be set ??? if Ekind (E) = E_String_Literal_Subtype then Set_Esize (E, Uint_0); @@ -2312,14 +2310,14 @@ package body Layout is return; end if; - -- For access types, set size/alignment. This is system address - -- size, except for fat pointers (unconstrained array access types), - -- where the size is two times the address size, to accommodate the - -- two pointers that are required for a fat pointer (data and - -- template). Note that E_Access_Protected_Subprogram_Type is not - -- an access type for this purpose since it is not a pointer but is - -- equivalent to a record. For access subtypes, copy the size from - -- the base type since Gigi represents them the same way. + -- For access types, set size/alignment. This is system address size, + -- except for fat pointers (unconstrained array access types), where the + -- size is two times the address size, to accommodate the two pointers + -- that are required for a fat pointer (data and template). Note that + -- E_Access_Protected_Subprogram_Type is not an access type for this + -- purpose since it is not a pointer but is equivalent to a record. For + -- access subtypes, copy the size from the base type since Gigi + -- represents them the same way. if Is_Access_Type (E) then @@ -2335,15 +2333,15 @@ package body Layout is Desig_Type := Non_Limited_View (Designated_Type (E)); end if; - -- If Esize already set (e.g. by a size clause), then nothing - -- further to be done here. + -- If Esize already set (e.g. by a size clause), then nothing further + -- to be done here. if Known_Esize (E) then null; - -- Access to subprogram is a strange beast, and we let the - -- backend figure out what is needed (it may be some kind - -- of fat pointer, including the static link for example. + -- Access to subprogram is a strange beast, and we let the backend + -- figure out what is needed (it may be some kind of fat pointer, + -- including the static link for example. elsif Is_Access_Protected_Subprogram_Type (E) then null; @@ -2354,9 +2352,9 @@ package body Layout is Set_Size_Info (E, Base_Type (E)); Set_RM_Size (E, RM_Size (Base_Type (E))); - -- For other access types, we use either address size, or, if - -- a fat pointer is used (pointer-to-unconstrained array case), - -- twice the address size to accommodate a fat pointer. + -- For other access types, we use either address size, or, if a fat + -- pointer is used (pointer-to-unconstrained array case), twice the + -- address size to accommodate a fat pointer. elsif Present (Desig_Type) and then Is_Array_Type (Desig_Type) @@ -2378,9 +2376,9 @@ package body Layout is ("?this access type does not correspond to C pointer", E); end if; - -- If the designated type is a limited view it is unanalyzed. We - -- can examine the declaration itself to determine whether it will - -- need a fat pointer. + -- If the designated type is a limited view it is unanalyzed. We can + -- examine the declaration itself to determine whether it will need a + -- fat pointer. elsif Present (Desig_Type) and then Present (Parent (Desig_Type)) @@ -2392,9 +2390,9 @@ package body Layout is Init_Size (E, 2 * System_Address_Size); -- When the target is AAMP, access-to-subprogram types are fat - -- pointers consisting of the subprogram address and a static - -- link (with the exception of library-level access types, - -- where a simple subprogram address is used). + -- pointers consisting of the subprogram address and a static link + -- (with the exception of library-level access types, where a simple + -- subprogram address is used). elsif AAMP_On_Target and then @@ -2411,15 +2409,14 @@ package body Layout is -- On VMS, reset size to 32 for convention C access type if no -- explicit size clause is given and the default size is 64. Really -- we do not know the size, since depending on options for the VMS - -- compiler, the size of a pointer type can be 32 or 64, but - -- choosing 32 as the default improves compatibility with legacy - -- VMS code. + -- compiler, the size of a pointer type can be 32 or 64, but choosing + -- 32 as the default improves compatibility with legacy VMS code. -- Note: we do not use Has_Size_Clause in the test below, because we - -- want to catch the case of a derived type inheriting a size - -- clause. We want to consider this to be an explicit size clause - -- for this purpose, since it would be weird not to inherit the size - -- in this case. + -- want to catch the case of a derived type inheriting a size clause. + -- We want to consider this to be an explicit size clause for this + -- purpose, since it would be weird not to inherit the size in this + -- case. -- We do NOT do this if we are in -gnatdm mode on a non-VMS target -- since in that case we want the normal pointer representation. @@ -2440,12 +2437,11 @@ package body Layout is elsif Is_Scalar_Type (E) then - -- For discrete types, the RM_Size and Esize must be set - -- already, since this is part of the earlier processing - -- and the front end is always required to lay out the - -- sizes of such types (since they are available as static - -- attributes). All we do is to check that this rule is - -- indeed obeyed! + -- For discrete types, the RM_Size and Esize must be set already, + -- since this is part of the earlier processing and the front end is + -- always required to lay out the sizes of such types (since they are + -- available as static attributes). All we do is to check that this + -- rule is indeed obeyed! if Is_Discrete_Type (E) then @@ -2472,10 +2468,10 @@ package body Layout is Init_Esize (E, S); exit; - -- If the RM_Size is greater than 64 (happens only - -- when strange values are specified by the user, - -- then Esize is simply a copy of RM_Size, it will - -- be further refined later on) + -- If the RM_Size is greater than 64 (happens only when + -- strange values are specified by the user, then Esize + -- is simply a copy of RM_Size, it will be further + -- refined later on) elsif S = 64 then Set_Esize (E, RM_Size (E)); @@ -2490,8 +2486,8 @@ package body Layout is end; end if; - -- For non-discrete scalar types, if the RM_Size is not set, - -- then set it now to a copy of the Esize if the Esize is set. + -- For non-discrete scalar types, if the RM_Size is not set, then set + -- it now to a copy of the Esize if the Esize is set. else if Known_Esize (E) and then Unknown_RM_Size (E) then @@ -2508,8 +2504,8 @@ package body Layout is if Known_RM_Size (E) and then Unknown_Esize (E) then - -- If the alignment is known, we bump the Esize up to the - -- next alignment boundary if it is not already on one. + -- If the alignment is known, we bump the Esize up to the next + -- alignment boundary if it is not already on one. if Known_Alignment (E) then declare @@ -2520,18 +2516,17 @@ package body Layout is end; end if; - -- If Esize is set, and RM_Size is not, RM_Size is copied from - -- Esize at least for now this seems reasonable, and is in any - -- case needed for compatibility with old versions of gigi. - -- look to be unknown. + -- If Esize is set, and RM_Size is not, RM_Size is copied from Esize. + -- At least for now this seems reasonable, and is in any case needed + -- for compatibility with old versions of gigi. elsif Known_Esize (E) and then Unknown_RM_Size (E) then Set_RM_Size (E, Esize (E)); end if; - -- For array base types, set component size if object size of - -- the component type is known and is a small power of 2 (8, - -- 16, 32, 64), since this is what will always be used. + -- For array base types, set component size if object size of the + -- component type is known and is a small power of 2 (8, 16, 32, 64), + -- since this is what will always be used. if Ekind (E) = E_Array_Type and then Unknown_Component_Size (E) @@ -2540,8 +2535,8 @@ package body Layout is CT : constant Entity_Id := Component_Type (E); begin - -- For some reasons, access types can cause trouble, - -- So let's just do this for discrete types ??? + -- For some reasons, access types can cause trouble, So let's + -- just do this for discrete types ??? if Present (CT) and then Is_Discrete_Type (CT) @@ -2646,9 +2641,9 @@ package body Layout is begin Set_Esize (E, RM_Size (E)); - -- For scalar types, increase Object_Size to power of 2, - -- but not less than a storage unit in any case (i.e., - -- normally this means it will be storage-unit addressable). + -- For scalar types, increase Object_Size to power of 2, but + -- not less than a storage unit in any case (i.e., normally + -- this means it will be storage-unit addressable). if Is_Scalar_Type (E) then if Size <= System_Storage_Unit then @@ -2700,16 +2695,15 @@ package body Layout is SC : Node_Id; procedure Check_Size_Too_Small (Spec : Uint; Min : Uint); - -- Spec is the number of bit specified in the size clause, and - -- Min is the minimum computed size. An error is given that the - -- specified size is too small if Spec < Min, and in this case - -- both Esize and RM_Size are set to unknown in E. The error - -- message is posted on node SC. + -- Spec is the number of bit specified in the size clause, and Min is + -- the minimum computed size. An error is given that the specified size + -- is too small if Spec < Min, and in this case both Esize and RM_Size + -- are set to unknown in E. The error message is posted on node SC. procedure Check_Unused_Bits (Spec : Uint; Max : Uint); - -- Spec is the number of bits specified in the size clause, and - -- Max is the maximum computed size. A warning is given about - -- unused bits if Spec > Max. This warning is posted on node SC. + -- Spec is the number of bits specified in the size clause, and Max is + -- the maximum computed size. A warning is given about unused bits if + -- Spec > Max. This warning is posted on node SC. -------------------------- -- Check_Size_Too_Small -- @@ -2758,10 +2752,10 @@ package body Layout is end if; end if; - -- Case where Value_Size (RM_Size) is set by specific Value_Size - -- clause (we do not need to worry about Value_Size being set by - -- a Size clause, since that will have set Esize as well, and we - -- already took care of that case). + -- Case where Value_Size (RM_Size) is set by specific Value_Size clause + -- (we do not need to worry about Value_Size being set by a Size clause, + -- since that will have set Esize as well, and we already took care of + -- that case). if Known_Static_RM_Size (E) then SC := Get_Attribute_Definition_Clause (E, Attribute_Value_Size); @@ -2949,8 +2943,8 @@ package body Layout is end if; end if; - -- Set chosen alignment, and increase Esize if necessary to match - -- the chosen alignment. + -- Set chosen alignment, and increase Esize if necessary to match the + -- chosen alignment. Set_Alignment (E, UI_From_Int (Align)); @@ -2969,21 +2963,21 @@ package body Layout is FST : constant Entity_Id := First_Subtype (Def_Id); begin - -- All discrete types except for the base types in standard - -- are constrained, so indicate this by setting Is_Constrained. + -- All discrete types except for the base types in standard are + -- constrained, so indicate this by setting Is_Constrained. Set_Is_Constrained (Def_Id); - -- We set generic types to have an unknown size, since the - -- representation of a generic type is irrelevant, in view - -- of the fact that they have nothing to do with code. + -- Set generic types to have an unknown size, since the representation + -- of a generic type is irrelevant, in view of the fact that they have + -- nothing to do with code. if Is_Generic_Type (Root_Type (FST)) then Set_RM_Size (Def_Id, Uint_0); - -- If the subtype statically matches the first subtype, then - -- it is required to have exactly the same layout. This is - -- required by aliasing considerations. + -- If the subtype statically matches the first subtype, then it is + -- required to have exactly the same layout. This is required by + -- aliasing considerations. elsif Def_Id /= FST and then Subtypes_Statically_Match (Def_Id, FST) @@ -2991,9 +2985,9 @@ package body Layout is Set_RM_Size (Def_Id, RM_Size (FST)); Set_Size_Info (Def_Id, FST); - -- In all other cases the RM_Size is set to the minimum size. - -- Note that this routine is never called for subtypes for which - -- the RM_Size is set explicitly by an attribute clause. + -- In all other cases the RM_Size is set to the minimum size. Note that + -- this routine is never called for subtypes for which the RM_Size is + -- set explicitly by an attribute clause. else Set_RM_Size (Def_Id, UI_From_Int (Minimum_Size (Def_Id))); @@ -3033,9 +3027,9 @@ package body Layout is return; end if; - -- Here we calculate the alignment as the largest power of two - -- multiple of System.Storage_Unit that does not exceed either - -- the actual size of the type, or the maximum allowed alignment. + -- Here we calculate the alignment as the largest power of two multiple + -- of System.Storage_Unit that does not exceed either the actual size of + -- the type, or the maximum allowed alignment. declare S : constant Int := @@ -3050,18 +3044,18 @@ package body Layout is A := 2 * A; end loop; - -- Now we think we should set the alignment to A, but we - -- skip this if an alignment is already set to a value - -- greater than A (happens for derived types). + -- Now we think we should set the alignment to A, but we skip this if + -- an alignment is already set to a value greater than A (happens for + -- derived types). - -- However, if the alignment is known and too small it - -- must be increased, this happens in a case like: + -- However, if the alignment is known and too small it must be + -- increased, this happens in a case like: -- type R is new Character; -- for R'Size use 16; - -- Here the alignment inherited from Character is 1, but - -- it must be increased to 2 to reflect the increased size. + -- Here the alignment inherited from Character is 1, but it must be + -- increased to 2 to reflect the increased size. if Unknown_Alignment (E) or else Alignment (E) < A then Init_Alignment (E, A); @@ -3170,8 +3164,8 @@ package body Layout is Make_Simple_Return_Statement (Loc, Expression => Expr)))); - -- The caller requests that the expression be encapsulated in - -- a parameterless function. + -- The caller requests that the expression be encapsulated in a + -- parameterless function. elsif Make_Func then Decl := diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 8af553fef59..2ab83c53aa8 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1834,7 +1834,11 @@ package body Lib.Xref is Par : Node_Id; begin - if Ekind (Scope (E)) /= E_Generic_Package then + -- The Present check here is an error defense + + if Present (Scope (E)) + and then Ekind (Scope (E)) /= E_Generic_Package + then return False; end if; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 7d055096832..13156357dc0 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1865,7 +1865,7 @@ package body Make is ALI := No_ALI_Id; Verbose_Msg - (Unit_Name, " sources does not include ", + (Unit_Name, " sources do not include ", Name_Id (WR.Sfile)); return; diff --git a/gcc/ada/mlib-tgt-specific-vms-alpha.adb b/gcc/ada/mlib-tgt-specific-vms-alpha.adb index 291293607f9..f272307b935 100644 --- a/gcc/ada/mlib-tgt-specific-vms-alpha.adb +++ b/gcc/ada/mlib-tgt-specific-vms-alpha.adb @@ -276,12 +276,26 @@ package body MLib.Tgt.Specific is -- Create and write the auto-init assembly file declare - First_Line : constant String := - ASCII.HT & ".section LIB$INITIALIZE,GBL,NOWRT" & - ASCII.LF; - Second_Line : constant String := - ASCII.HT & ".long " & Init_Proc & ASCII.LF; - -- First and second lines of the auto-init assembly file + use ASCII; + + -- Output a dummy transfer address for debugging + -- followed by the LIB$INITIALIZE section. + + Lines : constant String := + HT & ".text" & LF & + HT & ".align 4" & LF & + HT & ".globl __main" & LF & + HT & ".ent __main" & LF & + "__main..en:" & LF & + HT & ".base $27" & LF & + HT & ".frame $29,0,$26,8" & LF & + HT & "ret $31,($26),1" & LF & + HT & ".link" & LF & + "__main:" & LF & + HT & ".pdesc __main..en,null" & LF & + HT & ".end __main" & LF & LF & + HT & ".section LIB$INITIALIZE,GBL,NOWRT" & LF & + HT & ".long " & Init_Proc & LF; begin Macro_File := Create_File (Macro_File_Name, Text); @@ -289,16 +303,9 @@ package body MLib.Tgt.Specific is if OK then Len := Write - (Macro_File, First_Line (First_Line'First)'Address, - First_Line'Length); - OK := Len = First_Line'Length; - end if; - - if OK then - Len := Write - (Macro_File, Second_Line (Second_Line'First)'Address, - Second_Line'Length); - OK := Len = Second_Line'Length; + (Macro_File, Lines (Lines'First)'Address, + Lines'Length); + OK := Len = Lines'Length; end if; if OK then diff --git a/gcc/ada/mlib-tgt-specific-vms-ia64.adb b/gcc/ada/mlib-tgt-specific-vms-ia64.adb index baa8ce213f1..ed483876be4 100644 --- a/gcc/ada/mlib-tgt-specific-vms-ia64.adb +++ b/gcc/ada/mlib-tgt-specific-vms-ia64.adb @@ -275,26 +275,30 @@ package body MLib.Tgt.Specific is -- Create and write the auto-init assembly file declare - First_Line : constant String := - ASCII.HT - & ".type " & Init_Proc & "#, @function" - & ASCII.LF; - Second_Line : constant String := - ASCII.HT - & ".global " & Init_Proc & "#" - & ASCII.LF; - Third_Line : constant String := - ASCII.HT - & ".global LIB$INITIALIZE#" - & ASCII.LF; - Fourth_Line : constant String := - ASCII.HT - & ".section LIB$INITIALIZE#,""a"",@progbits" - & ASCII.LF; - Fifth_Line : constant String := - ASCII.HT - & "data4 @fptr(" & Init_Proc & "#)" - & ASCII.LF; + use ASCII; + + -- Output a dummy transfer address for debugging + -- followed by the LIB$INITIALIZE section. + + Lines : constant String := + HT & ".pred.safe_across_calls p1-p5,p16-p63" & LF & + HT & ".text" & LF & + HT & ".align 16" & LF & + HT & ".global __main#" & LF & + HT & ".proc __main#" & LF & + "__main:" & LF & + HT & ".prologue" & LF & + HT & ".body" & LF & + HT & ".mib" & LF & + HT & "nop 0" & LF & + HT & "nop 0" & LF & + HT & "br.ret.sptk.many b0" & LF & + HT & ".endp __main#" & LF & LF & + HT & ".type " & Init_Proc & "#, @function" & LF & + HT & ".global " & Init_Proc & "#" & LF & + HT & ".global LIB$INITIALIZE#" & LF & + HT & ".section LIB$INITIALIZE#,""a"",@progbits" & LF & + HT & "data4 @fptr(" & Init_Proc & "#)" & LF; begin Macro_File := Create_File (Macro_File_Name, Text); @@ -302,37 +306,9 @@ package body MLib.Tgt.Specific is if OK then Len := Write - (Macro_File, First_Line (First_Line'First)'Address, - First_Line'Length); - OK := Len = First_Line'Length; - end if; - - if OK then - Len := Write - (Macro_File, Second_Line (Second_Line'First)'Address, - Second_Line'Length); - OK := Len = Second_Line'Length; - end if; - - if OK then - Len := Write - (Macro_File, Third_Line (Third_Line'First)'Address, - Third_Line'Length); - OK := Len = Third_Line'Length; - end if; - - if OK then - Len := Write - (Macro_File, Fourth_Line (Fourth_Line'First)'Address, - Fourth_Line'Length); - OK := Len = Fourth_Line'Length; - end if; - - if OK then - Len := Write - (Macro_File, Fifth_Line (Fifth_Line'First)'Address, - Fifth_Line'Length); - OK := Len = Fifth_Line'Length; + (Macro_File, Lines (Lines'First)'Address, + Lines'Length); + OK := Len = Lines'Length; end if; if OK then diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb index 4d15ad85cf3..76e7db5332b 100644 --- a/gcc/ada/mlib-utl.adb +++ b/gcc/ada/mlib-utl.adb @@ -35,6 +35,10 @@ with System; package body MLib.Utl is + Adalib_Path : String_Access := null; + -- Path of the GNAT adalib directory, specified in procedure + -- Specify_Adalib_Dir. Used in function Lib_Directory. + Gcc_Name : String_Access; -- Default value of the "gcc" executable used in procedure Gcc @@ -597,6 +601,13 @@ package body MLib.Utl is Libgnat : constant String := Tgt.Libgnat; begin + -- If procedure Specify_Adalib_Dir has been called, used the specified + -- value. + + if Adalib_Path /= null then + return Adalib_Path.all; + end if; + Name_Len := Libgnat'Length; Name_Buffer (1 .. Name_Len) := Libgnat; Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library)); @@ -606,4 +617,17 @@ package body MLib.Utl is return Name_Buffer (1 .. Name_Len - Libgnat'Length); end Lib_Directory; + ------------------------ + -- Specify_Adalib_Dir -- + ------------------------ + + procedure Specify_Adalib_Dir (Path : String) is + begin + if Path'Length = 0 then + Adalib_Path := null; + else + Adalib_Path := new String'(Path); + end if; + end Specify_Adalib_Dir; + end MLib.Utl; diff --git a/gcc/ada/mlib-utl.ads b/gcc/ada/mlib-utl.ads index 237c678d1a7..f91eebf7f51 100644 --- a/gcc/ada/mlib-utl.ads +++ b/gcc/ada/mlib-utl.ads @@ -58,4 +58,10 @@ package MLib.Utl is function Lib_Directory return String; -- Return the directory containing libgnat + procedure Specify_Adalib_Dir (Path : String); + -- Specify the path of the GNAT adalib directory, to be returned by + -- function Lib_Directory without looking for it. This is used only in + -- gprlib, because we cannot rely on the search in Lib_Directory, as the + -- GNAT version may be different for gprbuild/gprlib and the compiler. + end MLib.Utl; diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index b0301d2817c..0bb3a99fbfb 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2007, AdaCore -- +-- Copyright (C) 1999-2008, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -310,18 +310,9 @@ package body MLib is pragma Unreferenced (Success, Result); begin - if Is_Absolute_Path (Lib_Version) then - Version_Path := new String (1 .. Lib_Version'Length + 1); - Version_Path (1 .. Lib_Version'Length) := Lib_Version; - - else - Version_Path := - new String (1 .. Lib_Dir'Length + 1 + Lib_Version'Length + 1); - Version_Path (1 .. Version_Path'Last - 1) := - Lib_Dir & Directory_Separator & Lib_Version; - end if; - - Version_Path (Version_Path'Last) := ASCII.NUL; + Version_Path := new String (1 .. Lib_Version'Length + 1); + Version_Path (1 .. Lib_Version'Length) := Lib_Version; + Version_Path (Version_Path'Last) := ASCII.NUL; if Maj_Version'Length = 0 then declare @@ -339,6 +330,7 @@ package body MLib is Maj_Path : constant String := Lib_Dir & Directory_Separator & Maj_Version; Newpath2 : String (1 .. Maj_Path'Length + 1); + Maj_Ver : String (1 .. Maj_Version'Length + 1); begin Newpath1 (1 .. Lib_Path'Length) := Lib_Path; @@ -347,13 +339,16 @@ package body MLib is Newpath2 (1 .. Maj_Path'Length) := Maj_Path; Newpath2 (Newpath2'Last) := ASCII.NUL; + Maj_Ver (1 .. Maj_Version'Length) := Maj_Version; + Maj_Ver (Maj_Ver'Last) := ASCII.NUL; + Delete_File (Maj_Path, Success); Result := Symlink (Version_Path (1)'Address, Newpath2'Address); Delete_File (Lib_Path, Success); - Result := Symlink (Newpath2'Address, Newpath1'Address); + Result := Symlink (Maj_Ver'Address, Newpath1'Address); end; end if; end Create_Sym_Links; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 7ffa2d5d855..68bf246919a 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -283,11 +283,6 @@ package Opt is -- is set True, or if pragma No_Run_Time is used. See the spec of Rtsfind -- for details on the handling of the latter pragma. - Canonical_Streams : Boolean := False; - -- GNATBIND - -- Set to True if configuration pragma Canonical_Streams is present. It - -- controls the canonical behaviour of stream operations for String types. - Constant_Condition_Warnings : Boolean := False; -- GNAT -- Set to True to activate warnings on constant conditions @@ -533,6 +528,11 @@ package Opt is -- the name is of the form .xxx, then to name.xxx where name is the source -- file name with extension stripped. + Generate_Processed_File : Boolean := False; + -- GNAT + -- True when switch -gnateG is used. When True, create in a file + -- <source>.prep, if the source is preprocessed. + Generating_Code : Boolean := False; -- GNAT -- True if the frontend finished its work and has called the backend to diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index eb16fb1737b..f433352b06d 100644 --- a/gcc/ada/par-ch10.adb +++ b/gcc/ada/par-ch10.adb @@ -115,7 +115,7 @@ package body Ch10 is P : Node_Id; SR_Present : Boolean; - Cunit_Error_Flag : Boolean := False; + Cunit_Error_Flag : Boolean := False; -- This flag is set True if we have to scan for a compilation unit -- token. It is used to ensure clean termination in such cases by -- not insisting on being at the end of file, and, in the syntax only @@ -140,8 +140,8 @@ package body Ch10 is Config_Pragmas := No_List; - -- If we have an initial Source_Reference pragma, then remember - -- the fact to generate an NR parameter in the output line. + -- If we have an initial Source_Reference pragma, then remember the fact + -- to generate an NR parameter in the output line. SR_Present := False; @@ -180,8 +180,7 @@ package body Ch10 is Item := P_Pragma; if Item = Error - or else not - Is_Configuration_Pragma_Name (Pragma_Name (Item)) + or else not Is_Configuration_Pragma_Name (Pragma_Name (Item)) then Restore_Scan_State (Scan_State); exit; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index c2ec59be9dc..9a5a8d39345 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -206,6 +206,18 @@ package body Ch3 is Ident_Node := Token_Node; Scan; -- past the reserved identifier + -- If we already have a defining identifier, clean it out and make + -- a new clean identifier. This situation arises in some error cases + -- and we need to fix it. + + if Nkind (Ident_Node) = N_Defining_Identifier then + Ident_Node := + Make_Identifier (Sloc (Ident_Node), + Chars => Chars (Ident_Node)); + end if; + + -- Change identifier to defining identifier if not in error + if Ident_Node /= Error then Change_Identifier_To_Defining_Identifier (Ident_Node); end if; @@ -290,20 +302,12 @@ package body Ch3 is Scan; -- past TYPE Ident_Node := P_Defining_Identifier (C_Is); - -- Otherwise this is an error case, and we may already have converted - -- the current token to a defining identifier, so don't do it again! + -- Otherwise this is an error case else T_Type; - - if Token = Tok_Identifier - and then Nkind (Token_Node) = N_Defining_Identifier - then - Ident_Node := Token_Node; - Scan; -- past defining identifier - else - Ident_Node := P_Defining_Identifier (C_Is); - end if; + Type_Token_Location := Type_Loc; + Ident_Node := P_Defining_Identifier (C_Is); end if; Discr_Sloc := Token_Ptr; @@ -1356,7 +1360,6 @@ package body Ch3 is -- If we have a comma, then scan out the list of identifiers elsif Token = Tok_Comma then - while Comma_Present loop Num_Idents := Num_Idents + 1; Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 7e68cbea1cb..ba32f387b6a 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1032,6 +1032,10 @@ begin raise Constraint_Error; end if; + Upper_Half_Encoding := + Wide_Character_Encoding_Method in + WC_Upper_Half_Encoding_Method; + exception when Constraint_Error => Error_Msg_N ("invalid argument for pragma%", Arg1); @@ -1054,7 +1058,6 @@ begin Pragma_Atomic | Pragma_Atomic_Components | Pragma_Attach_Handler | - Pragma_Canonical_Streams | Pragma_Check | Pragma_Check_Name | Pragma_Check_Policy | diff --git a/gcc/ada/prep.adb b/gcc/ada/prep.adb index eb739a75274..c1f4a5e780b 100644 --- a/gcc/ada/prep.adb +++ b/gcc/ada/prep.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1043,10 +1043,12 @@ package body Prep is -- Preprocess -- ---------------- - procedure Preprocess is + procedure Preprocess (Source_Modified : out Boolean) is Start_Of_Processing : Source_Ptr; Cond : Boolean; Preprocessor_Line : Boolean := False; + No_Error_Found : Boolean := True; + Modified : Boolean := False; procedure Output (From, To : Source_Ptr); -- Output the characters with indices From .. To in the buffer @@ -1118,75 +1120,21 @@ package body Prep is -- Preprocessor line if Token = Tok_Special and then Special_Character = '#' then - Preprocessor_Line := True; - Scan.all; - - case Token is - - -- #if - - when Tok_If => - declare - If_Ptr : constant Source_Ptr := Token_Ptr; - - begin - Scan.all; - Cond := Expression (not Deleting); - - -- Check for an eventual "then" - - if Token = Tok_Then then - Scan.all; - end if; - - -- It is an error to have trailing characters after - -- the condition or "then". - - if Token /= Tok_End_Of_Line - and then Token /= Tok_EOF - then - Error_Msg - ("extraneous text on preprocessor line", - Token_Ptr); - Go_To_End_Of_Line; - end if; - - declare - -- Set the initial state of this new "#if". - -- This must be done before incrementing the - -- Last of the table, otherwise function - -- Deleting does not report the correct value. - - New_State : constant Pp_State := - (If_Ptr => If_Ptr, - Else_Ptr => 0, - Deleting => Deleting or (not Cond), - Match_Seen => Deleting or Cond); - - begin - Pp_States.Increment_Last; - Pp_States.Table (Pp_States.Last) := New_State; - end; - end; - - -- #elsif + Modified := True; + Preprocessor_Line := True; + Scan.all; - when Tok_Elsif => - Cond := False; + case Token is - if Pp_States.Last = 0 - or else Pp_States.Table (Pp_States.Last).Else_Ptr - /= 0 - then - Error_Msg ("no IF for this ELSIF", Token_Ptr); + -- #if - else - Cond := - not Pp_States.Table (Pp_States.Last).Match_Seen; - end if; + when Tok_If => + declare + If_Ptr : constant Source_Ptr := Token_Ptr; + begin Scan.all; - Cond := Expression (Cond); + Cond := Expression (not Deleting); -- Check for an eventual "then" @@ -1203,136 +1151,201 @@ package body Prep is Error_Msg ("extraneous text on preprocessor line", Token_Ptr); - + No_Error_Found := False; Go_To_End_Of_Line; end if; - -- Depending on the value of the condition, set the - -- new values of Deleting and Match_Seen. - if Pp_States.Last > 0 then - if Pp_States.Table (Pp_States.Last).Match_Seen then - Pp_States.Table (Pp_States.Last).Deleting := - True; - else - if Cond then - Pp_States.Table (Pp_States.Last).Match_Seen := - True; - Pp_States.Table (Pp_States.Last).Deleting := - False; - end if; - end if; - end if; + declare + -- Set the initial state of this new "#if". This + -- must be done before incrementing the Last of + -- the table, otherwise function Deleting does + -- not report the correct value. - -- #else + New_State : constant Pp_State := + (If_Ptr => If_Ptr, + Else_Ptr => 0, + Deleting => Deleting or (not Cond), + Match_Seen => Deleting or Cond); - when Tok_Else => - if Pp_States.Last = 0 then - Error_Msg ("no IF for this ELSE", Token_Ptr); + begin + Pp_States.Increment_Last; + Pp_States.Table (Pp_States.Last) := New_State; + end; + end; - elsif - Pp_States.Table (Pp_States.Last).Else_Ptr /= 0 - then - Error_Msg ("duplicate ELSE line", Token_Ptr); - end if; + -- #elsif - -- Set the possibly new values of Deleting and - -- Match_Seen. + when Tok_Elsif => + Cond := False; - if Pp_States.Last > 0 then - if Pp_States.Table (Pp_States.Last).Match_Seen then - Pp_States.Table (Pp_States.Last).Deleting := - True; + if Pp_States.Last = 0 + or else Pp_States.Table (Pp_States.Last).Else_Ptr /= 0 + then + Error_Msg ("no IF for this ELSIF", Token_Ptr); + No_Error_Found := False; - else + else + Cond := + not Pp_States.Table (Pp_States.Last).Match_Seen; + end if; + + Scan.all; + Cond := Expression (Cond); + + -- Check for an eventual "then" + + if Token = Tok_Then then + Scan.all; + end if; + + -- It is an error to have trailing characters after + -- the condition or "then". + + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); + No_Error_Found := False; + + Go_To_End_Of_Line; + end if; + + -- Depending on the value of the condition, set the + -- new values of Deleting and Match_Seen. + if Pp_States.Last > 0 then + if Pp_States.Table (Pp_States.Last).Match_Seen then + Pp_States.Table (Pp_States.Last).Deleting := True; + else + if Cond then Pp_States.Table (Pp_States.Last).Match_Seen := True; Pp_States.Table (Pp_States.Last).Deleting := False; end if; + end if; + end if; - -- Set the Else_Ptr to check for illegal #elsif - -- later. + -- #else - Pp_States.Table (Pp_States.Last).Else_Ptr := - Token_Ptr; - end if; + when Tok_Else => + if Pp_States.Last = 0 then + Error_Msg ("no IF for this ELSE", Token_Ptr); + No_Error_Found := False; - Scan.all; + elsif + Pp_States.Table (Pp_States.Last).Else_Ptr /= 0 + then + Error_Msg ("duplicate ELSE line", Token_Ptr); + No_Error_Found := False; + end if; - -- It is an error to have characters after "#else" - if Token /= Tok_End_Of_Line - and then Token /= Tok_EOF - then - Error_Msg - ("extraneous text on preprocessor line", - Token_Ptr); - Go_To_End_Of_Line; - end if; + -- Set the possibly new values of Deleting and + -- Match_Seen. - -- #end if; + if Pp_States.Last > 0 then + if Pp_States.Table (Pp_States.Last).Match_Seen then + Pp_States.Table (Pp_States.Last).Deleting := + True; - when Tok_End => - if Pp_States.Last = 0 then - Error_Msg ("no IF for this END", Token_Ptr); + else + Pp_States.Table (Pp_States.Last).Match_Seen := + True; + Pp_States.Table (Pp_States.Last).Deleting := + False; end if; + -- Set the Else_Ptr to check for illegal #elsif + -- later. + + Pp_States.Table (Pp_States.Last).Else_Ptr := + Token_Ptr; + end if; + + Scan.all; + + -- It is an error to have characters after "#else" + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); + No_Error_Found := False; + Go_To_End_Of_Line; + end if; + + -- #end if; + + when Tok_End => + if Pp_States.Last = 0 then + Error_Msg ("no IF for this END", Token_Ptr); + No_Error_Found := False; + end if; + + Scan.all; + + if Token /= Tok_If then + Error_Msg ("IF expected", Token_Ptr); + No_Error_Found := False; + + else Scan.all; - if Token /= Tok_If then - Error_Msg ("IF expected", Token_Ptr); + if Token /= Tok_Semicolon then + Error_Msg ("`;` Expected", Token_Ptr); + No_Error_Found := False; else Scan.all; - if Token /= Tok_Semicolon then - Error_Msg ("`;` Expected", Token_Ptr); - - else - Scan.all; - - -- It is an error to have character after - -- "#end if;". - if Token /= Tok_End_Of_Line - and then Token /= Tok_EOF - then - Error_Msg - ("extraneous text on preprocessor line", - Token_Ptr); - end if; + -- It is an error to have character after + -- "#end if;". + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); + No_Error_Found := False; end if; end if; + end if; - -- In case of one of the errors above, skip the tokens - -- until the end of line is reached. + -- In case of one of the errors above, skip the tokens + -- until the end of line is reached. - Go_To_End_Of_Line; + Go_To_End_Of_Line; - -- Decrement the depth of the #if stack + -- Decrement the depth of the #if stack - if Pp_States.Last > 0 then - Pp_States.Decrement_Last; - end if; + if Pp_States.Last > 0 then + Pp_States.Decrement_Last; + end if; - -- Illegal preprocessor line + -- Illegal preprocessor line - when others => - if Pp_States.Last = 0 then - Error_Msg ("IF expected", Token_Ptr); + when others => + No_Error_Found := False; - elsif - Pp_States.Table (Pp_States.Last).Else_Ptr = 0 - then - Error_Msg ("IF, ELSIF, ELSE, or `END IF` expected", - Token_Ptr); + if Pp_States.Last = 0 then + Error_Msg ("IF expected", Token_Ptr); - else - Error_Msg ("IF or `END IF` expected", Token_Ptr); - end if; + elsif + Pp_States.Table (Pp_States.Last).Else_Ptr = 0 + then + Error_Msg ("IF, ELSIF, ELSE, or `END IF` expected", + Token_Ptr); + + else + Error_Msg ("IF or `END IF` expected", Token_Ptr); + end if; - -- Skip to the end of this illegal line + -- Skip to the end of this illegal line - Go_To_End_Of_Line; - end case; + Go_To_End_Of_Line; + end case; -- Not a preprocessor line @@ -1352,6 +1365,8 @@ package body Prep is if Token = Tok_Special and then Special_Character = '$' then + Modified := True; + declare Dollar_Ptr : constant Source_Ptr := Token_Ptr; Symbol : Symbol_Id; @@ -1449,7 +1464,10 @@ package body Prep is for Level in reverse 1 .. Pp_States.Last loop Error_Msg ("no `END IF` for this IF", Pp_States.Table (Level).If_Ptr); + No_Error_Found := False; end loop; + + Source_Modified := No_Error_Found and Modified; end Preprocess; end Prep; diff --git a/gcc/ada/prep.ads b/gcc/ada/prep.ads index 198ddb4159f..0f595e64dfb 100644 --- a/gcc/ada/prep.ads +++ b/gcc/ada/prep.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -106,9 +106,10 @@ package Prep is -- Parse the definition file. The definition file must have already been -- loaded and the scanner initialized. - procedure Preprocess; + procedure Preprocess (Source_Modified : out Boolean); -- Preprocess the input file. The input file must have already been loaded - -- and the scanner initialized. + -- and the scanner initialized. Source_Modified is set to True iff the + -- preprocessor modified the source text. procedure Check_Command_Line_Symbol_Definition (Definition : String; diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 6f6c888b4e6..9e8c92dbc44 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -168,6 +168,7 @@ package body Prj.Attr is "Sadriver#" & "Larequired_switches#" & "Lapic_option#" & + "Sapath_syntax#" & -- Configuration - Mapping files @@ -200,6 +201,7 @@ package body Prj.Attr is "Pbuilder#" & "Ladefault_switches#" & "Lcswitches#" & + "Lcglobal_compilation_switches#" & "Scexecutable#" & "SVexecutable_suffix#" & "SVglobal_configuration_pragmas#" & diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 3aa90ddfbd1..b3dc949347c 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -1442,7 +1442,7 @@ package body Prj.Nmsc is then In_Tree.Languages_Data.Table (Lang_Index).Config.Dependency_Kind := - Makefile; + Makefile; end if; List := Element.Value.Values; @@ -1481,7 +1481,7 @@ package body Prj.Nmsc is In_Tree.Languages_Data.Table (Lang_Index).Config.Include_Path := - Element.Value.Value; + Element.Value.Value; when Name_Include_Path_File => @@ -1489,7 +1489,7 @@ package body Prj.Nmsc is In_Tree.Languages_Data.Table (Lang_Index).Config.Include_Path_File := - Element.Value.Value; + Element.Value.Value; when Name_Driver => @@ -1499,16 +1499,32 @@ package body Prj.Nmsc is In_Tree.Languages_Data.Table (Lang_Index).Config.Compiler_Driver := - File_Name_Type (Element.Value.Value); + File_Name_Type (Element.Value.Value); when Name_Required_Switches => Put (Into_List => - In_Tree.Languages_Data.Table - (Lang_Index).Config. - Compiler_Required_Switches, + In_Tree.Languages_Data.Table + (Lang_Index).Config. + Compiler_Required_Switches, From_List => Element.Value.Values, In_Tree => In_Tree); + when Name_Path_Syntax => + begin + In_Tree.Languages_Data.Table + (Lang_Index).Config.Path_Syntax := + Path_Syntax_Kind'Value + (Get_Name_String (Element.Value.Value)); + + exception + when Constraint_Error => + Error_Msg + (Project, + In_Tree, + "invalid value for Path_Syntax", + Element.Value.Location); + end; + when Name_Pic_Option => -- Attribute Compiler_Pic_Option (<language>) @@ -1580,8 +1596,8 @@ package body Prj.Nmsc is end if; Put (Into_List => - In_Tree.Languages_Data.Table - (Lang_Index).Config.Config_File_Switches, + In_Tree.Languages_Data.Table + (Lang_Index).Config.Config_File_Switches, From_List => List, In_Tree => In_Tree); @@ -1591,7 +1607,7 @@ package body Prj.Nmsc is In_Tree.Languages_Data.Table (Lang_Index).Config.Objects_Path := - Element.Value.Value; + Element.Value.Value; when Name_Objects_Path_File => @@ -1599,7 +1615,7 @@ package body Prj.Nmsc is In_Tree.Languages_Data.Table (Lang_Index).Config.Objects_Path_File := - Element.Value.Value; + Element.Value.Value; when Name_Config_Body_File_Name => @@ -1607,7 +1623,7 @@ package body Prj.Nmsc is In_Tree.Languages_Data.Table (Lang_Index).Config.Config_Body := - Element.Value.Value; + Element.Value.Value; when Name_Config_Body_File_Name_Pattern => @@ -1624,7 +1640,7 @@ package body Prj.Nmsc is In_Tree.Languages_Data.Table (Lang_Index).Config.Config_Spec := - Element.Value.Value; + Element.Value.Value; when Name_Config_Spec_File_Name_Pattern => @@ -1678,8 +1694,7 @@ package body Prj.Nmsc is Attribute_Id := Attributes; while Attribute_Id /= No_Variable loop - Attribute := - In_Tree.Variable_Elements.Table (Attribute_Id); + Attribute := In_Tree.Variable_Elements.Table (Attribute_Id); if not Attribute.Value.Default then if Attribute.Name = Name_Separate_Suffix then diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 901875ad204..5e0b14f0151 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -165,13 +165,12 @@ package body Prj.Part is Packages_To_Check : String_List_Access; Depth : Natural; Current_Dir : String); - -- Parse a project file. - -- Recursive procedure: it calls itself for imported and extended - -- projects. When From_Extended is not None, if the project has already - -- been parsed and is an extended project A, return the ultimate - -- (not extended) project that extends A. When In_Limited is True, - -- the importing path includes at least one "limited with". - -- When parsing configuration projects, do not allow a depth > 1. + -- Parse a project file. This is a recursive procedure: it calls itself for + -- imported and extended projects. When From_Extended is not None, if the + -- project has already been parsed and is an extended project A, return the + -- ultimate (not extended) project that extends A. When In_Limited is True, + -- the importing path includes at least one "limited with". When parsing + -- configuration projects, do not allow a depth > 1. procedure Pre_Parse_Context_Clause (In_Tree : Project_Node_Tree_Ref; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 67ae8ba85f0..134f85b8b1c 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -83,12 +83,15 @@ package body Prj.Proc is -- Current_Dir is for optimization purposes, avoiding extra system calls. procedure Copy_Package_Declarations - (From : Declarations; - To : in out Declarations; - New_Loc : Source_Ptr; - In_Tree : Project_Tree_Ref); + (From : Declarations; + To : in out Declarations; + New_Loc : Source_Ptr; + Naming_Restricted : Boolean; + In_Tree : Project_Tree_Ref); -- Copy a package declaration From to To for a renamed package. Change the - -- locations of all the attributes to New_Loc. + -- locations of all the attributes to New_Loc. When Naming_Restricted is + -- True, do not copy attributes Body, Spec, Implementation and + -- Specification. function Expression (Project : Project_Id; @@ -310,10 +313,11 @@ package body Prj.Proc is ------------------------------- procedure Copy_Package_Declarations - (From : Declarations; - To : in out Declarations; - New_Loc : Source_Ptr; - In_Tree : Project_Tree_Ref) + (From : Declarations; + To : in out Declarations; + New_Loc : Source_Ptr; + Naming_Restricted : Boolean; + In_Tree : Project_Tree_Ref) is V1 : Variable_Id := From.Attributes; V2 : Variable_Id := No_Variable; @@ -368,67 +372,73 @@ package body Prj.Proc is while A1 /= No_Array loop - -- Copy the array - Arr := In_Tree.Arrays.Table (A1); A1 := Arr.Next; - -- Remove the Next component + if not Naming_Restricted or else + (Arr.Name /= Snames.Name_Body + and then Arr.Name /= Snames.Name_Spec + and then Arr.Name /= Snames.Name_Implementation + and then Arr.Name /= Snames.Name_Specification) + then + -- Remove the Next component - Arr.Next := No_Array; + Arr.Next := No_Array; - Array_Table.Increment_Last (In_Tree.Arrays); + Array_Table.Increment_Last (In_Tree.Arrays); - -- Create new Array declaration - if To.Arrays = No_Array then - To.Arrays := Array_Table.Last (In_Tree.Arrays); + -- Create new Array declaration - else - In_Tree.Arrays.Table (A2).Next := - Array_Table.Last (In_Tree.Arrays); - end if; + if To.Arrays = No_Array then + To.Arrays := Array_Table.Last (In_Tree.Arrays); - A2 := Array_Table.Last (In_Tree.Arrays); + else + In_Tree.Arrays.Table (A2).Next := + Array_Table.Last (In_Tree.Arrays); + end if; - -- Don't store the array, as its first element has not been set yet + A2 := Array_Table.Last (In_Tree.Arrays); - -- Copy the array elements of the array + -- Don't store the array as its first element has not been set yet - E1 := Arr.Value; - Arr.Value := No_Array_Element; + -- Copy the array elements of the array - while E1 /= No_Array_Element loop + E1 := Arr.Value; + Arr.Value := No_Array_Element; + while E1 /= No_Array_Element loop - -- Copy the array element + -- Copy the array element - Elm := In_Tree.Array_Elements.Table (E1); - E1 := Elm.Next; + Elm := In_Tree.Array_Elements.Table (E1); + E1 := Elm.Next; - -- Remove the Next component + -- Remove the Next component - Elm.Next := No_Array_Element; + Elm.Next := No_Array_Element; - -- Change the location + -- Change the location - Elm.Value.Location := New_Loc; - Array_Element_Table.Increment_Last (In_Tree.Array_Elements); + Elm.Value.Location := New_Loc; + Array_Element_Table.Increment_Last (In_Tree.Array_Elements); - -- Create new array element + -- Create new array element - if Arr.Value = No_Array_Element then - Arr.Value := Array_Element_Table.Last (In_Tree.Array_Elements); - else - In_Tree.Array_Elements.Table (E2).Next := - Array_Element_Table.Last (In_Tree.Array_Elements); - end if; + if Arr.Value = No_Array_Element then + Arr.Value := + Array_Element_Table.Last (In_Tree.Array_Elements); + else + In_Tree.Array_Elements.Table (E2).Next := + Array_Element_Table.Last (In_Tree.Array_Elements); + end if; - E2 := Array_Element_Table.Last (In_Tree.Array_Elements); - In_Tree.Array_Elements.Table (E2) := Elm; - end loop; + E2 := Array_Element_Table.Last (In_Tree.Array_Elements); + In_Tree.Array_Elements.Table (E2) := Elm; + end loop; - -- Finally, store the new array + -- Finally, store the new array - In_Tree.Arrays.Table (A2) := Arr; + In_Tree.Arrays.Table (A2) := Arr; + end if; end loop; end Copy_Package_Declarations; @@ -1343,14 +1353,15 @@ package body Prj.Proc is -- renaming declaration. Copy_Package_Declarations - (From => + (From => In_Tree.Packages.Table (Renamed_Package).Decl, - To => + To => In_Tree.Packages.Table (New_Pkg).Decl, - New_Loc => + New_Loc => Location_Of (Current_Item, From_Project_Node_Tree), - In_Tree => In_Tree); + Naming_Restricted => False, + In_Tree => In_Tree); end; -- Standard package declaration, not renaming @@ -2730,10 +2741,13 @@ package body Prj.Proc is Next => Processed_Data.Decl.Packages); Processed_Data.Decl.Packages := Current_Pkg; Copy_Package_Declarations - (From => Element.Decl, - To => In_Tree.Packages.Table (Current_Pkg).Decl, - New_Loc => No_Location, - In_Tree => In_Tree); + (From => Element.Decl, + To => + In_Tree.Packages.Table (Current_Pkg).Decl, + New_Loc => No_Location, + Naming_Restricted => + Element.Name = Snames.Name_Naming, + In_Tree => In_Tree); end if; Extended_Pkg := Element.Next; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 23623f5feda..505e2dad3d1 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -690,7 +690,7 @@ package body Prj is if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then return In_Tree.Languages_Data.Table - (Lang).Config.Objects_Generated; + (Lang).Config.Object_Generated; end if; Lang := In_Tree.Languages_Data.Table (Lang).Next; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 9af43b388ce..12b86b73079 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -399,6 +399,13 @@ package Prj is No_Source : constant Source_Id := 0; + type Path_Syntax_Kind is + (Canonical, + -- Unix style + + Host); + -- Host specific syntax, for example on VMS (the default) + type Language_Config is record Kind : Language_Kind := File_Based; -- Kind of language. All languages are file based, except Ada which is @@ -423,6 +430,10 @@ package Prj is -- The list of switches that are required as a minimum to invoke the -- compiler driver. + Path_Syntax : Path_Syntax_Kind := Host; + -- Value may be Canonical (Unix style) or Host (host syntax, for example + -- on VMS for DEC C). + Compilation_PIC_Option : Name_List_Index := No_Name_List; -- The option(s) to compile a source in Position Independent Code for -- shared libraries. Specified in the configuration. When not specified, @@ -525,12 +536,6 @@ package Prj is Toolchain_Description : Name_Id := No_Name; -- Hold the value of attribute Toolchain_Description for the language - PIC_Option : Name_Id := No_Name; - -- Hold the value of attribute Compiler'PIC_Option for the language - - Objects_Generated : Boolean := True; - -- Indicates if objects are generated for the language - end record; -- Record describing the configuration of a language @@ -541,6 +546,7 @@ package Prj is Compiler_Driver => No_File, Compiler_Driver_Path => null, Compiler_Required_Switches => No_Name_List, + Path_Syntax => Canonical, Compilation_PIC_Option => No_Name_List, Object_Generated => True, Objects_Linked => True, @@ -567,9 +573,7 @@ package Prj is Binder_Required_Switches => No_Name_List, Binder_Prefix => No_Name, Toolchain_Version => No_Name, - Toolchain_Description => No_Name, - PIC_Option => No_Name, - Objects_Generated => True); + Toolchain_Description => No_Name); type Language_Data is record Name : Name_Id := No_Name; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 2f1bd5dec3d..99a20afcad9 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -52,22 +52,20 @@ package body Restrict is -- Local Subprograms -- ----------------------- - procedure Restriction_Msg (Msg : String; R : String; N : Node_Id); - -- Output error message at node N with given text, replacing the - -- '%' in the message with the name of the restriction given as R, - -- cased according to the current identifier casing. We do not use - -- the normal insertion mechanism, since this requires an entry - -- in the Names table, and this table will be locked if we are - -- generating a message from gigi. + procedure Restriction_Msg (R : Restriction_Id; N : Node_Id); + -- Called if a violation of restriction R at node N is found. This routine + -- outputs the appropriate message or messages taking care of warning vs + -- real violation, serious vs non-serious, implicit vs explicit, the second + -- message giving the profile name if needed, and the location information. function Same_Unit (U1, U2 : Node_Id) return Boolean; -- Returns True iff U1 and U2 represent the same library unit. Used for -- handling of No_Dependence => Unit restriction case. function Suppress_Restriction_Message (N : Node_Id) return Boolean; - -- N is the node for a possible restriction violation message, but - -- the message is to be suppressed if this is an internal file and - -- this file is not the main unit. + -- N is the node for a possible restriction violation message, but the + -- message is to be suppressed if this is an internal file and this file is + -- not the main unit. Returns True if message is to be suppressed. ------------------- -- Abort_Allowed -- @@ -148,7 +146,7 @@ package body Restrict is if Name_Len < 5 or else (Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" and then - Name_Buffer (Name_Len - 4 .. Name_Len) /= ".adb") + Name_Buffer (Name_Len - 3 .. Name_Len) /= ".adb") then return; end if; @@ -194,8 +192,6 @@ package body Restrict is N : Node_Id; V : Uint := Uint_Minus_1) is - Rimage : constant String := Restriction_Id'Image (R); - VV : Integer; -- V converted to integer form. If V is greater than Integer'Last, -- it is reset to minus 1 (unknown value). @@ -311,35 +307,7 @@ package body Restrict is and then Restrictions.Value (R) = 0) or else Restrictions.Count (R) > Restrictions.Value (R) then - Error_Msg_Sloc := Restrictions_Loc (R); - - -- If we have a location for the Restrictions pragma, output it - - if Error_Msg_Sloc > No_Location - or else Error_Msg_Sloc = System_Location - then - if Restriction_Warnings (R) then - Restriction_Msg ("|violation of restriction %#?", Rimage, N); - else - -- Normally a restriction violation is a non-serious error, - -- but we treat violation of No_Finalization as a serious - -- error, since we want to turn off expansion in this case, - -- expansion just causes too many cascaded errors. - - if R = No_Finalization then - Restriction_Msg ("violation of restriction %#", Rimage, N); - else - Restriction_Msg ("|violation of restriction %#", Rimage, N); - end if; - end if; - - -- Otherwise we have the case of an implicit restriction - -- (e.g. a restriction implicitly set by another pragma) - - else - Restriction_Msg - ("|violation of implicit restriction %", Rimage, N); - end if; + Restriction_Msg (R, N); end if; end Check_Restriction; @@ -543,43 +511,147 @@ package body Restrict is -- Restriction_Msg -- --------------------- - procedure Restriction_Msg (Msg : String; R : String; N : Node_Id) is - B : String (1 .. Msg'Length + 2 * R'Length + 1); - P : Natural := 1; + procedure Restriction_Msg (R : Restriction_Id; N : Node_Id) is + Msg : String (1 .. 100); + Len : Natural := 0; - begin - Name_Buffer (1 .. R'Last) := R; - Name_Len := R'Length; - Set_Casing (Identifier_Casing (Get_Source_File_Index (Sloc (N)))); - - P := 0; - for J in Msg'Range loop - if Msg (J) = '%' then - P := P + 1; - B (P) := '`'; - - -- Put characters of image in message, quoting upper case letters - - for J in 1 .. Name_Len loop - if Name_Buffer (J) in 'A' .. 'Z' then - P := P + 1; - B (P) := '''; - end if; + procedure Add_Char (C : Character); + -- Append given character to Msg, bumping Len - P := P + 1; - B (P) := Name_Buffer (J); - end loop; + procedure Add_Str (S : String); + -- Append given string to Msg, bumping Len appropriately + + procedure Id_Case (S : String; Quotes : Boolean := True); + -- Given a string S, case it according to current identifier casing, + -- and store in Error_Msg_String. Then append `~` to the message buffer + -- to output the string unchanged surrounded in quotes. The quotes are + -- suppressed if Quotes = False. + + -------------- + -- Add_Char -- + -------------- + + procedure Add_Char (C : Character) is + begin + Len := Len + 1; + Msg (Len) := C; + end Add_Char; + + ------------- + -- Add_Str -- + ------------- - P := P + 1; - B (P) := '`'; + procedure Add_Str (S : String) is + begin + Msg (Len + 1 .. Len + S'Length) := S; + Len := Len + S'Length; + end Add_Str; + ------------- + -- Id_Case -- + ------------- + + procedure Id_Case (S : String; Quotes : Boolean := True) is + begin + Name_Buffer (1 .. S'Last) := S; + Name_Len := S'Length; + Set_Casing (Identifier_Casing (Get_Source_File_Index (Sloc (N)))); + Error_Msg_Strlen := Name_Len; + Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len); + + if Quotes then + Add_Str ("`~`"); else - P := P + 1; - B (P) := Msg (J); + Add_Char ('~'); + end if; + end Id_Case; + + -- Start of processing for Restriction_Msg + + begin + -- Set warning message if warning + + if Restriction_Warnings (R) then + Add_Char ('?'); + + -- If real violation (not warning), then mark it as non-serious unless + -- it is a violation of No_Finalization in which case we leave it as a + -- serious message, since otherwise we get crashes during attempts to + -- expand stuff that is not properly formed due to assumptions made + -- about no finalization being present. + + elsif R /= No_Finalization then + Add_Char ('|'); + end if; + + Error_Msg_Sloc := Restrictions_Loc (R); + + -- Set main message, adding implicit if no source location + + if Error_Msg_Sloc > No_Location + or else Error_Msg_Sloc = System_Location + then + Add_Str ("violation of restriction "); + else + Add_Str ("violation of implicit restriction "); + Error_Msg_Sloc := No_Location; + end if; + + -- Case of parametrized restriction + + if R in All_Parameter_Restrictions then + Add_Char ('`'); + Id_Case (Restriction_Id'Image (R), Quotes => False); + Add_Str (" = ^`"); + Error_Msg_Uint_1 := UI_From_Int (Int (Restrictions.Value (R))); + + -- Case of boolean restriction + + else + Id_Case (Restriction_Id'Image (R)); + end if; + + -- Case of no secondary profile continuation message + + if Restriction_Profile_Name (R) = No_Profile then + if Error_Msg_Sloc /= No_Location then + Add_Char ('#'); + end if; + + Add_Char ('!'); + Error_Msg_N (Msg (1 .. Len), N); + + -- Case of secondary profile continuation message present + + else + Add_Char ('!'); + Error_Msg_N (Msg (1 .. Len), N); + + Len := 0; + Add_Char ('\'); + + -- Set as warning if warning case + + if Restriction_Warnings (R) then + Add_Char ('?'); end if; - end loop; - Error_Msg_N (B (1 .. P), N); + -- Set main message + + Add_Str ("from profile "); + Id_Case (Profile_Name'Image (Restriction_Profile_Name (R))); + + -- Add location if we have one + + if Error_Msg_Sloc /= No_Location then + Add_Char ('#'); + end if; + + -- Output unconditional message and we are done + + Add_Char ('!'); + Error_Msg_N (Msg (1 .. Len), N); + end if; end Restriction_Msg; --------------- @@ -634,6 +706,10 @@ package body Restrict is Set_Restriction (J, N, V (J)); end if; + -- Record that this came from a Profile[_Warnings] restriction + + Restriction_Profile_Name (J) := P; + -- Set warning flag, except that we do not set the warning -- flag if the restriction was already active and this is -- the warning case. That avoids a warning overriding a real @@ -683,13 +759,17 @@ package body Restrict is Restricted_Profile_Cached := False; end if; - -- Set location, but preserve location of system - -- restriction for nice error msg with run time name + -- Set location, but preserve location of system restriction for nice + -- error msg with run time name. if Restrictions_Loc (R) /= System_Location then Restrictions_Loc (R) := Sloc (N); end if; + -- Note restriction came from restriction pragma, not profile + + Restriction_Profile_Name (R) := No_Profile; + -- Record the restriction if we are in the main unit, or in the extended -- main unit. The reason that we test separately for Main_Unit is that -- gnat.adc is processed with Current_Sem_Unit = Main_Unit, but nodes in @@ -731,12 +811,11 @@ package body Restrict is Restrictions_Loc (R) := Sloc (N); end if; - -- Record the restriction if we are in the main unit, - -- or in the extended main unit. The reason that we - -- test separately for Main_Unit is that gnat.adc is - -- processed with Current_Sem_Unit = Main_Unit, but - -- nodes in gnat.adc do not appear to be the extended - -- main source unit (they probably should do ???) + -- Record the restriction if we are in the main unit, or in the extended + -- main unit. The reason that we test separately for Main_Unit is that + -- gnat.adc is processed with Current_Sem_Unit = Main_Unit, but nodes in + -- gnat.adc do not appear to be the extended main source unit (they + -- probably should do ???) if Current_Sem_Unit = Main_Unit or else In_Extended_Main_Source_Unit (N) @@ -751,6 +830,10 @@ package body Restrict is Main_Restrictions.Value (R) := V; end if; end if; + + -- Note restriction came from restriction pragma, not profile + + Restriction_Profile_Name (R) := No_Profile; end Set_Restriction; ----------------------------------- @@ -758,8 +841,9 @@ package body Restrict is ----------------------------------- procedure Set_Restriction_No_Dependence - (Unit : Node_Id; - Warn : Boolean) + (Unit : Node_Id; + Warn : Boolean; + Profile : Profile_Name := No_Profile) is begin -- Loop to check for duplicate entry @@ -782,7 +866,7 @@ package body Restrict is -- Entry is not currently in table - No_Dependence.Append ((Unit, Warn)); + No_Dependence.Append ((Unit, Warn, Profile)); end Set_Restriction_No_Dependence; ---------------------------------- diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index bb81d85ed79..2553e0444aa 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -50,6 +50,12 @@ package Restrict is -- pragma, and a value of System_Location is used for restrictions -- set from package Standard by the processing in Targparm. + Restriction_Profile_Name : array (All_Restrictions) of Profile_Name; + -- Entries in this array are valid only if the corresponding restriction + -- in Restrictions set. The value is the corresponding profile name if the + -- restriction was set by a Profile or Profile_Warnings pragma. The value + -- is No_Profile in all other cases. + Main_Restrictions : Restrictions_Info := No_Restrictions; -- This variable records only restrictions found in any units of the -- main extended unit. These are the variables used for ali file output, @@ -154,6 +160,10 @@ package Restrict is Warn : Boolean; -- True if from Restriction_Warnings, False if from Restrictions + + Profile : Profile_Name; + -- Set to name of profile from which No_Dependence entry came, or to + -- No_Profile if a pragma Restriction set the No_Dependence entry. end record; package No_Dependence is new Table.Table ( @@ -190,14 +200,13 @@ package Restrict is V : Uint := Uint_Minus_1); -- Checks that the given restriction is not set, and if it is set, an -- appropriate message is posted on the given node. Also records the - -- violation in the appropriate internal arrays. Note that it is - -- mandatory to always use this routine to check if a restriction - -- is violated. Such checks must never be done directly by the caller, - -- since otherwise violations in the absence of restrictions are not - -- properly recorded. The value of V is relevant only for parameter - -- restrictions, and in this case indicates the exact count for the - -- violation. If the exact count is not known, V is left at its - -- default value of -1 which indicates an unknown count. + -- violation in the appropriate internal arrays. Note that it is mandatory + -- to always use this routine to check if a restriction is violated. Such + -- checks must never be done directly by the caller, since otherwise + -- violations in the absence of restrictions are not properly recorded. The + -- value of V is relevant only for parameter restrictions, and in this case + -- indicates the exact count for the violation. If the exact count is not + -- known, V is left at its default of -1 which indicates an unknown count. procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id); -- Called when a dependence on a unit is created (either implicitly, or by @@ -302,18 +311,19 @@ package Restrict is -- parameter restriction, and the corresponding value V is given. procedure Set_Restriction_No_Dependence - (Unit : Node_Id; - Warn : Boolean); + (Unit : Node_Id; + Warn : Boolean; + Profile : Profile_Name := No_Profile); -- Sets given No_Dependence restriction in table if not there already. -- Warn is True if from Restriction_Warnings, or for Restrictions if flag -- Treat_Restrictions_As_Warnings is set. False if from Restrictions and - -- this flag is not set. + -- this flag is not set. Profile is set to a non-default value if the + -- No_Dependence restriction comes from a Profile pragma. function Tasking_Allowed return Boolean; pragma Inline (Tasking_Allowed); - -- Tests to see if tasking operations are allowed by the current - -- restrictions settings. For tasking to be allowed Max_Tasks must - -- be non-zero. + -- Tests if tasking operations are allowed by the current restrictions + -- settings. For tasking to be allowed Max_Tasks must be non-zero. private type Save_Cunit_Boolean_Restrictions is diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index b3bbf6a3539..34e84065907 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -209,6 +209,7 @@ package Rtsfind is System_Compare_Array_Unsigned_64, System_Compare_Array_Unsigned_8, System_DSA_Services, + System_DSA_Types, System_Exception_Table, System_Exceptions, System_Exn_Int, @@ -696,6 +697,8 @@ package Rtsfind is RE_Get_Local_Partition_Id, -- System.DSA_Services RE_Get_Passive_Partition_Id, -- System.DSA_Services + RE_Any_Content_Ptr, -- System.DSA_Types + RE_Register_Exception, -- System.Exception_Table RE_Local_Raise, -- System.Exceptions @@ -1157,6 +1160,7 @@ package Rtsfind is RE_BS_To_Any, -- System.Partition_Interface RE_Any_To_BS, -- System.Partition_Interface + RE_FA_A, -- System.Partition_Interface RE_FA_B, -- System.Partition_Interface RE_FA_C, -- System.Partition_Interface RE_FA_F, -- System.Partition_Interface @@ -1205,7 +1209,7 @@ package Rtsfind is RE_TC_Build, -- System.Partition_Interface RE_Get_TC, -- System.Partition_Interface RE_Set_TC, -- System.Partition_Interface - RE_TC_Any, -- System.Partition_Interface + RE_TC_A, -- System.Partition_Interface RE_TC_B, -- System.Partition_Interface RE_TC_C, -- System.Partition_Interface RE_TC_F, -- System.Partition_Interface @@ -1331,17 +1335,29 @@ package Rtsfind is RE_Str_Concat_5, -- System.String_Ops_Concat_5 RE_String_Input, -- System.Strings.Stream_Ops + RE_String_Input_Blk_IO, -- System.Strings.Stream_Ops RE_String_Output, -- System.Strings.Stream_Ops + RE_String_Output_Blk_IO, -- System.Strings.Stream_Ops RE_String_Read, -- System.Strings.Stream_Ops + RE_String_Read_Blk_IO, -- System.Strings.Stream_Ops RE_String_Write, -- System.Strings.Stream_Ops + RE_String_Write_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_String_Input, -- System.Strings.Stream_Ops + RE_Wide_String_Input_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_String_Output, -- System.Strings.Stream_Ops + RE_Wide_String_Output_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_String_Read, -- System.Strings.Stream_Ops + RE_Wide_String_Read_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_String_Write, -- System.Strings.Stream_Ops + RE_Wide_String_Write_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_Wide_String_Input, -- System.Strings.Stream_Ops + RE_Wide_Wide_String_Input_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_Wide_String_Output, -- System.Strings.Stream_Ops + RE_Wide_Wide_String_Output_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_Wide_String_Read, -- System.Strings.Stream_Ops + RE_Wide_Wide_String_Read_Blk_IO, -- System.Strings.Stream_Ops RE_Wide_Wide_String_Write, -- System.Strings.Stream_Ops + RE_Wide_Wide_String_Write_Blk_IO, -- System.Strings.Stream_Ops RE_Task_Info_Type, -- System.Task_Info RE_Unspecified_Task_Info, -- System.Task_Info @@ -1838,6 +1854,8 @@ package Rtsfind is RE_Get_Local_Partition_Id => System_DSA_Services, RE_Get_Passive_Partition_Id => System_DSA_Services, + RE_Any_Content_Ptr => System_DSA_Types, + RE_Register_Exception => System_Exception_Table, RE_Local_Raise => System_Exceptions, @@ -2290,6 +2308,7 @@ package Rtsfind is RE_BS_To_Any => System_Partition_Interface, RE_Any_To_BS => System_Partition_Interface, + RE_FA_A => System_Partition_Interface, RE_FA_B => System_Partition_Interface, RE_FA_C => System_Partition_Interface, RE_FA_F => System_Partition_Interface, @@ -2338,7 +2357,7 @@ package Rtsfind is RE_TC_Build => System_Partition_Interface, RE_Get_TC => System_Partition_Interface, RE_Set_TC => System_Partition_Interface, - RE_TC_Any => System_Partition_Interface, + RE_TC_A => System_Partition_Interface, RE_TC_B => System_Partition_Interface, RE_TC_C => System_Partition_Interface, RE_TC_F => System_Partition_Interface, @@ -2473,17 +2492,29 @@ package Rtsfind is RE_Str_Concat_5 => System_String_Ops_Concat_5, RE_String_Input => System_Strings_Stream_Ops, + RE_String_Input_Blk_IO => System_Strings_Stream_Ops, RE_String_Output => System_Strings_Stream_Ops, + RE_String_Output_Blk_IO => System_Strings_Stream_Ops, RE_String_Read => System_Strings_Stream_Ops, + RE_String_Read_Blk_IO => System_Strings_Stream_Ops, RE_String_Write => System_Strings_Stream_Ops, + RE_String_Write_Blk_IO => System_Strings_Stream_Ops, RE_Wide_String_Input => System_Strings_Stream_Ops, + RE_Wide_String_Input_Blk_IO => System_Strings_Stream_Ops, RE_Wide_String_Output => System_Strings_Stream_Ops, + RE_Wide_String_Output_Blk_IO => System_Strings_Stream_Ops, RE_Wide_String_Read => System_Strings_Stream_Ops, + RE_Wide_String_Read_Blk_IO => System_Strings_Stream_Ops, RE_Wide_String_Write => System_Strings_Stream_Ops, + RE_Wide_String_Write_Blk_IO => System_Strings_Stream_Ops, RE_Wide_Wide_String_Input => System_Strings_Stream_Ops, + RE_Wide_Wide_String_Input_Blk_IO => System_Strings_Stream_Ops, RE_Wide_Wide_String_Output => System_Strings_Stream_Ops, + RE_Wide_Wide_String_Output_Blk_IO => System_Strings_Stream_Ops, RE_Wide_Wide_String_Read => System_Strings_Stream_Ops, + RE_Wide_Wide_String_Read_Blk_IO => System_Strings_Stream_Ops, RE_Wide_Wide_String_Write => System_Strings_Stream_Ops, + RE_Wide_Wide_String_Write_Blk_IO => System_Strings_Stream_Ops, RE_Task_Info_Type => System_Task_Info, RE_Unspecified_Task_Info => System_Task_Info, diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 6df7fa4a7c8..ca19e5a973f 100755 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -1316,6 +1316,25 @@ package body System.OS_Lib is return Is_Readable_File (F_Name'Address); end Is_Readable_File; + ------------------------ + -- Is_Executable_File -- + ------------------------ + + function Is_Executable_File (Name : C_File_Name) return Boolean is + function Is_Executable_File (Name : Address) return Integer; + pragma Import (C, Is_Executable_File, "__gnat_is_executable_file"); + begin + return Is_Executable_File (Name) /= 0; + end Is_Executable_File; + + function Is_Executable_File (Name : String) return Boolean is + F_Name : String (1 .. Name'Length + 1); + begin + F_Name (1 .. Name'Length) := Name; + F_Name (F_Name'Last) := ASCII.NUL; + return Is_Executable_File (F_Name'Address); + end Is_Executable_File; + --------------------- -- Is_Regular_File -- --------------------- @@ -1921,6 +1940,26 @@ package body System.OS_Lib is end; end if; + -- On Windows, remove all double-quotes that are possibly part of the + -- path but can cause problems with other methods. + + if On_Windows then + declare + Index : Natural; + + begin + Index := Path_Buffer'First; + for Current in Path_Buffer'First .. End_Path loop + if Path_Buffer (Current) /= '"' then + Path_Buffer (Index) := Path_Buffer (Current); + Index := Index + 1; + end if; + end loop; + + End_Path := Index - 1; + end; + end if; + -- Start the conversions -- If this is not finished after Max_Iterations, give up and return an diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index 8c319c845e1..f841558627f 100755 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1995-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -472,6 +472,14 @@ package System.OS_Lib is -- not actually be readable due to some other process having exclusive -- access. + function Is_Executable_File (Name : String) return Boolean; + -- Determines if the given string, Name, is the name of an existing file + -- that is executable. Returns True if so, False otherwise. Note that this + -- function simply interrogates the file attributes (e.g. using the C + -- function stat), so it does not indicate a situation in which a file may + -- not actually be readable due to some other process having exclusive + -- access. + function Is_Writable_File (Name : String) return Boolean; -- Determines if the given string, Name, is the name of an existing file -- that is writable. Returns True if so, False otherwise. Note that this @@ -608,6 +616,7 @@ package System.OS_Lib is function Is_Regular_File (Name : C_File_Name) return Boolean; function Is_Directory (Name : C_File_Name) return Boolean; function Is_Readable_File (Name : C_File_Name) return Boolean; + function Is_Executable_File (Name : C_File_Name) return Boolean; function Is_Writable_File (Name : C_File_Name) return Boolean; function Is_Symbolic_Link (Name : C_File_Name) return Boolean; diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index bbe422377de..9dbaa73ded4 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -50,9 +50,9 @@ package System.Rident is -- The following enumeration type defines the set of restriction -- identifiers that are implemented in GNAT. - -- To add a new restriction identifier, add an entry with the name - -- to be used in the pragma, and add appropriate calls to the - -- Restrict.Check_Restriction routine. + -- To add a new restriction identifier, add an entry with the name to be + -- used in the pragma, and add calls to the Restrict.Check_Restriction + -- routine as appropriate. type Restriction_Id is @@ -102,6 +102,7 @@ package System.Rident is No_Select_Statements, -- GNAT (Ravenscar) No_Specific_Termination_Handlers, -- (RM D.7(10.7/2)) No_Standard_Storage_Pools, -- GNAT + No_Stream_Optimizations, -- GNAT No_Streams, -- GNAT No_Task_Allocators, -- (RM D.7(7)) No_Task_Attributes_Package, -- GNAT @@ -198,7 +199,7 @@ package System.Rident is subtype All_Parameter_Restrictions is Restriction_Id range Max_Protected_Entries .. Max_Storage_At_Blocking; - -- All restrictions that are take a parameter + -- All restrictions that take a parameter subtype Checked_Parameter_Restrictions is All_Parameter_Restrictions range @@ -224,8 +225,8 @@ package System.Rident is subtype Checked_Val_Parameter_Restrictions is Checked_Parameter_Restrictions range Max_Protected_Entries .. Max_Tasks; - -- Restrictions with parameter where the count is known at least in - -- some cases by the compiler/binder. + -- Restrictions with parameter where the count is known at least in some + -- cases by the compiler/binder. subtype Checked_Zero_Parameter_Restrictions is Checked_Parameter_Restrictions range @@ -306,24 +307,29 @@ package System.Rident is -- Profile Definitions and Data -- ---------------------------------- - type Profile_Name is (Ravenscar, Restricted); - -- Names of recognized profiles + type Profile_Name is (No_Profile, Ravenscar, Restricted); + -- Names of recognized profiles. No_Profile is used to indicate that a + -- restriction came from pragma Restrictions[_Warning], as opposed to + -- pragma Profile[_Warning]. + + subtype Profile_Name_Actual is Profile_Name range Ravenscar .. Restricted; + -- Actual used profile names type Profile_Data is record Set : Restriction_Flags; - -- Set to True if given restriction must be set for the profile, - -- and False if it need not be set (False does not mean that it - -- must not be set, just that it need not be set). If the flag - -- is True for a parameter restriction, then the Value array - -- gives the maximum value permitted by the profile. + -- Set to True if given restriction must be set for the profile, and + -- False if it need not be set (False does not mean that it must not be + -- set, just that it need not be set). If the flag is True for a + -- parameter restriction, then the Value array gives the maximum value + -- permitted by the profile. Value : Restriction_Values; - -- An entry in this array is meaningful only if the corresponding - -- flag in Set is True. In that case, the value in this array is - -- the maximum value of the parameter permitted by the profile. + -- An entry in this array is meaningful only if the corresponding flag + -- in Set is True. In that case, the value in this array is the maximum + -- value of the parameter permitted by the profile. end record; - Profile_Info : array (Profile_Name) of Profile_Data := + Profile_Info : array (Profile_Name_Actual) of Profile_Data := -- Restricted Profile diff --git a/gcc/ada/s-ststop.adb b/gcc/ada/s-ststop.adb index 7dca75fbbe0..ca5c880fb31 100644 --- a/gcc/ada/s-ststop.adb +++ b/gcc/ada/s-ststop.adb @@ -43,6 +43,11 @@ with System.Stream_Attributes; use System; package body System.Strings.Stream_Ops is + -- The following type describes the low-level IO mechanism used in package + -- Stream_Ops_Internal. + + type IO_Kind is (Byte_IO, Block_IO); + -- The following package provides an IO framework for strings. Depending -- on the version of System.Stream_Attributes as well as the size of -- formal parameter Character_Type, the package will either utilize block @@ -53,13 +58,24 @@ package body System.Strings.Stream_Ops is type String_Type is array (Positive range <>) of Character_Type; package Stream_Ops_Internal is + function Input + (Strm : access Root_Stream_Type'Class; + IO : IO_Kind) return String_Type; + + procedure Output + (Strm : access Root_Stream_Type'Class; + Item : String_Type; + IO : IO_Kind); + procedure Read (Strm : access Root_Stream_Type'Class; - Item : out String_Type); + Item : out String_Type; + IO : IO_Kind); procedure Write (Strm : access Root_Stream_Type'Class; - Item : String_Type); + Item : String_Type; + IO : IO_Kind); end Stream_Ops_Internal; ------------------------- @@ -92,24 +108,6 @@ package body System.Strings.Stream_Ops is subtype String_Block is String_Type (1 .. C_In_Default_Block); - Flag : Integer; - pragma Import (C, Flag, "__gl_canonical_streams"); - -- This imported value is used to determine whether configuration pragma - -- Canonical_Streams is present. A value of zero indicates whether any - -- stream-related optimizations are enabled, while a value of one - -- indicates a disabled status. - - Canonical_Streams : constant Boolean := Flag = 1; - - -- Block IO is used when the low level can support block IO, the size - -- of the character type is a multiple of the stream element type and - -- the compilation can use stream optimizations. - - Use_Block_IO : constant Boolean := - Stream_Attributes.Block_IO_OK - and then C_Size mod SE_Size = 0 - and then not Canonical_Streams; - -- Conversions to and from Default_Block function To_Default_Block is @@ -118,13 +116,74 @@ package body System.Strings.Stream_Ops is function To_String_Block is new Ada.Unchecked_Conversion (Default_Block, String_Block); + ----------- + -- Input -- + ----------- + + function Input + (Strm : access Root_Stream_Type'Class; + IO : IO_Kind) return String_Type + is + begin + if Strm = null then + raise Constraint_Error; + end if; + + declare + Low : Positive; + High : Positive; + + begin + -- Read the bounds of the string + + Positive'Read (Strm, Low); + Positive'Read (Strm, High); + + declare + Item : String_Type (Low .. High); + + begin + -- Read the character content of the string + + Read (Strm, Item, IO); + + return Item; + end; + end; + end Input; + + ------------ + -- Output -- + ------------ + + procedure Output + (Strm : access Root_Stream_Type'Class; + Item : String_Type; + IO : IO_Kind) + is + begin + if Strm = null then + raise Constraint_Error; + end if; + + -- Write the bounds of the string + + Positive'Write (Strm, Item'First); + Positive'Write (Strm, Item'Last); + + -- Write the character content of the string + + Write (Strm, Item, IO); + end Output; + ---------- -- Read -- ---------- procedure Read (Strm : access Root_Stream_Type'Class; - Item : out String_Type) + Item : out String_Type; + IO : IO_Kind) is begin if Strm = null then @@ -137,7 +196,11 @@ package body System.Strings.Stream_Ops is return; end if; - if Use_Block_IO then + -- Block IO + + if IO = Block_IO + and then Stream_Attributes.Block_IO_OK + then declare -- Determine the size in BITS of the block necessary to contain -- the whole string. @@ -221,7 +284,7 @@ package body System.Strings.Stream_Ops is end if; end; - -- Character-by-character IO + -- Byte IO else declare @@ -242,7 +305,8 @@ package body System.Strings.Stream_Ops is procedure Write (Strm : access Root_Stream_Type'Class; - Item : String_Type) + Item : String_Type; + IO : IO_Kind) is begin if Strm = null then @@ -255,7 +319,11 @@ package body System.Strings.Stream_Ops is return; end if; - if Use_Block_IO then + -- Block IO + + if IO = Block_IO + and then Stream_Attributes.Block_IO_OK + then declare -- Determine the size in BITS of the block necessary to contain -- the whole string. @@ -309,7 +377,7 @@ package body System.Strings.Stream_Ops is end if; end; - -- Character-by-character IO + -- Byte IO else for Index in Item'First .. Item'Last loop @@ -319,7 +387,7 @@ package body System.Strings.Stream_Ops is end Write; end Stream_Ops_Internal; - -- Specific instantiations for different string types + -- Specific instantiations for all Ada string types package String_Ops is new Stream_Ops_Internal @@ -344,32 +412,19 @@ package body System.Strings.Stream_Ops is (Strm : access Ada.Streams.Root_Stream_Type'Class) return String is begin - if Strm = null then - raise Constraint_Error; - end if; - - declare - Low : Positive; - High : Positive; - - begin - -- Read the bounds of the string - - Positive'Read (Strm, Low); - Positive'Read (Strm, High); - - declare - Item : String (Low .. High); - - begin - -- Read the character content of the string + return String_Ops.Input (Strm, Byte_IO); + end String_Input; - String_Read (Strm, Item); + ------------------------- + -- String_Input_Blk_IO -- + ------------------------- - return Item; - end; - end; - end String_Input; + function String_Input_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class) return String + is + begin + return String_Ops.Input (Strm, Block_IO); + end String_Input_Blk_IO; ------------------- -- String_Output -- @@ -380,19 +435,20 @@ package body System.Strings.Stream_Ops is Item : String) is begin - if Strm = null then - raise Constraint_Error; - end if; - - -- Write the bounds of the string - - Positive'Write (Strm, Item'First); - Positive'Write (Strm, Item'Last); + String_Ops.Output (Strm, Item, Byte_IO); + end String_Output; - -- Write the character content of the string + -------------------------- + -- String_Output_Blk_IO -- + -------------------------- - String_Write (Strm, Item); - end String_Output; + procedure String_Output_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : String) + is + begin + String_Ops.Output (Strm, Item, Block_IO); + end String_Output_Blk_IO; ----------------- -- String_Read -- @@ -403,9 +459,21 @@ package body System.Strings.Stream_Ops is Item : out String) is begin - String_Ops.Read (Strm, Item); + String_Ops.Read (Strm, Item, Byte_IO); end String_Read; + ------------------------ + -- String_Read_Blk_IO -- + ------------------------ + + procedure String_Read_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out String) + is + begin + String_Ops.Read (Strm, Item, Block_IO); + end String_Read_Blk_IO; + ------------------ -- String_Write -- ------------------ @@ -415,44 +483,42 @@ package body System.Strings.Stream_Ops is Item : String) is begin - String_Ops.Write (Strm, Item); + String_Ops.Write (Strm, Item, Byte_IO); end String_Write; + ------------------------- + -- String_Write_Blk_IO -- + ------------------------- + + procedure String_Write_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : String) + is + begin + String_Ops.Write (Strm, Item, Block_IO); + end String_Write_Blk_IO; + ----------------------- -- Wide_String_Input -- ----------------------- function Wide_String_Input - (Strm : access Ada.Streams.Root_Stream_Type'Class) - return Wide_String + (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String is begin - if Strm = null then - raise Constraint_Error; - end if; - - declare - Low : Positive; - High : Positive; - - begin - -- Read the bounds of the string - - Positive'Read (Strm, Low); - Positive'Read (Strm, High); - - declare - Item : Wide_String (Low .. High); - - begin - -- Read the character content of the string + return Wide_String_Ops.Input (Strm, Byte_IO); + end Wide_String_Input; - Wide_String_Read (Strm, Item); + ------------------------------ + -- Wide_String_Input_Blk_IO -- + ------------------------------ - return Item; - end; - end; - end Wide_String_Input; + function Wide_String_Input_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String + is + begin + return Wide_String_Ops.Input (Strm, Block_IO); + end Wide_String_Input_Blk_IO; ------------------------ -- Wide_String_Output -- @@ -463,19 +529,20 @@ package body System.Strings.Stream_Ops is Item : Wide_String) is begin - if Strm = null then - raise Constraint_Error; - end if; - - -- Write the bounds of the string - - Positive'Write (Strm, Item'First); - Positive'Write (Strm, Item'Last); + Wide_String_Ops.Output (Strm, Item, Byte_IO); + end Wide_String_Output; - -- Write the character content of the string + ------------------------------- + -- Wide_String_Output_Blk_IO -- + ------------------------------- - Wide_String_Write (Strm, Item); - end Wide_String_Output; + procedure Wide_String_Output_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Wide_String) + is + begin + Wide_String_Ops.Output (Strm, Item, Block_IO); + end Wide_String_Output_Blk_IO; ---------------------- -- Wide_String_Read -- @@ -486,9 +553,21 @@ package body System.Strings.Stream_Ops is Item : out Wide_String) is begin - Wide_String_Ops.Read (Strm, Item); + Wide_String_Ops.Read (Strm, Item, Byte_IO); end Wide_String_Read; + ----------------------------- + -- Wide_String_Read_Blk_IO -- + ----------------------------- + + procedure Wide_String_Read_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out Wide_String) + is + begin + Wide_String_Ops.Read (Strm, Item, Block_IO); + end Wide_String_Read_Blk_IO; + ----------------------- -- Wide_String_Write -- ----------------------- @@ -498,44 +577,42 @@ package body System.Strings.Stream_Ops is Item : Wide_String) is begin - Wide_String_Ops.Write (Strm, Item); + Wide_String_Ops.Write (Strm, Item, Byte_IO); end Wide_String_Write; + ------------------------------ + -- Wide_String_Write_Blk_IO -- + ------------------------------ + + procedure Wide_String_Write_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Wide_String) + is + begin + Wide_String_Ops.Write (Strm, Item, Block_IO); + end Wide_String_Write_Blk_IO; + ---------------------------- -- Wide_Wide_String_Input -- ---------------------------- function Wide_Wide_String_Input - (Strm : access Ada.Streams.Root_Stream_Type'Class) - return Wide_Wide_String + (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String is begin - if Strm = null then - raise Constraint_Error; - end if; - - declare - Low : Positive; - High : Positive; - - begin - -- Read the bounds of the string - - Positive'Read (Strm, Low); - Positive'Read (Strm, High); - - declare - Item : Wide_Wide_String (Low .. High); - - begin - -- Read the character content of the string + return Wide_Wide_String_Ops.Input (Strm, Byte_IO); + end Wide_Wide_String_Input; - Wide_Wide_String_Read (Strm, Item); + ----------------------------------- + -- Wide_Wide_String_Input_Blk_IO -- + ----------------------------------- - return Item; - end; - end; - end Wide_Wide_String_Input; + function Wide_Wide_String_Input_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String + is + begin + return Wide_Wide_String_Ops.Input (Strm, Block_IO); + end Wide_Wide_String_Input_Blk_IO; ----------------------------- -- Wide_Wide_String_Output -- @@ -546,19 +623,20 @@ package body System.Strings.Stream_Ops is Item : Wide_Wide_String) is begin - if Strm = null then - raise Constraint_Error; - end if; - - -- Write the bounds of the string - - Positive'Write (Strm, Item'First); - Positive'Write (Strm, Item'Last); + Wide_Wide_String_Ops.Output (Strm, Item, Byte_IO); + end Wide_Wide_String_Output; - -- Write the character content of the string + ------------------------------------ + -- Wide_Wide_String_Output_Blk_IO -- + ------------------------------------ - Wide_Wide_String_Write (Strm, Item); - end Wide_Wide_String_Output; + procedure Wide_Wide_String_Output_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Wide_Wide_String) + is + begin + Wide_Wide_String_Ops.Output (Strm, Item, Block_IO); + end Wide_Wide_String_Output_Blk_IO; --------------------------- -- Wide_Wide_String_Read -- @@ -569,9 +647,21 @@ package body System.Strings.Stream_Ops is Item : out Wide_Wide_String) is begin - Wide_Wide_String_Ops.Read (Strm, Item); + Wide_Wide_String_Ops.Read (Strm, Item, Byte_IO); end Wide_Wide_String_Read; + ---------------------------------- + -- Wide_Wide_String_Read_Blk_IO -- + ---------------------------------- + + procedure Wide_Wide_String_Read_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out Wide_Wide_String) + is + begin + Wide_Wide_String_Ops.Read (Strm, Item, Block_IO); + end Wide_Wide_String_Read_Blk_IO; + ---------------------------- -- Wide_Wide_String_Write -- ---------------------------- @@ -581,7 +671,19 @@ package body System.Strings.Stream_Ops is Item : Wide_Wide_String) is begin - Wide_Wide_String_Ops.Write (Strm, Item); + Wide_Wide_String_Ops.Write (Strm, Item, Byte_IO); end Wide_Wide_String_Write; + ----------------------------------- + -- Wide_Wide_String_Write_Blk_IO -- + ----------------------------------- + + procedure Wide_Wide_String_Write_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Wide_Wide_String) + is + begin + Wide_Wide_String_Ops.Write (Strm, Item, Block_IO); + end Wide_Wide_String_Write_Blk_IO; + end System.Strings.Stream_Ops; diff --git a/gcc/ada/s-ststop.ads b/gcc/ada/s-ststop.ads index f954bccfc7b..432b1335d50 100644 --- a/gcc/ada/s-ststop.ads +++ b/gcc/ada/s-ststop.ads @@ -45,6 +45,8 @@ -- will be expanded into: -- -- String_Output (Some_Stream, Some_String); +-- or +-- String_Output_Blk_IO (Some_Stream, Some_String); pragma Warnings (Off); pragma Compiler_Unit; @@ -62,18 +64,34 @@ package System.Strings.Stream_Ops is (Strm : access Ada.Streams.Root_Stream_Type'Class) return String; + function String_Input_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class) + return String; + procedure String_Output (Strm : access Ada.Streams.Root_Stream_Type'Class; Item : String); + procedure String_Output_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : String); + procedure String_Read (Strm : access Ada.Streams.Root_Stream_Type'Class; Item : out String); + procedure String_Read_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out String); + procedure String_Write (Strm : access Ada.Streams.Root_Stream_Type'Class; Item : String); + procedure String_Write_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : String); + ----------------------------------- -- Wide_String stream operations -- ----------------------------------- @@ -82,18 +100,34 @@ package System.Strings.Stream_Ops is (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_String; + function Wide_String_Input_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class) + return Wide_String; + procedure Wide_String_Output (Strm : access Ada.Streams.Root_Stream_Type'Class; Item : Wide_String); + procedure Wide_String_Output_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Wide_String); + procedure Wide_String_Read (Strm : access Ada.Streams.Root_Stream_Type'Class; Item : out Wide_String); + procedure Wide_String_Read_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out Wide_String); + procedure Wide_String_Write (Strm : access Ada.Streams.Root_Stream_Type'Class; Item : Wide_String); + procedure Wide_String_Write_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Wide_String); + ---------------------------------------- -- Wide_Wide_String stream operations -- ---------------------------------------- @@ -102,16 +136,32 @@ package System.Strings.Stream_Ops is (Strm : access Ada.Streams.Root_Stream_Type'Class) return Wide_Wide_String; + function Wide_Wide_String_Input_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class) + return Wide_Wide_String; + procedure Wide_Wide_String_Output (Strm : access Ada.Streams.Root_Stream_Type'Class; Item : Wide_Wide_String); + procedure Wide_Wide_String_Output_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Wide_Wide_String); + procedure Wide_Wide_String_Read (Strm : access Ada.Streams.Root_Stream_Type'Class; Item : out Wide_Wide_String); + procedure Wide_Wide_String_Read_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : out Wide_Wide_String); + procedure Wide_Wide_String_Write (Strm : access Ada.Streams.Root_Stream_Type'Class; Item : Wide_Wide_String); + procedure Wide_Wide_String_Write_Blk_IO + (Strm : access Ada.Streams.Root_Stream_Type'Class; + Item : Wide_Wide_String); + end System.Strings.Stream_Ops; diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index 83cc368dee4..e344f74433b 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -338,8 +338,7 @@ package Scans is -- Flag array used to test for reserved word procedure Initialize_Ada_Keywords; - -- Set up Token_Type values in Names table entries for Ada reserved - -- words. + -- Set up Token_Type values in Names table entries for Ada reserved words -------------------------- -- Scan State Variables -- diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index 76f63f9353b..914c101afdc 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -350,6 +350,7 @@ package body Scng is procedure Error_Illegal_Wide_Character is begin + Scan_Ptr := Scan_Ptr + 1; Error_Msg ("illegal wide character", Wptr); end Error_Illegal_Wide_Character; @@ -1651,7 +1652,7 @@ package body Scng is if Err then Error_Illegal_Wide_Character; - Code := Character'Pos (' '); + Code := Character'Pos (' '); -- In Ada 95 mode we allow any wide character in a character -- literal, but in Ada 2005, the set of characters allowed diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 4b599151f8e..30684916644 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -315,6 +315,9 @@ package body Sem_Attr is -- corresponding possible defined attribute function (e.g. for the -- Read attribute, Nam will be TSS_Stream_Read). + procedure Check_PolyORB_Attribute; + -- Validity checking for PolyORB/DSA attribute + procedure Check_Task_Prefix; -- Verify that prefix of attribute N is a task or task type @@ -1380,6 +1383,23 @@ package body Sem_Attr is end if; end Check_Object_Reference; + ---------------------------- + -- Check_PolyORB_Attribute -- + ---------------------------- + + procedure Check_PolyORB_Attribute is + begin + Validate_Non_Static_Attribute_Function_Call; + + Check_Type; + Check_Not_CPP_Type; + + if Get_PCS_Name /= Name_PolyORB_DSA then + Error_Attr + ("attribute% requires the 'Poly'O'R'B 'P'C'S", N); + end if; + end Check_PolyORB_Attribute; + ------------------------ -- Check_Program_Unit -- ------------------------ @@ -2976,6 +2996,15 @@ package body Sem_Attr is Set_Etype (N, P_Base_Type); Resolve (E1, P_Base_Type); + -------------- + -- From_Any -- + -------------- + + when Attribute_From_Any => + Check_E1; + Check_PolyORB_Attribute; + Set_Etype (N, P_Base_Type); + ----------------------- -- Has_Access_Values -- ----------------------- @@ -4238,6 +4267,15 @@ package body Sem_Attr is Analyze_And_Resolve (E1, Any_Integer); Set_Etype (N, RTE (RE_Address)); + ------------ + -- To_Any -- + ------------ + + when Attribute_To_Any => + Check_E1; + Check_PolyORB_Attribute; + Set_Etype (N, RTE (RE_Any)); + ---------------- -- Truncation -- ---------------- @@ -4257,6 +4295,15 @@ package body Sem_Attr is Check_Not_Incomplete_Type; Set_Etype (N, RTE (RE_Type_Class)); + ------------ + -- To_Any -- + ------------ + + when Attribute_TypeCode => + Check_E0; + Check_PolyORB_Attribute; + Set_Etype (N, RTE (RE_TypeCode)); + ----------------- -- UET_Address -- ----------------- @@ -7253,6 +7300,13 @@ package body Sem_Attr is end if; end Width; + -- The following attributes denote function that cannot be folded + + when Attribute_From_Any | + Attribute_To_Any | + Attribute_TypeCode => + null; + -- The following attributes can never be folded, and furthermore we -- should not even have entered the case statement for any of these. -- Note that in some cases, the values have already been folded as diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 626bee47c1a..f81cca8ea12 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2663,7 +2663,7 @@ package body Sem_Ch10 is -- Build name to be used in implicit with_clause. In most cases this -- is the source name, but if renamings are present we must make the -- original unit visible, not the one it renames. The entity in the - -- use clause is the renamed unit, but the identifier is the one from + -- with clause is the renamed unit, but the identifier is the one from -- the source, which allows us to recover the unit renaming. --------------------- @@ -2708,7 +2708,6 @@ package body Sem_Ch10 is Nkind (Unit_Declaration_Node (Entity (Selector_Name (Nam)))) = N_Package_Renaming_Declaration then - -- The name in the with_clause is of the form A.B.C, and B -- is given by a renaming declaration. In that case we may -- not have analyzed the unit for B, but replaced it directly diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index b2e7d852487..a4abddf2b2a 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3753,6 +3753,38 @@ package body Sem_Ch12 is Analyze_Subprogram_Instantiation (N, E_Procedure); end Analyze_Procedure_Instantiation; + ----------------------------------- + -- Need_Subprogram_Instance_Body -- + ----------------------------------- + + function Need_Subprogram_Instance_Body + (N : Node_Id; + Subp : Entity_Id) return Boolean + is + begin + if (Is_In_Main_Unit (N) + or else Is_Inlined (Subp) + or else Is_Inlined (Alias (Subp))) + and then (Operating_Mode = Generate_Code + or else (Operating_Mode = Check_Semantics + and then ASIS_Mode)) + and then (Expander_Active or else ASIS_Mode) + and then not ABE_Is_Certain (N) + and then not Is_Eliminated (Subp) + then + Pending_Instantiations.Append + ((Inst_Node => N, + Act_Decl => Unit_Declaration_Node (Subp), + Expander_Status => Expander_Active, + Current_Sem_Unit => Current_Sem_Unit, + Scope_Suppress => Scope_Suppress, + Local_Suppress_Stack_Top => Local_Suppress_Stack_Top)); + return True; + else + return False; + end if; + end Need_Subprogram_Instance_Body; + -------------------------------------- -- Analyze_Subprogram_Instantiation -- -------------------------------------- @@ -4144,22 +4176,7 @@ package body Sem_Ch12 is -- If the context requires a full instantiation, mark node for -- subsequent construction of the body. - if (Is_In_Main_Unit (N) - or else Is_Inlined (Act_Decl_Id)) - and then (Operating_Mode = Generate_Code - or else (Operating_Mode = Check_Semantics - and then ASIS_Mode)) - and then (Expander_Active or else ASIS_Mode) - and then not ABE_Is_Certain (N) - and then not Is_Eliminated (Act_Decl_Id) - then - Pending_Instantiations.Append - ((Inst_Node => N, - Act_Decl => Act_Decl, - Expander_Status => Expander_Active, - Current_Sem_Unit => Current_Sem_Unit, - Scope_Suppress => Scope_Suppress, - Local_Suppress_Stack_Top => Local_Suppress_Stack_Top)); + if Need_Subprogram_Instance_Body (N, Act_Decl_Id) then Check_Forward_Instantiation (Gen_Decl); @@ -8699,6 +8716,14 @@ package body Sem_Ch12 is begin Gen_Body_Id := Corresponding_Body (Gen_Decl); + -- Subprogram body may have been created already because of an inline + -- pragma, or because of multiple elaborations of the enclosing package + -- when several instances of the subprogram appear in the main unit. + + if Present (Corresponding_Body (Act_Decl)) then + return; + end if; + Expander_Mode_Save_And_Set (Body_Info.Expander_Status); -- Re-establish the state of information on which checks are suppressed. @@ -10853,11 +10878,11 @@ package body Sem_Ch12 is Set_Is_Immediately_Visible (P, False); -- If the current scope is itself an instantiation of a generic - -- nested within P, and we are in the private part of body of - -- this instantiation, restore the full views of P, that were - -- removed in End_Package_Scope above. This obscure case can - -- occur when a subunit of a generic contains an instance of - -- of a child unit of its generic parent unit. + -- nested within P, and we are in the private part of body of this + -- instantiation, restore the full views of P, that were removed + -- in End_Package_Scope above. This obscure case can occur when a + -- subunit of a generic contains an instance of a child unit of + -- its generic parent unit. elsif S = Current_Scope and then Is_Generic_Instance (S) diff --git a/gcc/ada/sem_ch12.ads b/gcc/ada/sem_ch12.ads index 7ebb2e88342..c3b34173e18 100644 --- a/gcc/ada/sem_ch12.ads +++ b/gcc/ada/sem_ch12.ads @@ -106,6 +106,16 @@ package Sem_Ch12 is -- function and procedure instances. The flag Body_Optional has the -- same purpose as described for Instantiate_Package_Body. + function Need_Subprogram_Instance_Body + (N : Node_Id; + Subp : Entity_Id) return Boolean; + + -- If a subprogram instance is inlined, indicate that the body of it + -- must be created, to be used in inlined calls by the back-end. The + -- subprogram may be inlined because the generic itself carries the + -- pragma, or because a pragma appears for the instance in the scope. + -- of the instance. + procedure Save_Global_References (N : Node_Id); -- Traverse the original generic unit, and capture all references to -- entities that are defined outside of the generic in the analyzed diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index f67d34d60f8..307b6a158b6 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -935,13 +935,25 @@ package body Sem_Ch3 is Build_Itype_Reference (Anon_Type, Parent (Parent (Related_Nod))); -- Similarly, if the access definition is the return result of a - -- protected function, create an itype reference for it because it - -- will be used within the function body. + -- function, create an itype reference for it because it + -- will be used within the function body. For a regular function that + -- is not a compilation unit, insert reference after the declaration. + -- For a protected operation, insert it after the enclosing protected + -- type declaration. In either case, do not create a reference for a + -- type obtained through a limited_with clause, because this would + -- introduce semantic dependencies. elsif Nkind (Related_Nod) = N_Function_Specification - and then Ekind (Current_Scope) = E_Protected_Type + and then not From_With_Type (Anon_Type) then - Build_Itype_Reference (Anon_Type, Parent (Current_Scope)); + if Ekind (Current_Scope) = E_Protected_Type then + Build_Itype_Reference (Anon_Type, Parent (Current_Scope)); + + elsif Is_List_Member (Parent (Related_Nod)) + and then Nkind (Parent (N)) /= N_Parameter_Specification + then + Build_Itype_Reference (Anon_Type, Parent (Related_Nod)); + end if; -- Finally, create an itype reference for an object declaration of -- an anonymous access type. This is strictly necessary only for @@ -1042,7 +1054,9 @@ package body Sem_Ch3 is or else Nkind_In (D_Ityp, N_Object_Declaration, N_Object_Renaming_Declaration, + N_Formal_Object_Declaration, N_Formal_Type_Declaration, + N_Formal_Object_Declaration, N_Task_Type_Declaration, N_Protected_Type_Declaration)) loop @@ -1104,13 +1118,32 @@ package body Sem_Ch3 is if Present (Formals) then Push_Scope (Desig_Type); + + -- A bit of a kludge here. These kludges will be removed when Itypes + -- have proper parent pointers to their declarations??? + + -- Kludge 1) Link definining_identifier of formals. Required by + -- First_Formal to provide its functionality. + + declare + F : Node_Id; + + begin + F := First (Formals); + while Present (F) loop + if No (Parent (Defining_Identifier (F))) then + Set_Parent (Defining_Identifier (F), F); + end if; + + Next (F); + end loop; + end; + Process_Formals (Formals, Parent (T_Def)); - -- A bit of a kludge here, End_Scope requires that the parent - -- pointer be set to something reasonable, but Itypes don't have - -- parent pointers. So we set it and then unset it ??? If and when - -- Itypes have proper parent pointers to their declarations, this - -- kludge can be removed. + -- Kludge 2) End_Scope requires that the parent pointer be set to + -- something reasonable, but Itypes don't have parent pointers. So + -- we set it and then unset it ??? Set_Parent (Desig_Type, T_Name); End_Scope; @@ -4428,6 +4461,10 @@ package body Sem_Ch3 is Comp := Object_Definition (N); Acc := Comp; + when N_Function_Specification => + Comp := Result_Definition (N); + Acc := Comp; + when others => raise Program_Error; end case; @@ -4472,6 +4509,10 @@ package body Sem_Ch3 is elsif Nkind (N) = N_Access_Function_Definition then Rewrite (Comp, New_Occurrence_Of (Anon, Loc)); + elsif Nkind (N) = N_Function_Specification then + Rewrite (Comp, New_Occurrence_Of (Anon, Loc)); + Set_Etype (Defining_Unit_Name (N), Anon); + else Rewrite (Comp, Make_Component_Definition (Loc, diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index d6983b1e648..cd3bb500099 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -498,11 +498,24 @@ package body Sem_Ch4 is Set_Directly_Designated_Type (Acc_Type, Type_Id); Check_Fully_Declared (Type_Id, N); - -- Ada 2005 (AI-231) + -- Ada 2005 (AI-231) If the designated type is itself an access + -- type that excludes null, it's default initializastion will + -- be a null object, and we can insert an unconditional raise + -- before the allocator. if Can_Never_Be_Null (Type_Id) then - Error_Msg_N ("(Ada 2005) qualified expression required", - Expression (N)); + declare + Not_Null_Check : constant Node_Id := + Make_Raise_Constraint_Error (Sloc (E), + Reason => CE_Null_Not_Allowed); + begin + if Expander_Active then + Insert_Action (N, Not_Null_Check); + Analyze (Not_Null_Check); + else + Error_Msg_N ("null value not allowed here?", E); + end if; + end; end if; -- Check restriction against dynamically allocated protected @@ -684,12 +697,16 @@ package body Sem_Ch4 is procedure Analyze_Call (N : Node_Id) is Actuals : constant List_Id := Parameter_Associations (N); - Nam : Node_Id := Name (N); + Nam : Node_Id; X : Interp_Index; It : Interp; Nam_Ent : Entity_Id; Success : Boolean := False; + Deref : Boolean := False; + -- Flag indicates whether an interpretation of the prefix is a + -- parameterless call that returns an access_to_subprogram. + function Name_Denotes_Function return Boolean; -- If the type of the name is an access to subprogram, this may be the -- type of a name, or the return type of the function being called. If @@ -762,6 +779,8 @@ package body Sem_Ch4 is Set_Etype (N, Any_Type); + Nam := Name (N); + if not Is_Overloaded (Nam) then -- Only one interpretation to check @@ -874,6 +893,7 @@ package body Sem_Ch4 is while Present (It.Nam) loop Nam_Ent := It.Nam; + Deref := False; -- Name may be call that returns an access to subprogram, or more -- generally an overloaded expression one of whose interpretations @@ -888,11 +908,17 @@ package body Sem_Ch4 is Nam_Ent := Designated_Type (Nam_Ent); elsif Is_Access_Type (Etype (Nam_Ent)) - and then not Is_Entity_Name (Nam) + and then + (not Is_Entity_Name (Nam) + or else Nkind (N) = N_Procedure_Call_Statement) and then Ekind (Designated_Type (Etype (Nam_Ent))) = E_Subprogram_Type then Nam_Ent := Designated_Type (Etype (Nam_Ent)); + + if Is_Entity_Name (Nam) then + Deref := True; + end if; end if; Analyze_One_Call (N, Nam_Ent, False, Success); @@ -904,7 +930,16 @@ package body Sem_Ch4 is -- guation is done directly in Resolve. if Success then - Set_Etype (Nam, It.Typ); + if Deref + and then Nkind (Parent (N)) /= N_Explicit_Dereference + then + Set_Entity (Nam, It.Nam); + Insert_Explicit_Dereference (Nam); + Set_Etype (Nam, Nam_Ent); + + else + Set_Etype (Nam, It.Typ); + end if; elsif Nkind_In (Name (N), N_Selected_Component, N_Function_Call) @@ -1480,14 +1515,15 @@ package body Sem_Ch4 is and then Is_Overloaded (N) then -- The prefix may include access to subprograms and other access - -- types. If the context selects the interpretation that is a call, - -- we cannot rewrite the node yet, but we include the result of - -- the call interpretation. + -- types. If the context selects the interpretation that is a + -- function call (not a procedure call) we cannot rewrite the node + -- yet, but we include the result of the call interpretation. Get_First_Interp (N, I, It); while Present (It.Nam) loop if Ekind (Base_Type (It.Typ)) = E_Subprogram_Type and then Etype (Base_Type (It.Typ)) /= Standard_Void_Type + and then Nkind (Parent (N)) /= N_Procedure_Call_Statement then Add_One_Interp (N, Etype (It.Typ), Etype (It.Typ)); end if; @@ -2104,11 +2140,12 @@ package body Sem_Ch4 is -- is already known to be compatible, and because this may be an -- indexing of a call with default parameters. - Formal : Entity_Id; - Actual : Node_Id; - Is_Indexed : Boolean := False; - Subp_Type : constant Entity_Id := Etype (Nam); - Norm_OK : Boolean; + Formal : Entity_Id; + Actual : Node_Id; + Is_Indexed : Boolean := False; + Is_Indirect : Boolean := False; + Subp_Type : constant Entity_Id := Etype (Nam); + Norm_OK : Boolean; function Operator_Hidden_By (Fun : Entity_Id) return Boolean; -- There may be a user-defined operator that hides the current @@ -2217,6 +2254,13 @@ package body Sem_Ch4 is -- in prefix notation, so that the rebuilt parameter list has more than -- one actual. + if not Is_Overloadable (Nam) + and then Ekind (Nam) /= E_Subprogram_Type + and then Ekind (Nam) /= E_Entry_Family + then + return; + end if; + if Present (Actuals) and then (Needs_No_Actuals (Nam) @@ -2236,11 +2280,13 @@ package body Sem_Ch4 is -- The prefix can also be a parameterless function that returns an -- access to subprogram, in which case this is an indirect call. + -- If this succeeds, an explicit dereference is added later on, + -- in Analyze_Call or Resolve_Call. elsif Is_Access_Type (Subp_Type) and then Ekind (Designated_Type (Subp_Type)) = E_Subprogram_Type then - Is_Indexed := Try_Indirect_Call (N, Nam, Subp_Type); + Is_Indirect := Try_Indirect_Call (N, Nam, Subp_Type); end if; end if; @@ -2255,13 +2301,21 @@ package body Sem_Ch4 is return; end if; - Normalize_Actuals (N, Nam, (Report and not Is_Indexed), Norm_OK); + Normalize_Actuals + (N, Nam, (Report and not Is_Indexed and not Is_Indirect), Norm_OK); if not Norm_OK then + -- If an indirect call is a possible interpretation, indicate + -- success to the caller. + + if Is_Indirect then + Success := True; + return; + -- Mismatch in number or names of parameters - if Debug_Flag_E then + elsif Debug_Flag_E then Write_Str (" normalization fails in call "); Write_Int (Int (N)); Write_Str (" with subprogram "); @@ -2387,7 +2441,7 @@ package body Sem_Ch4 is Write_Eol; end if; - if Report and not Is_Indexed then + if Report and not Is_Indexed and not Is_Indirect then -- Ada 2005 (AI-251): Complete the error notification -- to help new Ada 2005 users diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 11439419a25..139675969a9 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -579,18 +579,15 @@ package body Sem_Ch5 is end if; end if; - -- Ada 2005 (AI-230 and AI-385): When the lhs type is an anonymous - -- access type, apply an implicit conversion of the rhs to that type - -- to force appropriate static and run-time accessibility checks. - -- This applies as well to anonymous access-to-subprogram types that + -- Ada 2005 (AI-385): When the lhs type is an anonymous access type, + -- apply an implicit conversion of the rhs to that type to force + -- appropriate static and run-time accessibility checks. This + -- applies as well to anonymous access-to-subprogram types that -- are component subtypes. if Ada_Version >= Ada_05 - and then - Is_Access_Type (T1) - and then - (Is_Local_Anonymous_Access (T1) - or else Can_Never_Be_Null (T1)) + and then Is_Access_Type (T1) + and then Is_Local_Anonymous_Access (T1) then Rewrite (Rhs, Convert_To (T1, Relocate_Node (Rhs))); Analyze_And_Resolve (Rhs, T1); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 6583b72537d..ea1a21ed178 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -542,16 +542,33 @@ package body Sem_Ch6 is -- "return access T" case; check that the return statement also has -- "access T", and that the subtypes statically match: + -- if this is an access to subprogram the signatures must match. if R_Type_Is_Anon_Access then if R_Stm_Type_Is_Anon_Access then - if Base_Type (Designated_Type (R_Stm_Type)) /= - Base_Type (Designated_Type (R_Type)) - or else not Subtypes_Statically_Match (R_Stm_Type, R_Type) + if + Ekind (Designated_Type (R_Stm_Type)) /= E_Subprogram_Type then - Error_Msg_N - ("subtype must statically match function result subtype", - Subtype_Mark (Subtype_Ind)); + if Base_Type (Designated_Type (R_Stm_Type)) /= + Base_Type (Designated_Type (R_Type)) + or else not Subtypes_Statically_Match (R_Stm_Type, R_Type) + then + Error_Msg_N + ("subtype must statically match function result subtype", + Subtype_Mark (Subtype_Ind)); + end if; + + else + -- For two anonymous access to subprogram types, the + -- types themselves must be type conformant. + + if not Conforming_Types + (R_Stm_Type, R_Type, Fully_Conformant) + then + Error_Msg_N + ("subtype must statically match function result subtype", + Subtype_Ind); + end if; end if; else @@ -589,17 +606,22 @@ package body Sem_Ch6 is -- definition matches the class-wide type. This prevents rejection -- in the case where the object declaration is initialized by a call -- to a build-in-place function with a specific result type and the - -- object entity had its type changed to that specific type. (Note - -- that the ARG believes that return objects should be allowed to - -- have a type covered by a class-wide result type in any case, so - -- once that relaxation is made (see AI05-32), the above check for - -- type compatibility should be changed to test Covers rather than - -- equality, and then the following special test will no longer be - -- needed. ???) + -- object entity had its type changed to that specific type. This is + -- also allowed in the case where Obj_Decl does not come from source, + -- which can occur for an expansion of a simple return statement of + -- a build-in-place class-wide function when the result expression + -- has a specific type, because a return object with a specific type + -- is created. (Note that the ARG believes that return objects should + -- be allowed to have a type covered by a class-wide result type in + -- any case, so once that relaxation is made (see AI05-32), the above + -- check for type compatibility should be changed to test Covers + -- rather than equality, and the following special test will no + -- longer be needed. ???) elsif Is_Class_Wide_Type (R_Type) and then - R_Type = Etype (Object_Definition (Original_Node (Obj_Decl))) + (R_Type = Etype (Object_Definition (Original_Node (Obj_Decl))) + or else not Comes_From_Source (Obj_Decl)) then null; @@ -1240,7 +1262,20 @@ package body Sem_Ch6 is if Result_Definition (N) /= Error then if Nkind (Result_Definition (N)) = N_Access_Definition then - Typ := Access_Definition (N, Result_Definition (N)); + + -- Ada 2005 (AI-254): Handle anonymous access to subprograms + + declare + AD : constant Node_Id := + Access_To_Subprogram_Definition (Result_Definition (N)); + begin + if Present (AD) and then Protected_Present (AD) then + Typ := Replace_Anonymous_Access_To_Protected_Subprogram (N); + else + Typ := Access_Definition (N, Result_Definition (N)); + end if; + end; + Set_Parent (Typ, Result_Definition (N)); Set_Is_Local_Anonymous_Access (Typ); Set_Etype (Designator, Typ); @@ -1564,6 +1599,7 @@ package body Sem_Ch6 is -- Subprogram_Specification. In such cases, we undo the change -- made by the analysis of the specification and try to find the -- spec again. + -- Note that wrappers already have their corresponding specs and -- bodies set during their creation, so if the candidate spec is -- a wrapper, then we definately need to swap all types to their @@ -2405,17 +2441,6 @@ package body Sem_Ch6 is and then No_Return (Ent) then Set_Trivial_Subprogram (Stm); - - -- If the procedure name is Raise_Exception, then also - -- assume that it raises an exception. The main target - -- here is Ada.Exceptions.Raise_Exception, but this name - -- is pretty evocative in any context! Note that the - -- procedure in Ada.Exceptions is not marked No_Return - -- because of the annoying case of the null exception Id - -- when operating in Ada 95 mode. - - elsif Chars (Ent) = Name_Raise_Exception then - Set_Trivial_Subprogram (Stm); end if; end; end if; @@ -7756,6 +7781,7 @@ package body Sem_Ch6 is -- procedure. Note that it is only at the outer level that we -- do this fiddling, for the spec cases, the already preanalyzed -- parameters are not affected. + -- For a postcondition pragma within a generic, preserve the pragma -- for later expansion. @@ -7784,6 +7810,12 @@ package body Sem_Ch6 is -- Start of processing for Process_PPCs begin + -- Nothing to do if we are not generating code + + if Operating_Mode /= Generate_Code then + return; + end if; + -- Grab preconditions from spec if Present (Spec_Id) then @@ -7891,7 +7923,7 @@ package body Sem_Ch6 is end loop; end if; - -- If we had any postconditions and expansion is enabled,, build + -- If we had any postconditions and expansion is enabled, build -- the Postconditions procedure. if Present (Plist) diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index 177a39ca671..87a0d054451 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -69,7 +69,7 @@ package body Sem_Mech is ("mechanism for & has already been set", Mech_Name, Ent); end if; - -- MECHANISM_NAME ::= value | reference | descriptor + -- MECHANISM_NAME ::= value | reference | descriptor | short_descriptor if Nkind (Mech_Name) = N_Identifier then if Chars (Mech_Name) = Name_Value then @@ -85,6 +85,11 @@ package body Sem_Mech is Set_Mechanism_With_Checks (Ent, By_Descriptor, Mech_Name); return; + elsif Chars (Mech_Name) = Name_Short_Descriptor then + Check_VMS (Mech_Name); + Set_Mechanism_With_Checks (Ent, By_Short_Descriptor, Mech_Name); + return; + elsif Chars (Mech_Name) = Name_Copy then Error_Msg_N ("bad mechanism name, Value assumed", Mech_Name); @@ -95,7 +100,8 @@ package body Sem_Mech is return; end if; - -- MECHANISM_NAME ::= descriptor (CLASS_NAME) + -- MECHANISM_NAME ::= descriptor (CLASS_NAME) | + -- short_descriptor (CLASS_NAME) -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca -- Note: this form is parsed as an indexed component @@ -104,14 +110,16 @@ package body Sem_Mech is Class := First (Expressions (Mech_Name)); if Nkind (Prefix (Mech_Name)) /= N_Identifier - or else Chars (Prefix (Mech_Name)) /= Name_Descriptor + or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else + Chars (Prefix (Mech_Name)) = Name_Short_Descriptor) or else Present (Next (Class)) then Bad_Mechanism; return; end if; - -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) + -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) | + -- short_descriptor (Class => CLASS_NAME) -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca -- Note: this form is parsed as a function call @@ -121,7 +129,8 @@ package body Sem_Mech is Param := First (Parameter_Associations (Mech_Name)); if Nkind (Name (Mech_Name)) /= N_Identifier - or else Chars (Name (Mech_Name)) /= Name_Descriptor + or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else + Chars (Name (Mech_Name)) = Name_Short_Descriptor) or else Present (Next (Param)) or else No (Selector_Name (Param)) or else Chars (Selector_Name (Param)) /= Name_Class @@ -145,27 +154,76 @@ package body Sem_Mech is Bad_Class; return; - elsif Chars (Class) = Name_UBS then + elsif Chars (Name (Mech_Name)) = Name_Descriptor + and then Chars (Class) = Name_UBS + then Set_Mechanism_With_Checks (Ent, By_Descriptor_UBS, Mech_Name); - elsif Chars (Class) = Name_UBSB then + elsif Chars (Name (Mech_Name)) = Name_Descriptor + and then Chars (Class) = Name_UBSB + then Set_Mechanism_With_Checks (Ent, By_Descriptor_UBSB, Mech_Name); - elsif Chars (Class) = Name_UBA then + elsif Chars (Name (Mech_Name)) = Name_Descriptor + and then Chars (Class) = Name_UBA + then Set_Mechanism_With_Checks (Ent, By_Descriptor_UBA, Mech_Name); - elsif Chars (Class) = Name_S then + elsif Chars (Name (Mech_Name)) = Name_Descriptor + and then Chars (Class) = Name_S + then Set_Mechanism_With_Checks (Ent, By_Descriptor_S, Mech_Name); - elsif Chars (Class) = Name_SB then + elsif Chars (Name (Mech_Name)) = Name_Descriptor + and then Chars (Class) = Name_SB + then Set_Mechanism_With_Checks (Ent, By_Descriptor_SB, Mech_Name); - elsif Chars (Class) = Name_A then + elsif Chars (Name (Mech_Name)) = Name_Descriptor + and then Chars (Class) = Name_A + then Set_Mechanism_With_Checks (Ent, By_Descriptor_A, Mech_Name); - elsif Chars (Class) = Name_NCA then + elsif Chars (Name (Mech_Name)) = Name_Descriptor + and then Chars (Class) = Name_NCA + then Set_Mechanism_With_Checks (Ent, By_Descriptor_NCA, Mech_Name); + elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor + and then Chars (Class) = Name_UBS + then + Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBS, Mech_Name); + + elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor + and then Chars (Class) = Name_UBSB + then + Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBSB, Mech_Name); + + elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor + and then Chars (Class) = Name_UBA + then + Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBA, Mech_Name); + + elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor + and then Chars (Class) = Name_S + then + Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_S, Mech_Name); + + elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor + and then Chars (Class) = Name_SB + then + Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_SB, Mech_Name); + + elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor + and then Chars (Class) = Name_A + then + Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_A, Mech_Name); + + elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor + and then Chars (Class) = Name_NCA + then + Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_NCA, Mech_Name); + else Bad_Class; return; diff --git a/gcc/ada/sem_mech.ads b/gcc/ada/sem_mech.ads index 1673a671b0e..93f6080f1f4 100644 --- a/gcc/ada/sem_mech.ads +++ b/gcc/ada/sem_mech.ads @@ -95,6 +95,14 @@ package Sem_Mech is By_Descriptor_SB : constant Mechanism_Type := -8; By_Descriptor_A : constant Mechanism_Type := -9; By_Descriptor_NCA : constant Mechanism_Type := -10; + By_Short_Descriptor : constant Mechanism_Type := -11; + By_Short_Descriptor_UBS : constant Mechanism_Type := -12; + By_Short_Descriptor_UBSB : constant Mechanism_Type := -13; + By_Short_Descriptor_UBA : constant Mechanism_Type := -14; + By_Short_Descriptor_S : constant Mechanism_Type := -15; + By_Short_Descriptor_SB : constant Mechanism_Type := -16; + By_Short_Descriptor_A : constant Mechanism_Type := -17; + By_Short_Descriptor_NCA : constant Mechanism_Type := -18; -- These values are used only in OpenVMS ports of GNAT. Pass by descriptor -- is forced, as described in the OpenVMS ABI. The suffix indicates the -- descriptor type: @@ -113,7 +121,7 @@ package Sem_Mech is -- type based on the Ada type in accordance with the OpenVMS ABI. subtype Descriptor_Codes is Mechanism_Type - range By_Descriptor_NCA .. By_Descriptor; + range By_Short_Descriptor_NCA .. By_Descriptor; -- Subtype including all descriptor mechanisms -- All the above special values are non-positive. Positive values for diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 8d162e6b37b..3ad8ff5d21b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -53,6 +53,7 @@ with Sem_Aux; use Sem_Aux; with Sem_Ch3; use Sem_Ch3; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch12; use Sem_Ch12; with Sem_Ch13; use Sem_Ch13; with Sem_Dist; use Sem_Dist; with Sem_Elim; use Sem_Elim; @@ -1424,7 +1425,18 @@ package body Sem_Prag is P := N; while Present (Prev (P)) loop P := Prev (P); - PO := Original_Node (P); + + -- If the previous node is a generic subprogram, do not go to + -- to the original node, which is the unanalyzed tree: we need + -- to attach the pre/postconditions to the analyzed version + -- at this point. They get propagated to the original tree when + -- analyzing the corresponding body. + + if Nkind (P) not in N_Generic_Declaration then + PO := Original_Node (P); + else + PO := P; + end if; -- Skip past prior pragma @@ -1450,6 +1462,15 @@ package body Sem_Prag is if Nkind (Parent (N)) = N_Subprogram_Body and then List_Containing (N) = Declarations (Parent (N)) then + if Operating_Mode /= Generate_Code then + + -- Analyze expression in pragma, for correctness + -- and for ASIS use. + + Preanalyze_Spec_Expression + (Get_Pragma_Arg (Arg1), Standard_Boolean); + end if; + In_Body := True; return; @@ -2221,7 +2242,6 @@ package body Sem_Prag is Arg1x : constant Node_Id := Get_Pragma_Arg (Arg1); begin - GNAT_Pragma; Check_Arg_Count (2); Check_No_Identifiers; Check_Arg_Is_Static_Expression (Arg2, Standard_String); @@ -2638,8 +2658,6 @@ package body Sem_Prag is Code_Val : Uint; begin - GNAT_Pragma; - if not OpenVMS_On_Target then Error_Pragma ("?pragma% ignored (applies only to Open'V'M'S)"); @@ -2697,8 +2715,6 @@ package body Sem_Prag is (Arg_Internal : Node_Id := Empty) is begin - GNAT_Pragma; - if No (Arg_Internal) then Error_Pragma ("Internal parameter required for pragma%"); end if; @@ -3315,7 +3331,6 @@ package body Sem_Prag is Exp : Node_Id; begin - GNAT_Pragma; Check_No_Identifiers; Check_At_Least_N_Arguments (1); @@ -3752,6 +3767,22 @@ package body Sem_Prag is and then Present (Corresponding_Body (Decl)) then Set_Inline_Flags (Corresponding_Body (Decl)); + + elsif Is_Generic_Instance (Subp) then + + -- Indicate that the body needs to be created for + -- inlining subsequent calls. The instantiation + -- node follows the declaration of the wrapper + -- package created for it. + + if Scope (Subp) /= Standard_Standard + and then + Need_Subprogram_Instance_Body + (Next (Unit_Declaration_Node (Scope (Alias (Subp)))), + Subp) + then + null; + end if; end if; end if; @@ -3870,17 +3901,23 @@ package body Sem_Prag is Link_Nam : Node_Id; String_Val : String_Id; - procedure Check_Form_Of_Interface_Name (SN : Node_Id); + procedure Check_Form_Of_Interface_Name + (SN : Node_Id; + Ext_Name_Case : Boolean); -- SN is a string literal node for an interface name. This routine -- performs some minimal checks that the name is reasonable. In -- particular that no spaces or other obviously incorrect characters -- appear. This is only a warning, since any characters are allowed. + -- Ext_Name_Case is True for an External_Name, False for a Link_Name. ---------------------------------- -- Check_Form_Of_Interface_Name -- ---------------------------------- - procedure Check_Form_Of_Interface_Name (SN : Node_Id) is + procedure Check_Form_Of_Interface_Name + (SN : Node_Id; + Ext_Name_Case : Boolean) + is S : constant String_Id := Strval (Expr_Value_S (SN)); SL : constant Nat := String_Length (S); C : Char_Code; @@ -3893,15 +3930,28 @@ package body Sem_Prag is for J in 1 .. SL loop C := Get_String_Char (S, J); - if Warn_On_Export_Import - and then - (not In_Character_Range (C) - or else (Get_Character (C) = ' ' - and then VM_Target /= CLI_Target) - or else Get_Character (C) = ',') + -- Look for dubious character and issue unconditional warning. + -- Definitely dubious if not in character range. + + if not In_Character_Range (C) + + -- For all cases except external names on CLI target, + -- commas, spaces and slashes are dubious (in CLI, we use + -- spaces and commas in external names to specify assembly + -- version and public key). + + or else ((not Ext_Name_Case or else VM_Target /= CLI_Target) + and then (Get_Character (C) = ' ' + or else + Get_Character (C) = ',' + or else + Get_Character (C) = '/' + or else + Get_Character (C) = '\')) then - Error_Msg_N - ("?interface name contains illegal character", SN); + Error_Msg + ("?interface name contains illegal character", + Sloc (SN) + Source_Ptr (J)); end if; end loop; end Check_Form_Of_Interface_Name; @@ -3946,13 +3996,13 @@ package body Sem_Prag is if Present (Ext_Nam) then Check_Arg_Is_Static_Expression (Ext_Nam, Standard_String); - Check_Form_Of_Interface_Name (Ext_Nam); + Check_Form_Of_Interface_Name (Ext_Nam, Ext_Name_Case => True); - -- Verify that the external name is not the name of a local - -- entity, which would hide the imported one and lead to - -- run-time surprises. The problem can only arise for entities - -- declared in a package body (otherwise the external name is - -- fully qualified and won't conflict). + -- Verify that external name is not the name of a local entity, + -- which would hide the imported one and could lead to run-time + -- surprises. The problem can only arise for entities declared in + -- a package body (otherwise the external name is fully qualified + -- and will not conflict). declare Nam : Name_Id; @@ -3975,10 +4025,10 @@ package body Sem_Prag is Par := Parent (E); while Present (Par) loop if Nkind (Par) = N_Package_Body then - Error_Msg_Sloc := Sloc (E); + Error_Msg_Sloc := Sloc (E); Error_Msg_NE ("imported entity is hidden by & declared#", - Ext_Arg, E); + Ext_Arg, E); exit; end if; @@ -3991,7 +4041,7 @@ package body Sem_Prag is if Present (Link_Nam) then Check_Arg_Is_Static_Expression (Link_Nam, Standard_String); - Check_Form_Of_Interface_Name (Link_Nam); + Check_Form_Of_Interface_Name (Link_Nam, Ext_Name_Case => False); end if; -- If there is no link name, just set the external name @@ -4622,6 +4672,7 @@ package body Sem_Prag is procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is Class : Node_Id; Param : Node_Id; + Mech_Name_Id : Name_Id; procedure Bad_Class; -- Signal bad descriptor class name @@ -4655,7 +4706,8 @@ package body Sem_Prag is ("mechanism for & has already been set", Mech_Name, Ent); end if; - -- MECHANISM_NAME ::= value | reference | descriptor + -- MECHANISM_NAME ::= value | reference | descriptor | + -- short_descriptor if Nkind (Mech_Name) = N_Identifier then if Chars (Mech_Name) = Name_Value then @@ -4671,6 +4723,11 @@ package body Sem_Prag is Set_Mechanism (Ent, By_Descriptor); return; + elsif Chars (Mech_Name) = Name_Short_Descriptor then + Check_VMS (Mech_Name); + Set_Mechanism (Ent, By_Short_Descriptor); + return; + elsif Chars (Mech_Name) = Name_Copy then Error_Pragma_Arg ("bad mechanism name, Value assumed", Mech_Name); @@ -4679,22 +4736,28 @@ package body Sem_Prag is Bad_Mechanism; end if; - -- MECHANISM_NAME ::= descriptor (CLASS_NAME) + -- MECHANISM_NAME ::= descriptor (CLASS_NAME) | + -- short_descriptor (CLASS_NAME) -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca -- Note: this form is parsed as an indexed component elsif Nkind (Mech_Name) = N_Indexed_Component then + Class := First (Expressions (Mech_Name)); if Nkind (Prefix (Mech_Name)) /= N_Identifier - or else Chars (Prefix (Mech_Name)) /= Name_Descriptor - or else Present (Next (Class)) + or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else + Chars (Prefix (Mech_Name)) = Name_Short_Descriptor) + or else Present (Next (Class)) then Bad_Mechanism; + else + Mech_Name_Id := Chars (Prefix (Mech_Name)); end if; - -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) + -- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) | + -- short_descriptor (Class => CLASS_NAME) -- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca -- Note: this form is parsed as a function call @@ -4704,7 +4767,8 @@ package body Sem_Prag is Param := First (Parameter_Associations (Mech_Name)); if Nkind (Name (Mech_Name)) /= N_Identifier - or else Chars (Name (Mech_Name)) /= Name_Descriptor + or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else + Chars (Name (Mech_Name)) = Name_Short_Descriptor) or else Present (Next (Param)) or else No (Selector_Name (Param)) or else Chars (Selector_Name (Param)) /= Name_Class @@ -4712,6 +4776,7 @@ package body Sem_Prag is Bad_Mechanism; else Class := Explicit_Actual_Parameter (Param); + Mech_Name_Id := Chars (Name (Mech_Name)); end if; else @@ -4725,27 +4790,76 @@ package body Sem_Prag is if Nkind (Class) /= N_Identifier then Bad_Class; - elsif Chars (Class) = Name_UBS then + elsif Mech_Name_Id = Name_Descriptor + and then Chars (Class) = Name_UBS + then Set_Mechanism (Ent, By_Descriptor_UBS); - elsif Chars (Class) = Name_UBSB then + elsif Mech_Name_Id = Name_Descriptor + and then Chars (Class) = Name_UBSB + then Set_Mechanism (Ent, By_Descriptor_UBSB); - elsif Chars (Class) = Name_UBA then + elsif Mech_Name_Id = Name_Descriptor + and then Chars (Class) = Name_UBA + then Set_Mechanism (Ent, By_Descriptor_UBA); - elsif Chars (Class) = Name_S then + elsif Mech_Name_Id = Name_Descriptor + and then Chars (Class) = Name_S + then Set_Mechanism (Ent, By_Descriptor_S); - elsif Chars (Class) = Name_SB then + elsif Mech_Name_Id = Name_Descriptor + and then Chars (Class) = Name_SB + then Set_Mechanism (Ent, By_Descriptor_SB); - elsif Chars (Class) = Name_A then + elsif Mech_Name_Id = Name_Descriptor + and then Chars (Class) = Name_A + then Set_Mechanism (Ent, By_Descriptor_A); - elsif Chars (Class) = Name_NCA then + elsif Mech_Name_Id = Name_Descriptor + and then Chars (Class) = Name_NCA + then Set_Mechanism (Ent, By_Descriptor_NCA); + elsif Mech_Name_Id = Name_Short_Descriptor + and then Chars (Class) = Name_UBS + then + Set_Mechanism (Ent, By_Short_Descriptor_UBS); + + elsif Mech_Name_Id = Name_Short_Descriptor + and then Chars (Class) = Name_UBSB + then + Set_Mechanism (Ent, By_Short_Descriptor_UBSB); + + elsif Mech_Name_Id = Name_Short_Descriptor + and then Chars (Class) = Name_UBA + then + Set_Mechanism (Ent, By_Short_Descriptor_UBA); + + elsif Mech_Name_Id = Name_Short_Descriptor + and then Chars (Class) = Name_S + then + Set_Mechanism (Ent, By_Short_Descriptor_S); + + elsif Mech_Name_Id = Name_Short_Descriptor + and then Chars (Class) = Name_SB + then + Set_Mechanism (Ent, By_Short_Descriptor_SB); + + elsif Mech_Name_Id = Name_Short_Descriptor + and then Chars (Class) = Name_A + then + Set_Mechanism (Ent, By_Short_Descriptor_A); + + elsif Mech_Name_Id = Name_Short_Descriptor + and then Chars (Class) = Name_NCA + then + Set_Mechanism (Ent, By_Short_Descriptor_NCA); + else Bad_Class; end if; @@ -5540,18 +5654,6 @@ package body Sem_Prag is end if; end C_Pass_By_Copy; - ----------------------- - -- Canonical_Streams -- - ----------------------- - - -- pragma Canonical_Streams; - - when Pragma_Canonical_Streams => - GNAT_Pragma; - Check_Arg_Count (0); - Check_Valid_Configuration_Pragma; - Canonical_Streams := True; - ----------- -- Check -- ----------- @@ -5715,11 +5817,11 @@ package body Sem_Prag is -- pragma Comment (static_string_EXPRESSION) - -- Processing for pragma Comment shares the circuitry for - -- pragma Ident. The only differences are that Ident enforces - -- a limit of 31 characters on its argument, and also enforces - -- limitations on placement for DEC compatibility. Pragma - -- Comment shares neither of these restrictions. + -- Processing for pragma Comment shares the circuitry for pragma + -- Ident. The only differences are that Ident enforces a limit of 31 + -- characters on its argument, and also enforces limitations on + -- placement for DEC compatibility. Pragma Comment shares neither of + -- these restrictions. ------------------- -- Common_Object -- @@ -5740,6 +5842,7 @@ package body Sem_Prag is -- (boolean_EXPRESSION, static_string_EXPRESSION); when Pragma_Compile_Time_Error => + GNAT_Pragma; Process_Compile_Time_Warning_Or_Error; -------------------------- @@ -5750,6 +5853,7 @@ package body Sem_Prag is -- (boolean_EXPRESSION, static_string_EXPRESSION); when Pragma_Compile_Time_Warning => + GNAT_Pragma; Process_Compile_Time_Warning_Or_Error; ------------------- @@ -6124,6 +6228,8 @@ package body Sem_Prag is when Pragma_CPP_Virtual => CPP_Virtual : declare begin + GNAT_Pragma; + if Warn_On_Obsolescent_Feature then Error_Msg_N ("'G'N'A'T pragma cpp'_virtual is now obsolete and has " & @@ -6137,6 +6243,8 @@ package body Sem_Prag is when Pragma_CPP_Vtable => CPP_Vtable : declare begin + GNAT_Pragma; + if Warn_On_Obsolescent_Feature then Error_Msg_N ("'G'N'A'T pragma cpp'_vtable is now obsolete and has " & @@ -6656,6 +6764,8 @@ package body Sem_Prag is Code : Node_Id renames Args (4); begin + GNAT_Pragma; + if Inside_A_Generic then Error_Pragma ("pragma% cannot be used for generic entities"); end if; @@ -7125,6 +7235,7 @@ package body Sem_Prag is Typ : Entity_Id; begin + GNAT_Pragma; Check_No_Identifiers; Check_Arg_Count (1); Check_Arg_Is_Local_Name (Arg1); @@ -7458,6 +7569,7 @@ package body Sem_Prag is Code : Node_Id renames Args (4); begin + GNAT_Pragma; Gather_Associations (Names, Args); if Present (External) and then Present (Code) then @@ -7743,6 +7855,7 @@ package body Sem_Prag is -- pragma Inline_Always ( NAME {, NAME} ); when Pragma_Inline_Always => + GNAT_Pragma; Process_Inline (True); -------------------- @@ -7752,6 +7865,7 @@ package body Sem_Prag is -- pragma Inline_Generic (NAME {, NAME}); when Pragma_Inline_Generic => + GNAT_Pragma; Process_Generic_List; ---------------------- @@ -8782,6 +8896,7 @@ package body Sem_Prag is -- it was misplaced. when Pragma_No_Body => + GNAT_Pragma; Pragma_Misplaced; --------------- @@ -8848,13 +8963,43 @@ package body Sem_Prag is end loop; end No_Return; + ----------------- + -- No_Run_Time -- + ----------------- + + -- pragma No_Run_Time; + + -- Note: this pragma is retained for backwards compatibility. + -- See body of Rtsfind for full details on its handling. + + when Pragma_No_Run_Time => + GNAT_Pragma; + Check_Valid_Configuration_Pragma; + Check_Arg_Count (0); + + No_Run_Time_Mode := True; + Configurable_Run_Time_Mode := True; + + -- Set Duration to 32 bits if word size is 32 + + if Ttypes.System_Word_Size = 32 then + Duration_32_Bits_On_Target := True; + end if; + + -- Set appropriate restrictions + + Set_Restriction (No_Finalization, N); + Set_Restriction (No_Exception_Handlers, N); + Set_Restriction (Max_Tasks, N, 0); + Set_Restriction (No_Tasking, N); + ------------------------ -- No_Strict_Aliasing -- ------------------------ -- pragma No_Strict_Aliasing [([Entity =>] type_LOCAL_NAME)]; - when Pragma_No_Strict_Aliasing => No_Strict_Alias : declare + when Pragma_No_Strict_Aliasing => No_Strict_Aliasing : declare E_Id : Entity_Id; begin @@ -8878,7 +9023,20 @@ package body Sem_Prag is Set_No_Strict_Aliasing (Implementation_Base_Type (E_Id)); end if; - end No_Strict_Alias; + end No_Strict_Aliasing; + + ----------------------- + -- Normalize_Scalars -- + ----------------------- + + -- pragma Normalize_Scalars; + + when Pragma_Normalize_Scalars => + Check_Ada_83_Warning; + Check_Arg_Count (0); + Check_Valid_Configuration_Pragma; + Normalize_Scalars := True; + Init_Or_Norm_Scalars := True; ----------------- -- Obsolescent -- @@ -9086,49 +9244,6 @@ package body Sem_Prag is end if; end Obsolescent; - ----------------- - -- No_Run_Time -- - ----------------- - - -- pragma No_Run_Time - - -- Note: this pragma is retained for backwards compatibility. - -- See body of Rtsfind for full details on its handling. - - when Pragma_No_Run_Time => - GNAT_Pragma; - Check_Valid_Configuration_Pragma; - Check_Arg_Count (0); - - No_Run_Time_Mode := True; - Configurable_Run_Time_Mode := True; - - -- Set Duration to 32 bits if word size is 32 - - if Ttypes.System_Word_Size = 32 then - Duration_32_Bits_On_Target := True; - end if; - - -- Set appropriate restrictions - - Set_Restriction (No_Finalization, N); - Set_Restriction (No_Exception_Handlers, N); - Set_Restriction (Max_Tasks, N, 0); - Set_Restriction (No_Tasking, N); - - ----------------------- - -- Normalize_Scalars -- - ----------------------- - - -- pragma Normalize_Scalars; - - when Pragma_Normalize_Scalars => - Check_Ada_83_Warning; - Check_Arg_Count (0); - Check_Valid_Configuration_Pragma; - Normalize_Scalars := True; - Init_Or_Norm_Scalars := True; - -------------- -- Optimize -- -------------- @@ -9365,19 +9480,6 @@ package body Sem_Prag is end if; end Preelab_Init; - ------------- - -- Polling -- - ------------- - - -- pragma Polling (ON | OFF); - - when Pragma_Polling => - GNAT_Pragma; - Check_Arg_Count (1); - Check_No_Identifiers; - Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off); - Polling_Required := (Chars (Expression (Arg1)) = Name_On); - -------------------- -- Persistent_BSS -- -------------------- @@ -9436,6 +9538,19 @@ package body Sem_Prag is end if; end Persistent_BSS; + ------------- + -- Polling -- + ------------- + + -- pragma Polling (ON | OFF); + + when Pragma_Polling => + GNAT_Pragma; + Check_Arg_Count (1); + Check_No_Identifiers; + Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off); + Polling_Required := (Chars (Expression (Arg1)) = Name_On); + ------------------- -- Postcondition -- ------------------- @@ -10952,6 +11067,7 @@ package body Sem_Prag is -- or the identifier GCC, no other identifiers are acceptable. when Pragma_System_Name => + GNAT_Pragma; Check_No_Identifiers; Check_Arg_Count (1); Check_Arg_Is_One_Of (Arg1, Name_Gcc, Name_Gnat); @@ -11200,7 +11316,7 @@ package body Sem_Prag is Variant : Node_Id; begin - GNAT_Pragma; + Ada_2005_Pragma; Check_No_Identifiers; Check_Arg_Count (1); Check_Arg_Is_Local_Name (Arg1); @@ -11567,7 +11683,7 @@ package body Sem_Prag is -- pragma Unsuppress (IDENTIFIER [, [On =>] NAME]); when Pragma_Unsuppress => - GNAT_Pragma; + Ada_2005_Pragma; Process_Suppress_Unsuppress (False); ------------------- @@ -11891,6 +12007,7 @@ package body Sem_Prag is -- pragma Wide_Character_Encoding (IDENTIFIER); when Pragma_Wide_Character_Encoding => + GNAT_Pragma; -- Nothing to do, handled in parser. Note that we do not enforce -- configuration pragma placement, this pragma can appear at any @@ -12093,7 +12210,6 @@ package body Sem_Prag is Pragma_Atomic => 0, Pragma_Atomic_Components => 0, Pragma_Attach_Handler => -1, - Pragma_Canonical_Streams => -1, Pragma_Check => 99, Pragma_Check_Name => 0, Pragma_Check_Policy => 0, diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e0118685ea0..4e0e0dedfcd 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -446,16 +446,18 @@ package body Sem_Res is return; end if; - -- Detect a common beginner error: + -- Detect a common error: -- type R (D : Positive := 100) is record -- Name : String (1 .. D); -- end record; - -- The default value causes an object of type R to be - -- allocated with room for Positive'Last characters. + -- The default value causes an object of type R to be allocated + -- with room for Positive'Last characters. The RM does not mandate + -- the allocation of the maximum size, but that is what GNAT does + -- so we should warn the programmer that there is a problem. - declare + Check_Large : declare SI : Node_Id; T : Entity_Id; TB : Node_Id; @@ -480,9 +482,11 @@ package body Sem_Res is and then Compile_Time_Known_Value (Type_High_Bound (T)) and then Minimum_Size (T, Biased => True) >= - Esize (Standard_Integer) - 1; + RM_Size (Standard_Positive); end Large_Storage_Type; + -- Start of processing for Check_Large + begin -- Check that the Disc has a large range @@ -553,7 +557,7 @@ package body Sem_Res is <<No_Danger>> null; - end; + end Check_Large; end if; -- Legal case is in index or discriminant constraint @@ -754,7 +758,22 @@ package body Sem_Res is C := N; loop P := Parent (C); + + -- If no parent, then we were not inside a subprogram, this can for + -- example happen when processing certain pragmas in a spec. Just + -- return False in this case. + + if No (P) then + return False; + end if; + + -- Done if we get to subprogram body, this is definitely an infinite + -- recursion case if we did not find anything to stop us. + exit when Nkind (P) = N_Subprogram_Body; + + -- If appearing in conditional, result is false + if Nkind_In (P, N_Or_Else, N_And_Then, N_If_Statement, @@ -4677,6 +4696,25 @@ package body Sem_Res is end loop; end if; + if Ekind (Etype (Nam)) = E_Access_Subprogram_Type + and then Ekind (Typ) /= E_Access_Subprogram_Type + and then Nkind (Subp) /= N_Explicit_Dereference + and then Present (Parameter_Associations (N)) + then + -- The prefix is a parameterless function call that returns an + -- access to subprogram. If parameters are present in the current + -- call add an explicit dereference. + + -- The dereference is added either in Analyze_Call or here. Should + -- be consolidated ??? + + Set_Is_Overloaded (Subp, False); + Set_Etype (Subp, Etype (Nam)); + Insert_Explicit_Dereference (Subp); + Nam := Designated_Type (Etype (Nam)); + Resolve (Subp, Nam); + end if; + -- Check that a call to Current_Task does not occur in an entry body if Is_RTE (Nam, RE_Current_Task) then @@ -6538,8 +6576,8 @@ package body Sem_Res is procedure Resolve_Membership_Op (N : Node_Id; Typ : Entity_Id) is pragma Warnings (Off, Typ); - L : constant Node_Id := Left_Opnd (N); - R : constant Node_Id := Right_Opnd (N); + L : constant Node_Id := Left_Opnd (N); + R : constant Node_Id := Right_Opnd (N); T : Entity_Id; begin @@ -6604,6 +6642,8 @@ package body Sem_Res is ------------------ procedure Resolve_Null (N : Node_Id; Typ : Entity_Id) is + Loc : constant Source_Ptr := Sloc (N); + begin -- Handle restriction against anonymous null access values This -- restriction can be turned off using -gnatdj. @@ -6632,6 +6672,26 @@ package body Sem_Res is end if; end if; + -- Ada 2005 (AI-231): Generate the null-excluding check in case of + -- assignment to a null-excluding object + + if Ada_Version >= Ada_05 + and then Can_Never_Be_Null (Typ) + and then Nkind (Parent (N)) = N_Assignment_Statement + then + if not Inside_Init_Proc then + Insert_Action + (Compile_Time_Constraint_Error (N, + "(Ada 2005) null not allowed in null-excluding objects?"), + Make_Raise_Constraint_Error (Loc, + Reason => CE_Access_Check_Failed)); + else + Insert_Action (N, + Make_Raise_Constraint_Error (Loc, + Reason => CE_Access_Check_Failed)); + end if; + end if; + -- In a distributed context, null for a remote access to subprogram -- may need to be replaced with a special record aggregate. In this -- case, return after having done the transformation. @@ -9459,7 +9519,27 @@ package body Sem_Res is (not Is_Constrained (Opnd) or else not Is_Constrained (Target))) then - return True; + -- Special case, if Value_Size has been used to make the + -- sizes different, the conversion is not allowed even + -- though the subtypes statically match. + + if Known_Static_RM_Size (Target) + and then Known_Static_RM_Size (Opnd) + and then RM_Size (Target) /= RM_Size (Opnd) + then + Error_Msg_NE + ("target designated subtype not compatible with }", + N, Opnd); + Error_Msg_NE + ("\because sizes of the two designated subtypes differ", + N, Opnd); + return False; + + -- Normal case where conversion is allowed + + else + return True; + end if; else Error_Msg_NE @@ -9472,16 +9552,21 @@ package body Sem_Res is -- Access to subprogram types. If the operand is an access parameter, -- the type has a deeper accessibility that any master, and cannot - -- be assigned. + -- be assigned. We must make an exception if the conversion is part + -- of an assignment and the target is the return object of an extended + -- return statement, because in that case the accessibility check + -- takes place after the return. - elsif (Ekind (Target_Type) = E_Access_Subprogram_Type - or else - Ekind (Target_Type) = E_Anonymous_Access_Subprogram_Type) + elsif Ekind (Target_Type) in Access_Subprogram_Kind and then No (Corresponding_Remote_Type (Opnd_Type)) then if Ekind (Base_Type (Opnd_Type)) = E_Anonymous_Access_Subprogram_Type and then Is_Entity_Name (Operand) and then Ekind (Entity (Operand)) = E_In_Parameter + and then + (Nkind (Parent (N)) /= N_Assignment_Statement + or else not Is_Entity_Name (Name (Parent (N))) + or else not Is_Return_Object (Entity (Name (Parent (N))))) then Error_Msg_N ("illegal attempt to store anonymous access to subprogram", diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index aae54d1f67e..bdd1c388220 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -766,7 +766,7 @@ package body Sem_Type is if T1 = T2 then return True; - elsif BT1 = BT2 + elsif BT1 = BT2 or else BT1 = T2 or else BT2 = T1 then diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 64d5cfb674b..00c1e380d88 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -246,7 +246,7 @@ package Sem_Util is -- families constrained by discriminants. function Denotes_Variable (N : Node_Id) return Boolean; - -- Returns True if node N denotes a single variable without parentheses. + -- Returns True if node N denotes a single variable without parentheses function Depends_On_Discriminant (N : Node_Id) return Boolean; -- Returns True if N denotes a discriminant or if N is a range, a subtype diff --git a/gcc/ada/sequenio.ads b/gcc/ada/sequenio.ads index 7fdf72d782f..42522fb9072 100644 --- a/gcc/ada/sequenio.ads +++ b/gcc/ada/sequenio.ads @@ -15,9 +15,9 @@ pragma Ada_2005; -- Explicit setting of Ada 2005 mode is required here, since we want to with a --- child unit (not possible in Ada 83 mode), and Text_IO is not considered to --- be an internal unit that is automatically compiled in Ada 2005 mode (since --- a user is allowed to redeclare Sequential_IO). +-- child unit (not possible in Ada 83 mode), and Sequential_IO is not +-- considered to be an internal unit that is automatically compiled in Ada +-- 2005 mode (since a user is allowed to redeclare Sequential_IO). with Ada.Sequential_IO; diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index eee61f664e0..8bb6778fbd7 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -28,6 +28,8 @@ with Atree; use Atree; with Debug; use Debug; with Einfo; use Einfo; with Errout; use Errout; +with Fname; use Fname; +with Hostparm; with Opt; use Opt; with Osint; use Osint; with Output; use Output; @@ -39,6 +41,8 @@ with Sinfo; use Sinfo; with Snames; use Snames; with System; use System; +with System.OS_Lib; use System.OS_Lib; + with Unchecked_Conversion; package body Sinput.L is @@ -319,7 +323,7 @@ package body Sinput.L is -- source will be the last created, and we will be able to replace it -- and modify Hi without stepping on another buffer. - if T = Osint.Source then + if T = Osint.Source and then not Is_Internal_File_Name (N) then Prepare_To_Preprocess (Source => N, Preprocessing_Needed => Preprocessing_Needed); end if; @@ -475,6 +479,8 @@ package body Sinput.L is -- Saved state of the Style_Check flag (which needs to be -- temporarily set to False during preprocessing, see below). + Modified : Boolean; + begin -- If this is the first time we preprocess a source, allocate -- the preprocessing buffer. @@ -512,7 +518,7 @@ package body Sinput.L is Save_Style_Check := Opt.Style_Check; Opt.Style_Check := False; - Preprocess; + Preprocess (Modified); -- Reset the scanner to its standard behavior, and restore the -- Style_Checks flag. @@ -531,6 +537,54 @@ package body Sinput.L is return No_Source_File; else + -- Output the result of the preprocessing, if requested and + -- the source has been modified by the preprocessing. + + if Generate_Processed_File and then Modified then + declare + FD : File_Descriptor; + NB : Integer; + Status : Boolean; + + begin + Get_Name_String (N); + + if Hostparm.OpenVMS then + Add_Str_To_Name_Buffer ("_prep"); + else + Add_Str_To_Name_Buffer (".prep"); + end if; + + Delete_File (Name_Buffer (1 .. Name_Len), Status); + + FD := + Create_New_File (Name_Buffer (1 .. Name_Len), Text); + + Status := FD /= Invalid_FD; + + if Status then + NB := + Write + (FD, + Prep_Buffer (1)'Address, + Integer (Prep_Buffer_Last)); + Status := NB = Integer (Prep_Buffer_Last); + end if; + + if Status then + Close (FD, Status); + end if; + + if not Status then + Errout.Error_Msg + ("could not write processed file """ & + Name_Buffer (1 .. Name_Len) & '"', + Lo); + return No_Source_File; + end if; + end; + end if; + -- Set the new value of Hi Hi := Lo + Source_Ptr (Prep_Buffer_Last); diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index aaea3c8c15d..3936b5b311f 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -649,7 +649,7 @@ package body Sinput is Chr : constant Character := Source (P); begin - if Chr = CR then + if Chr = CR then if Source (P + 1) = LF then P := P + 2; else diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index e97ef15c19c..d038e4372a4 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -104,9 +104,6 @@ package body Snames is "finalize#" & "next#" & "prev#" & - "_typecode#" & - "_from_any#" & - "_to_any#" & "allocate#" & "deallocate#" & "dereference#" & @@ -183,7 +180,6 @@ package body Snames is "ada_2005#" & "assertion_policy#" & "c_pass_by_copy#" & - "canonical_streams#" & "check_name#" & "check_policy#" & "compile_time_error#" & @@ -415,6 +411,7 @@ package body Snames is "secondary_stack_size#" & "section#" & "semaphore#" & + "short_descriptor#" & "simple_barriers#" & "spec_file_name#" & "state#" & @@ -557,6 +554,7 @@ package body Snames is "copy_sign#" & "floor#" & "fraction#" & + "from_any#" & "image#" & "input#" & "machine#" & @@ -567,7 +565,9 @@ package body Snames is "remainder#" & "rounding#" & "succ#" & + "to_any#" & "truncation#" & + "typecode#" & "value#" & "wide_image#" & "wide_wide_image#" & @@ -727,6 +727,7 @@ package body Snames is "extends#" & "externally_built#" & "finder#" & + "global_compilation_switches#" & "global_configuration_pragmas#" & "global_config_file#" & "gnatls#" & @@ -779,6 +780,7 @@ package body Snames is "objects_path#" & "objects_path_file#" & "object_dir#" & + "path_syntax#" & "pic_option#" & "pretty_printer#" & "prefix#" & diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index 3a93bef1fa6..8037ee18934 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -40,7 +40,7 @@ package Snames is -- the definitions of some enumeration types whose definitions are tied to -- the order of these preset names. --- WARNING: There is a C file, a-snames.h which duplicates some of the +-- WARNING: There is a C file, snames.h which duplicates some of the -- definitions in this file and must be kept properly synchronized. -- If you change this package, you should run xsnames. @@ -199,116 +199,110 @@ package Snames is Name_Next : constant Name_Id := N + 044; Name_Prev : constant Name_Id := N + 045; - -- Names of TSS routines for implementation of DSA over PolyORB - - Name_uTypeCode : constant Name_Id := N + 046; - Name_uFrom_Any : constant Name_Id := N + 047; - Name_uTo_Any : constant Name_Id := N + 048; - -- Names of allocation routines, also needed by expander - Name_Allocate : constant Name_Id := N + 049; - Name_Deallocate : constant Name_Id := N + 050; - Name_Dereference : constant Name_Id := N + 051; + Name_Allocate : constant Name_Id := N + 046; + Name_Deallocate : constant Name_Id := N + 047; + Name_Dereference : constant Name_Id := N + 048; -- Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge) - First_Text_IO_Package : constant Name_Id := N + 052; - Name_Decimal_IO : constant Name_Id := N + 052; - Name_Enumeration_IO : constant Name_Id := N + 053; - Name_Fixed_IO : constant Name_Id := N + 054; - Name_Float_IO : constant Name_Id := N + 055; - Name_Integer_IO : constant Name_Id := N + 056; - Name_Modular_IO : constant Name_Id := N + 057; - Last_Text_IO_Package : constant Name_Id := N + 057; + First_Text_IO_Package : constant Name_Id := N + 049; + Name_Decimal_IO : constant Name_Id := N + 049; + Name_Enumeration_IO : constant Name_Id := N + 050; + Name_Fixed_IO : constant Name_Id := N + 051; + Name_Float_IO : constant Name_Id := N + 052; + Name_Integer_IO : constant Name_Id := N + 053; + Name_Modular_IO : constant Name_Id := N + 054; + Last_Text_IO_Package : constant Name_Id := N + 054; subtype Text_IO_Package_Name is Name_Id range First_Text_IO_Package .. Last_Text_IO_Package; -- Some miscellaneous names used for error detection/recovery - Name_Const : constant Name_Id := N + 058; - Name_Error : constant Name_Id := N + 059; - Name_Go : constant Name_Id := N + 060; - Name_Put : constant Name_Id := N + 061; - Name_Put_Line : constant Name_Id := N + 062; - Name_To : constant Name_Id := N + 063; + Name_Const : constant Name_Id := N + 055; + Name_Error : constant Name_Id := N + 056; + Name_Go : constant Name_Id := N + 057; + Name_Put : constant Name_Id := N + 058; + Name_Put_Line : constant Name_Id := N + 059; + Name_To : constant Name_Id := N + 060; -- Names for packages that are treated specially by the compiler - Name_Exception_Traces : constant Name_Id := N + 064; - Name_Finalization : constant Name_Id := N + 065; - Name_Finalization_Root : constant Name_Id := N + 066; - Name_Interfaces : constant Name_Id := N + 067; - Name_Most_Recent_Exception : constant Name_Id := N + 068; - Name_Standard : constant Name_Id := N + 069; - Name_System : constant Name_Id := N + 070; - Name_Text_IO : constant Name_Id := N + 071; - Name_Wide_Text_IO : constant Name_Id := N + 072; - Name_Wide_Wide_Text_IO : constant Name_Id := N + 073; + Name_Exception_Traces : constant Name_Id := N + 061; + Name_Finalization : constant Name_Id := N + 062; + Name_Finalization_Root : constant Name_Id := N + 063; + Name_Interfaces : constant Name_Id := N + 064; + Name_Most_Recent_Exception : constant Name_Id := N + 065; + Name_Standard : constant Name_Id := N + 066; + Name_System : constant Name_Id := N + 067; + Name_Text_IO : constant Name_Id := N + 068; + Name_Wide_Text_IO : constant Name_Id := N + 069; + Name_Wide_Wide_Text_IO : constant Name_Id := N + 070; -- Names of implementations of the distributed systems annex - First_PCS_Name : constant Name_Id := N + 074; - Name_No_DSA : constant Name_Id := N + 074; - Name_GARLIC_DSA : constant Name_Id := N + 075; - Name_PolyORB_DSA : constant Name_Id := N + 076; - Last_PCS_Name : constant Name_Id := N + 076; + First_PCS_Name : constant Name_Id := N + 071; + Name_No_DSA : constant Name_Id := N + 071; + Name_GARLIC_DSA : constant Name_Id := N + 072; + Name_PolyORB_DSA : constant Name_Id := N + 073; + Last_PCS_Name : constant Name_Id := N + 073; subtype PCS_Names is Name_Id range First_PCS_Name .. Last_PCS_Name; -- Names of identifiers used in expanding distribution stubs - Name_Addr : constant Name_Id := N + 077; - Name_Async : constant Name_Id := N + 078; - Name_Get_Active_Partition_ID : constant Name_Id := N + 079; - Name_Get_RCI_Package_Receiver : constant Name_Id := N + 080; - Name_Get_RCI_Package_Ref : constant Name_Id := N + 081; - Name_Origin : constant Name_Id := N + 082; - Name_Params : constant Name_Id := N + 083; - Name_Partition : constant Name_Id := N + 084; - Name_Partition_Interface : constant Name_Id := N + 085; - Name_Ras : constant Name_Id := N + 086; - Name_uCall : constant Name_Id := N + 087; - Name_RCI_Name : constant Name_Id := N + 088; - Name_Receiver : constant Name_Id := N + 089; - Name_Rpc : constant Name_Id := N + 090; - Name_Subp_Id : constant Name_Id := N + 091; - Name_Operation : constant Name_Id := N + 092; - Name_Argument : constant Name_Id := N + 093; - Name_Arg_Modes : constant Name_Id := N + 094; - Name_Handler : constant Name_Id := N + 095; - Name_Target : constant Name_Id := N + 096; - Name_Req : constant Name_Id := N + 097; - Name_Obj_TypeCode : constant Name_Id := N + 098; - Name_Stub : constant Name_Id := N + 099; + Name_Addr : constant Name_Id := N + 074; + Name_Async : constant Name_Id := N + 075; + Name_Get_Active_Partition_ID : constant Name_Id := N + 076; + Name_Get_RCI_Package_Receiver : constant Name_Id := N + 077; + Name_Get_RCI_Package_Ref : constant Name_Id := N + 078; + Name_Origin : constant Name_Id := N + 079; + Name_Params : constant Name_Id := N + 080; + Name_Partition : constant Name_Id := N + 081; + Name_Partition_Interface : constant Name_Id := N + 082; + Name_Ras : constant Name_Id := N + 083; + Name_uCall : constant Name_Id := N + 084; + Name_RCI_Name : constant Name_Id := N + 085; + Name_Receiver : constant Name_Id := N + 086; + Name_Rpc : constant Name_Id := N + 087; + Name_Subp_Id : constant Name_Id := N + 088; + Name_Operation : constant Name_Id := N + 089; + Name_Argument : constant Name_Id := N + 090; + Name_Arg_Modes : constant Name_Id := N + 091; + Name_Handler : constant Name_Id := N + 092; + Name_Target : constant Name_Id := N + 093; + Name_Req : constant Name_Id := N + 094; + Name_Obj_TypeCode : constant Name_Id := N + 095; + Name_Stub : constant Name_Id := N + 096; -- Operator Symbol entries. The actual names have an upper case O at -- the start in place of the Op_ prefix (e.g. the actual name that -- corresponds to Name_Op_Abs is "Oabs". - First_Operator_Name : constant Name_Id := N + 100; - Name_Op_Abs : constant Name_Id := N + 100; -- "abs" - Name_Op_And : constant Name_Id := N + 101; -- "and" - Name_Op_Mod : constant Name_Id := N + 102; -- "mod" - Name_Op_Not : constant Name_Id := N + 103; -- "not" - Name_Op_Or : constant Name_Id := N + 104; -- "or" - Name_Op_Rem : constant Name_Id := N + 105; -- "rem" - Name_Op_Xor : constant Name_Id := N + 106; -- "xor" - Name_Op_Eq : constant Name_Id := N + 107; -- "=" - Name_Op_Ne : constant Name_Id := N + 108; -- "/=" - Name_Op_Lt : constant Name_Id := N + 109; -- "<" - Name_Op_Le : constant Name_Id := N + 110; -- "<=" - Name_Op_Gt : constant Name_Id := N + 111; -- ">" - Name_Op_Ge : constant Name_Id := N + 112; -- ">=" - Name_Op_Add : constant Name_Id := N + 113; -- "+" - Name_Op_Subtract : constant Name_Id := N + 114; -- "-" - Name_Op_Concat : constant Name_Id := N + 115; -- "&" - Name_Op_Multiply : constant Name_Id := N + 116; -- "*" - Name_Op_Divide : constant Name_Id := N + 117; -- "/" - Name_Op_Expon : constant Name_Id := N + 118; -- "**" - Last_Operator_Name : constant Name_Id := N + 118; + First_Operator_Name : constant Name_Id := N + 097; + Name_Op_Abs : constant Name_Id := N + 097; -- "abs" + Name_Op_And : constant Name_Id := N + 098; -- "and" + Name_Op_Mod : constant Name_Id := N + 099; -- "mod" + Name_Op_Not : constant Name_Id := N + 100; -- "not" + Name_Op_Or : constant Name_Id := N + 101; -- "or" + Name_Op_Rem : constant Name_Id := N + 102; -- "rem" + Name_Op_Xor : constant Name_Id := N + 103; -- "xor" + Name_Op_Eq : constant Name_Id := N + 104; -- "=" + Name_Op_Ne : constant Name_Id := N + 105; -- "/=" + Name_Op_Lt : constant Name_Id := N + 106; -- "<" + Name_Op_Le : constant Name_Id := N + 107; -- "<=" + Name_Op_Gt : constant Name_Id := N + 108; -- ">" + Name_Op_Ge : constant Name_Id := N + 109; -- ">=" + Name_Op_Add : constant Name_Id := N + 110; -- "+" + Name_Op_Subtract : constant Name_Id := N + 111; -- "-" + Name_Op_Concat : constant Name_Id := N + 112; -- "&" + Name_Op_Multiply : constant Name_Id := N + 113; -- "*" + Name_Op_Divide : constant Name_Id := N + 114; -- "/" + Name_Op_Expon : constant Name_Id := N + 115; -- "**" + Last_Operator_Name : constant Name_Id := N + 115; -- Names for all pragmas recognized by GNAT. The entries with the comment -- "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95. @@ -331,32 +325,31 @@ package Snames is -- only in GNAT for the AAMP. They are ignored in other versions with -- appropriate warnings. - First_Pragma_Name : constant Name_Id := N + 119; + First_Pragma_Name : constant Name_Id := N + 116; -- Configuration pragmas are grouped at start - Name_Ada_83 : constant Name_Id := N + 119; -- GNAT - Name_Ada_95 : constant Name_Id := N + 120; -- GNAT - Name_Ada_05 : constant Name_Id := N + 121; -- GNAT - Name_Ada_2005 : constant Name_Id := N + 122; -- GNAT - Name_Assertion_Policy : constant Name_Id := N + 123; -- Ada 05 - Name_C_Pass_By_Copy : constant Name_Id := N + 124; -- GNAT - Name_Canonical_Streams : constant Name_Id := N + 125; -- GNAT - Name_Check_Name : constant Name_Id := N + 126; -- GNAT - Name_Check_Policy : constant Name_Id := N + 127; -- GNAT - Name_Compile_Time_Error : constant Name_Id := N + 128; -- GNAT - Name_Compile_Time_Warning : constant Name_Id := N + 129; -- GNAT - Name_Compiler_Unit : constant Name_Id := N + 130; -- GNAT - Name_Component_Alignment : constant Name_Id := N + 131; -- GNAT - Name_Convention_Identifier : constant Name_Id := N + 132; -- GNAT - Name_Debug_Policy : constant Name_Id := N + 133; -- GNAT - Name_Detect_Blocking : constant Name_Id := N + 134; -- Ada 05 - Name_Discard_Names : constant Name_Id := N + 135; - Name_Elaboration_Checks : constant Name_Id := N + 136; -- GNAT - Name_Eliminate : constant Name_Id := N + 137; -- GNAT - Name_Extend_System : constant Name_Id := N + 138; -- GNAT - Name_Extensions_Allowed : constant Name_Id := N + 139; -- GNAT - Name_External_Name_Casing : constant Name_Id := N + 140; -- GNAT + Name_Ada_83 : constant Name_Id := N + 116; -- GNAT + Name_Ada_95 : constant Name_Id := N + 117; -- GNAT + Name_Ada_05 : constant Name_Id := N + 118; -- GNAT + Name_Ada_2005 : constant Name_Id := N + 119; -- GNAT + Name_Assertion_Policy : constant Name_Id := N + 120; -- Ada 05 + Name_C_Pass_By_Copy : constant Name_Id := N + 121; -- GNAT + Name_Check_Name : constant Name_Id := N + 122; -- GNAT + Name_Check_Policy : constant Name_Id := N + 123; -- GNAT + Name_Compile_Time_Error : constant Name_Id := N + 124; -- GNAT + Name_Compile_Time_Warning : constant Name_Id := N + 125; -- GNAT + Name_Compiler_Unit : constant Name_Id := N + 126; -- GNAT + Name_Component_Alignment : constant Name_Id := N + 127; -- GNAT + Name_Convention_Identifier : constant Name_Id := N + 128; -- GNAT + Name_Debug_Policy : constant Name_Id := N + 129; -- GNAT + Name_Detect_Blocking : constant Name_Id := N + 130; -- Ada 05 + Name_Discard_Names : constant Name_Id := N + 131; + Name_Elaboration_Checks : constant Name_Id := N + 132; -- GNAT + Name_Eliminate : constant Name_Id := N + 133; -- GNAT + Name_Extend_System : constant Name_Id := N + 134; -- GNAT + Name_Extensions_Allowed : constant Name_Id := N + 135; -- GNAT + Name_External_Name_Casing : constant Name_Id := N + 136; -- GNAT -- Note: Fast_Math is not in this list because its name matches -- GNAT -- the name of the corresponding attribute. However, it is @@ -364,49 +357,49 @@ package Snames is -- functions Get_Pragma_Id, Is_[Configuration_]Pragma_Id, and -- correctly recognize and process Fast_Math. - Name_Favor_Top_Level : constant Name_Id := N + 141; -- GNAT - Name_Float_Representation : constant Name_Id := N + 142; -- GNAT - Name_Implicit_Packing : constant Name_Id := N + 143; -- GNAT - Name_Initialize_Scalars : constant Name_Id := N + 144; -- GNAT - Name_Interrupt_State : constant Name_Id := N + 145; -- GNAT - Name_License : constant Name_Id := N + 146; -- GNAT - Name_Locking_Policy : constant Name_Id := N + 147; - Name_Long_Float : constant Name_Id := N + 148; -- VMS - Name_No_Run_Time : constant Name_Id := N + 149; -- GNAT - Name_No_Strict_Aliasing : constant Name_Id := N + 150; -- GNAT - Name_Normalize_Scalars : constant Name_Id := N + 151; - Name_Optimize_Alignment : constant Name_Id := N + 152; -- GNAT - Name_Persistent_BSS : constant Name_Id := N + 153; -- GNAT - Name_Polling : constant Name_Id := N + 154; -- GNAT - Name_Priority_Specific_Dispatching : constant Name_Id := N + 155; -- Ada 05 - Name_Profile : constant Name_Id := N + 156; -- Ada 05 - Name_Profile_Warnings : constant Name_Id := N + 157; -- GNAT - Name_Propagate_Exceptions : constant Name_Id := N + 158; -- GNAT - Name_Queuing_Policy : constant Name_Id := N + 159; - Name_Ravenscar : constant Name_Id := N + 160; -- GNAT - Name_Restricted_Run_Time : constant Name_Id := N + 161; -- GNAT - Name_Restrictions : constant Name_Id := N + 162; - Name_Restriction_Warnings : constant Name_Id := N + 163; -- GNAT - Name_Reviewable : constant Name_Id := N + 164; - Name_Source_File_Name : constant Name_Id := N + 165; -- GNAT - Name_Source_File_Name_Project : constant Name_Id := N + 166; -- GNAT - Name_Style_Checks : constant Name_Id := N + 167; -- GNAT - Name_Suppress : constant Name_Id := N + 168; - Name_Suppress_Exception_Locations : constant Name_Id := N + 169; -- GNAT - Name_Task_Dispatching_Policy : constant Name_Id := N + 170; - Name_Universal_Data : constant Name_Id := N + 171; -- AAMP - Name_Unsuppress : constant Name_Id := N + 172; -- GNAT - Name_Use_VADS_Size : constant Name_Id := N + 173; -- GNAT - Name_Validity_Checks : constant Name_Id := N + 174; -- GNAT - Name_Warnings : constant Name_Id := N + 175; -- GNAT - Name_Wide_Character_Encoding : constant Name_Id := N + 176; -- GNAT - Last_Configuration_Pragma_Name : constant Name_Id := N + 176; + Name_Favor_Top_Level : constant Name_Id := N + 137; -- GNAT + Name_Float_Representation : constant Name_Id := N + 138; -- GNAT + Name_Implicit_Packing : constant Name_Id := N + 139; -- GNAT + Name_Initialize_Scalars : constant Name_Id := N + 140; -- GNAT + Name_Interrupt_State : constant Name_Id := N + 141; -- GNAT + Name_License : constant Name_Id := N + 142; -- GNAT + Name_Locking_Policy : constant Name_Id := N + 143; + Name_Long_Float : constant Name_Id := N + 144; -- VMS + Name_No_Run_Time : constant Name_Id := N + 145; -- GNAT + Name_No_Strict_Aliasing : constant Name_Id := N + 146; -- GNAT + Name_Normalize_Scalars : constant Name_Id := N + 147; + Name_Optimize_Alignment : constant Name_Id := N + 148; -- GNAT + Name_Persistent_BSS : constant Name_Id := N + 149; -- GNAT + Name_Polling : constant Name_Id := N + 150; -- GNAT + Name_Priority_Specific_Dispatching : constant Name_Id := N + 151; -- Ada 05 + Name_Profile : constant Name_Id := N + 152; -- Ada 05 + Name_Profile_Warnings : constant Name_Id := N + 153; -- GNAT + Name_Propagate_Exceptions : constant Name_Id := N + 154; -- GNAT + Name_Queuing_Policy : constant Name_Id := N + 155; + Name_Ravenscar : constant Name_Id := N + 156; -- GNAT + Name_Restricted_Run_Time : constant Name_Id := N + 157; -- GNAT + Name_Restrictions : constant Name_Id := N + 158; + Name_Restriction_Warnings : constant Name_Id := N + 159; -- GNAT + Name_Reviewable : constant Name_Id := N + 160; + Name_Source_File_Name : constant Name_Id := N + 161; -- GNAT + Name_Source_File_Name_Project : constant Name_Id := N + 162; -- GNAT + Name_Style_Checks : constant Name_Id := N + 163; -- GNAT + Name_Suppress : constant Name_Id := N + 164; + Name_Suppress_Exception_Locations : constant Name_Id := N + 165; -- GNAT + Name_Task_Dispatching_Policy : constant Name_Id := N + 166; + Name_Universal_Data : constant Name_Id := N + 167; -- AAMP + Name_Unsuppress : constant Name_Id := N + 168; -- Ada 05 + Name_Use_VADS_Size : constant Name_Id := N + 169; -- GNAT + Name_Validity_Checks : constant Name_Id := N + 170; -- GNAT + Name_Warnings : constant Name_Id := N + 171; -- GNAT + Name_Wide_Character_Encoding : constant Name_Id := N + 172; -- GNAT + Last_Configuration_Pragma_Name : constant Name_Id := N + 172; -- Remaining pragma names - Name_Abort_Defer : constant Name_Id := N + 177; -- GNAT - Name_All_Calls_Remote : constant Name_Id := N + 178; - Name_Annotate : constant Name_Id := N + 179; -- GNAT + Name_Abort_Defer : constant Name_Id := N + 173; -- GNAT + Name_All_Calls_Remote : constant Name_Id := N + 174; + Name_Annotate : constant Name_Id := N + 175; -- GNAT -- Note: AST_Entry is not in this list because its name matches -- VMS -- the name of the corresponding attribute. However, it is @@ -414,77 +407,83 @@ package Snames is -- functions Get_Pragma_Id and Is_Pragma_Id correctly recognize -- and process Name_AST_Entry. - Name_Assert : constant Name_Id := N + 180; -- Ada 05 - Name_Asynchronous : constant Name_Id := N + 181; - Name_Atomic : constant Name_Id := N + 182; - Name_Atomic_Components : constant Name_Id := N + 183; - Name_Attach_Handler : constant Name_Id := N + 184; - Name_Check : constant Name_Id := N + 185; -- GNAT - Name_CIL_Constructor : constant Name_Id := N + 186; -- GNAT - Name_Comment : constant Name_Id := N + 187; -- GNAT - Name_Common_Object : constant Name_Id := N + 188; -- GNAT - Name_Complete_Representation : constant Name_Id := N + 189; -- GNAT - Name_Complex_Representation : constant Name_Id := N + 190; -- GNAT - Name_Controlled : constant Name_Id := N + 191; - Name_Convention : constant Name_Id := N + 192; - Name_CPP_Class : constant Name_Id := N + 193; -- GNAT - Name_CPP_Constructor : constant Name_Id := N + 194; -- GNAT - Name_CPP_Virtual : constant Name_Id := N + 195; -- GNAT - Name_CPP_Vtable : constant Name_Id := N + 196; -- GNAT - Name_Debug : constant Name_Id := N + 197; -- GNAT - Name_Elaborate : constant Name_Id := N + 198; -- Ada 83 - Name_Elaborate_All : constant Name_Id := N + 199; - Name_Elaborate_Body : constant Name_Id := N + 200; - Name_Export : constant Name_Id := N + 201; - Name_Export_Exception : constant Name_Id := N + 202; -- VMS - Name_Export_Function : constant Name_Id := N + 203; -- GNAT - Name_Export_Object : constant Name_Id := N + 204; -- GNAT - Name_Export_Procedure : constant Name_Id := N + 205; -- GNAT - Name_Export_Value : constant Name_Id := N + 206; -- GNAT - Name_Export_Valued_Procedure : constant Name_Id := N + 207; -- GNAT - Name_External : constant Name_Id := N + 208; -- GNAT - Name_Finalize_Storage_Only : constant Name_Id := N + 209; -- GNAT - Name_Ident : constant Name_Id := N + 210; -- VMS - Name_Implemented_By_Entry : constant Name_Id := N + 211; -- Ada 05 - Name_Import : constant Name_Id := N + 212; - Name_Import_Exception : constant Name_Id := N + 213; -- VMS - Name_Import_Function : constant Name_Id := N + 214; -- GNAT - Name_Import_Object : constant Name_Id := N + 215; -- GNAT - Name_Import_Procedure : constant Name_Id := N + 216; -- GNAT - Name_Import_Valued_Procedure : constant Name_Id := N + 217; -- GNAT - Name_Inline : constant Name_Id := N + 218; - Name_Inline_Always : constant Name_Id := N + 219; -- GNAT - Name_Inline_Generic : constant Name_Id := N + 220; -- GNAT - Name_Inspection_Point : constant Name_Id := N + 221; - Name_Interface_Name : constant Name_Id := N + 222; -- GNAT - Name_Interrupt_Handler : constant Name_Id := N + 223; - Name_Interrupt_Priority : constant Name_Id := N + 224; - Name_Java_Constructor : constant Name_Id := N + 225; -- GNAT - Name_Java_Interface : constant Name_Id := N + 226; -- GNAT - Name_Keep_Names : constant Name_Id := N + 227; -- GNAT - Name_Link_With : constant Name_Id := N + 228; -- GNAT - Name_Linker_Alias : constant Name_Id := N + 229; -- GNAT - Name_Linker_Constructor : constant Name_Id := N + 230; -- GNAT - Name_Linker_Destructor : constant Name_Id := N + 231; -- GNAT - Name_Linker_Options : constant Name_Id := N + 232; - Name_Linker_Section : constant Name_Id := N + 233; -- GNAT - Name_List : constant Name_Id := N + 234; - Name_Machine_Attribute : constant Name_Id := N + 235; -- GNAT - Name_Main : constant Name_Id := N + 236; -- GNAT - Name_Main_Storage : constant Name_Id := N + 237; -- GNAT - Name_Memory_Size : constant Name_Id := N + 238; -- Ada 83 - Name_No_Body : constant Name_Id := N + 239; -- GNAT - Name_No_Return : constant Name_Id := N + 240; -- GNAT - Name_Obsolescent : constant Name_Id := N + 241; -- GNAT - Name_Optimize : constant Name_Id := N + 242; - Name_Pack : constant Name_Id := N + 243; - Name_Page : constant Name_Id := N + 244; - Name_Passive : constant Name_Id := N + 245; -- GNAT - Name_Postcondition : constant Name_Id := N + 246; -- GNAT - Name_Precondition : constant Name_Id := N + 247; -- GNAT - Name_Preelaborable_Initialization : constant Name_Id := N + 248; -- Ada 05 - Name_Preelaborate : constant Name_Id := N + 249; - Name_Preelaborate_05 : constant Name_Id := N + 250; -- GNAT + Name_Assert : constant Name_Id := N + 176; -- Ada 05 + Name_Asynchronous : constant Name_Id := N + 177; + Name_Atomic : constant Name_Id := N + 178; + Name_Atomic_Components : constant Name_Id := N + 179; + Name_Attach_Handler : constant Name_Id := N + 180; + Name_Check : constant Name_Id := N + 181; -- GNAT + Name_CIL_Constructor : constant Name_Id := N + 182; -- GNAT + Name_Comment : constant Name_Id := N + 183; -- GNAT + Name_Common_Object : constant Name_Id := N + 184; -- GNAT + Name_Complete_Representation : constant Name_Id := N + 185; -- GNAT + Name_Complex_Representation : constant Name_Id := N + 186; -- GNAT + Name_Controlled : constant Name_Id := N + 187; + Name_Convention : constant Name_Id := N + 188; + Name_CPP_Class : constant Name_Id := N + 189; -- GNAT + Name_CPP_Constructor : constant Name_Id := N + 190; -- GNAT + Name_CPP_Virtual : constant Name_Id := N + 191; -- GNAT + Name_CPP_Vtable : constant Name_Id := N + 192; -- GNAT + Name_Debug : constant Name_Id := N + 193; -- GNAT + Name_Elaborate : constant Name_Id := N + 194; -- Ada 83 + Name_Elaborate_All : constant Name_Id := N + 195; + Name_Elaborate_Body : constant Name_Id := N + 196; + Name_Export : constant Name_Id := N + 197; + Name_Export_Exception : constant Name_Id := N + 198; -- VMS + Name_Export_Function : constant Name_Id := N + 199; -- GNAT + Name_Export_Object : constant Name_Id := N + 200; -- GNAT + Name_Export_Procedure : constant Name_Id := N + 201; -- GNAT + Name_Export_Value : constant Name_Id := N + 202; -- GNAT + Name_Export_Valued_Procedure : constant Name_Id := N + 203; -- GNAT + Name_External : constant Name_Id := N + 204; -- GNAT + Name_Finalize_Storage_Only : constant Name_Id := N + 205; -- GNAT + Name_Ident : constant Name_Id := N + 206; -- VMS + Name_Implemented_By_Entry : constant Name_Id := N + 207; -- Ada 05 + Name_Import : constant Name_Id := N + 208; + Name_Import_Exception : constant Name_Id := N + 209; -- VMS + Name_Import_Function : constant Name_Id := N + 210; -- GNAT + Name_Import_Object : constant Name_Id := N + 211; -- GNAT + Name_Import_Procedure : constant Name_Id := N + 212; -- GNAT + Name_Import_Valued_Procedure : constant Name_Id := N + 213; -- GNAT + Name_Inline : constant Name_Id := N + 214; + Name_Inline_Always : constant Name_Id := N + 215; -- GNAT + Name_Inline_Generic : constant Name_Id := N + 216; -- GNAT + Name_Inspection_Point : constant Name_Id := N + 217; + + -- Note: Interface is not in this list because its name matches -- GNAT + -- an Ada 2005 keyword. However it is included in the definition + -- of the type Attribute_Id, and the functions Get_Pragma_Id and + -- Is_Pragma_Id correctly recognize and process Name_Storage_Size. + + Name_Interface_Name : constant Name_Id := N + 218; -- GNAT + Name_Interrupt_Handler : constant Name_Id := N + 219; + Name_Interrupt_Priority : constant Name_Id := N + 220; + Name_Java_Constructor : constant Name_Id := N + 221; -- GNAT + Name_Java_Interface : constant Name_Id := N + 222; -- GNAT + Name_Keep_Names : constant Name_Id := N + 223; -- GNAT + Name_Link_With : constant Name_Id := N + 224; -- GNAT + Name_Linker_Alias : constant Name_Id := N + 225; -- GNAT + Name_Linker_Constructor : constant Name_Id := N + 226; -- GNAT + Name_Linker_Destructor : constant Name_Id := N + 227; -- GNAT + Name_Linker_Options : constant Name_Id := N + 228; + Name_Linker_Section : constant Name_Id := N + 229; -- GNAT + Name_List : constant Name_Id := N + 230; + Name_Machine_Attribute : constant Name_Id := N + 231; -- GNAT + Name_Main : constant Name_Id := N + 232; -- GNAT + Name_Main_Storage : constant Name_Id := N + 233; -- GNAT + Name_Memory_Size : constant Name_Id := N + 234; -- Ada 83 + Name_No_Body : constant Name_Id := N + 235; -- GNAT + Name_No_Return : constant Name_Id := N + 236; -- GNAT + Name_Obsolescent : constant Name_Id := N + 237; -- GNAT + Name_Optimize : constant Name_Id := N + 238; + Name_Pack : constant Name_Id := N + 239; + Name_Page : constant Name_Id := N + 240; + Name_Passive : constant Name_Id := N + 241; -- GNAT + Name_Postcondition : constant Name_Id := N + 242; -- GNAT + Name_Precondition : constant Name_Id := N + 243; -- GNAT + Name_Preelaborable_Initialization : constant Name_Id := N + 244; -- Ada 05 + Name_Preelaborate : constant Name_Id := N + 245; + Name_Preelaborate_05 : constant Name_Id := N + 246; -- GNAT -- Note: Priority is not in this list because its name matches -- the name of the corresponding attribute. However, it is @@ -492,16 +491,16 @@ package Snames is -- functions Get_Pragma_Id and Is_Pragma_Id correctly recognize -- and process Priority. Priority is a standard Ada 95 pragma. - Name_Psect_Object : constant Name_Id := N + 251; -- VMS - Name_Pure : constant Name_Id := N + 252; - Name_Pure_05 : constant Name_Id := N + 253; -- GNAT - Name_Pure_Function : constant Name_Id := N + 254; -- GNAT - Name_Relative_Deadline : constant Name_Id := N + 255; -- Ada 05 - Name_Remote_Call_Interface : constant Name_Id := N + 256; - Name_Remote_Types : constant Name_Id := N + 257; - Name_Share_Generic : constant Name_Id := N + 258; -- GNAT - Name_Shared : constant Name_Id := N + 259; -- Ada 83 - Name_Shared_Passive : constant Name_Id := N + 260; + Name_Psect_Object : constant Name_Id := N + 247; -- VMS + Name_Pure : constant Name_Id := N + 248; + Name_Pure_05 : constant Name_Id := N + 249; -- GNAT + Name_Pure_Function : constant Name_Id := N + 250; -- GNAT + Name_Relative_Deadline : constant Name_Id := N + 251; -- Ada 05 + Name_Remote_Call_Interface : constant Name_Id := N + 252; + Name_Remote_Types : constant Name_Id := N + 253; + Name_Share_Generic : constant Name_Id := N + 254; -- GNAT + Name_Shared : constant Name_Id := N + 255; -- Ada 83 + Name_Shared_Passive : constant Name_Id := N + 256; -- Note: Storage_Size is not in this list because its name -- matches the name of the corresponding attribute. However, @@ -512,30 +511,30 @@ package Snames is -- Note: Storage_Unit is also omitted from the list because -- of a clash with an attribute name, and is treated similarly. - Name_Source_Reference : constant Name_Id := N + 261; -- GNAT - Name_Static_Elaboration_Desired : constant Name_Id := N + 262; -- GNAT - Name_Stream_Convert : constant Name_Id := N + 263; -- GNAT - Name_Subtitle : constant Name_Id := N + 264; -- GNAT - Name_Suppress_All : constant Name_Id := N + 265; -- GNAT - Name_Suppress_Debug_Info : constant Name_Id := N + 266; -- GNAT - Name_Suppress_Initialization : constant Name_Id := N + 267; -- GNAT - Name_System_Name : constant Name_Id := N + 268; -- Ada 83 - Name_Task_Info : constant Name_Id := N + 269; -- GNAT - Name_Task_Name : constant Name_Id := N + 270; -- GNAT - Name_Task_Storage : constant Name_Id := N + 271; -- VMS - Name_Time_Slice : constant Name_Id := N + 272; -- GNAT - Name_Title : constant Name_Id := N + 273; -- GNAT - Name_Unchecked_Union : constant Name_Id := N + 274; -- GNAT - Name_Unimplemented_Unit : constant Name_Id := N + 275; -- GNAT - Name_Universal_Aliasing : constant Name_Id := N + 276; -- GNAT - Name_Unmodified : constant Name_Id := N + 277; -- GNAT - Name_Unreferenced : constant Name_Id := N + 278; -- GNAT - Name_Unreferenced_Objects : constant Name_Id := N + 279; -- GNAT - Name_Unreserve_All_Interrupts : constant Name_Id := N + 280; -- GNAT - Name_Volatile : constant Name_Id := N + 281; - Name_Volatile_Components : constant Name_Id := N + 282; - Name_Weak_External : constant Name_Id := N + 283; -- GNAT - Last_Pragma_Name : constant Name_Id := N + 283; + Name_Source_Reference : constant Name_Id := N + 257; -- GNAT + Name_Static_Elaboration_Desired : constant Name_Id := N + 258; -- GNAT + Name_Stream_Convert : constant Name_Id := N + 259; -- GNAT + Name_Subtitle : constant Name_Id := N + 260; -- GNAT + Name_Suppress_All : constant Name_Id := N + 261; -- GNAT + Name_Suppress_Debug_Info : constant Name_Id := N + 262; -- GNAT + Name_Suppress_Initialization : constant Name_Id := N + 263; -- GNAT + Name_System_Name : constant Name_Id := N + 264; -- Ada 83 + Name_Task_Info : constant Name_Id := N + 265; -- GNAT + Name_Task_Name : constant Name_Id := N + 266; -- GNAT + Name_Task_Storage : constant Name_Id := N + 267; -- VMS + Name_Time_Slice : constant Name_Id := N + 268; -- GNAT + Name_Title : constant Name_Id := N + 269; -- GNAT + Name_Unchecked_Union : constant Name_Id := N + 270; -- Ada 05 + Name_Unimplemented_Unit : constant Name_Id := N + 271; -- GNAT + Name_Universal_Aliasing : constant Name_Id := N + 272; -- GNAT + Name_Unmodified : constant Name_Id := N + 273; -- GNAT + Name_Unreferenced : constant Name_Id := N + 274; -- GNAT + Name_Unreferenced_Objects : constant Name_Id := N + 275; -- GNAT + Name_Unreserve_All_Interrupts : constant Name_Id := N + 276; -- GNAT + Name_Volatile : constant Name_Id := N + 277; + Name_Volatile_Components : constant Name_Id := N + 278; + Name_Weak_External : constant Name_Id := N + 279; -- GNAT + Last_Pragma_Name : constant Name_Id := N + 279; -- Language convention names for pragma Convention/Export/Import/Interface -- Note that Name_C is not included in this list, since it was already @@ -546,119 +545,120 @@ package Snames is -- Entry and Protected, this is because these conventions cannot be -- specified by a pragma. - First_Convention_Name : constant Name_Id := N + 284; - Name_Ada : constant Name_Id := N + 284; - Name_Assembler : constant Name_Id := N + 285; - Name_CIL : constant Name_Id := N + 286; - Name_COBOL : constant Name_Id := N + 287; - Name_CPP : constant Name_Id := N + 288; - Name_Fortran : constant Name_Id := N + 289; - Name_Intrinsic : constant Name_Id := N + 290; - Name_Java : constant Name_Id := N + 291; - Name_Stdcall : constant Name_Id := N + 292; - Name_Stubbed : constant Name_Id := N + 293; - Last_Convention_Name : constant Name_Id := N + 293; + First_Convention_Name : constant Name_Id := N + 280; + Name_Ada : constant Name_Id := N + 280; + Name_Assembler : constant Name_Id := N + 281; + Name_CIL : constant Name_Id := N + 282; + Name_COBOL : constant Name_Id := N + 283; + Name_CPP : constant Name_Id := N + 284; + Name_Fortran : constant Name_Id := N + 285; + Name_Intrinsic : constant Name_Id := N + 286; + Name_Java : constant Name_Id := N + 287; + Name_Stdcall : constant Name_Id := N + 288; + Name_Stubbed : constant Name_Id := N + 289; + Last_Convention_Name : constant Name_Id := N + 289; -- The following names are preset as synonyms for Assembler - Name_Asm : constant Name_Id := N + 294; - Name_Assembly : constant Name_Id := N + 295; + Name_Asm : constant Name_Id := N + 290; + Name_Assembly : constant Name_Id := N + 291; -- The following names are preset as synonyms for C - Name_Default : constant Name_Id := N + 296; + Name_Default : constant Name_Id := N + 292; -- Name_External (previously defined as pragma) -- The following names are preset as synonyms for CPP - Name_C_Plus_Plus : constant Name_Id := N + 297; + Name_C_Plus_Plus : constant Name_Id := N + 293; -- The following names are present as synonyms for Stdcall - Name_DLL : constant Name_Id := N + 298; - Name_Win32 : constant Name_Id := N + 299; + Name_DLL : constant Name_Id := N + 294; + Name_Win32 : constant Name_Id := N + 295; -- Other special names used in processing pragmas - Name_As_Is : constant Name_Id := N + 300; - Name_Assertion : constant Name_Id := N + 301; - Name_Attribute_Name : constant Name_Id := N + 302; - Name_Body_File_Name : constant Name_Id := N + 303; - Name_Boolean_Entry_Barriers : constant Name_Id := N + 304; - Name_Casing : constant Name_Id := N + 305; - Name_Code : constant Name_Id := N + 306; - Name_Component : constant Name_Id := N + 307; - Name_Component_Size_4 : constant Name_Id := N + 308; - Name_Copy : constant Name_Id := N + 309; - Name_D_Float : constant Name_Id := N + 310; - Name_Descriptor : constant Name_Id := N + 311; - Name_Dot_Replacement : constant Name_Id := N + 312; - Name_Dynamic : constant Name_Id := N + 313; - Name_Entity : constant Name_Id := N + 314; - Name_Entry_Count : constant Name_Id := N + 315; - Name_External_Name : constant Name_Id := N + 316; - Name_First_Optional_Parameter : constant Name_Id := N + 317; - Name_Form : constant Name_Id := N + 318; - Name_G_Float : constant Name_Id := N + 319; - Name_Gcc : constant Name_Id := N + 320; - Name_Gnat : constant Name_Id := N + 321; - Name_GPL : constant Name_Id := N + 322; - Name_IEEE_Float : constant Name_Id := N + 323; - Name_Ignore : constant Name_Id := N + 324; - Name_Info : constant Name_Id := N + 325; - Name_Internal : constant Name_Id := N + 326; - Name_Link_Name : constant Name_Id := N + 327; - Name_Lowercase : constant Name_Id := N + 328; - Name_Max_Entry_Queue_Depth : constant Name_Id := N + 329; - Name_Max_Entry_Queue_Length : constant Name_Id := N + 330; - Name_Max_Size : constant Name_Id := N + 331; - Name_Mechanism : constant Name_Id := N + 332; - Name_Message : constant Name_Id := N + 333; - Name_Mixedcase : constant Name_Id := N + 334; - Name_Modified_GPL : constant Name_Id := N + 335; - Name_Name : constant Name_Id := N + 336; - Name_NCA : constant Name_Id := N + 337; - Name_No : constant Name_Id := N + 338; - Name_No_Dependence : constant Name_Id := N + 339; - Name_No_Dynamic_Attachment : constant Name_Id := N + 340; - Name_No_Dynamic_Interrupts : constant Name_Id := N + 341; - Name_No_Requeue : constant Name_Id := N + 342; - Name_No_Requeue_Statements : constant Name_Id := N + 343; - Name_No_Task_Attributes : constant Name_Id := N + 344; - Name_No_Task_Attributes_Package : constant Name_Id := N + 345; - Name_On : constant Name_Id := N + 346; - Name_Parameter_Types : constant Name_Id := N + 347; - Name_Reference : constant Name_Id := N + 348; - Name_Restricted : constant Name_Id := N + 349; - Name_Result_Mechanism : constant Name_Id := N + 350; - Name_Result_Type : constant Name_Id := N + 351; - Name_Runtime : constant Name_Id := N + 352; - Name_SB : constant Name_Id := N + 353; - Name_Secondary_Stack_Size : constant Name_Id := N + 354; - Name_Section : constant Name_Id := N + 355; - Name_Semaphore : constant Name_Id := N + 356; - Name_Simple_Barriers : constant Name_Id := N + 357; - Name_Spec_File_Name : constant Name_Id := N + 358; - Name_State : constant Name_Id := N + 359; - Name_Static : constant Name_Id := N + 360; - Name_Stack_Size : constant Name_Id := N + 361; - Name_Subunit_File_Name : constant Name_Id := N + 362; - Name_Task_Stack_Size_Default : constant Name_Id := N + 363; - Name_Task_Type : constant Name_Id := N + 364; - Name_Time_Slicing_Enabled : constant Name_Id := N + 365; - Name_Top_Guard : constant Name_Id := N + 366; - Name_UBA : constant Name_Id := N + 367; - Name_UBS : constant Name_Id := N + 368; - Name_UBSB : constant Name_Id := N + 369; - Name_Unit_Name : constant Name_Id := N + 370; - Name_Unknown : constant Name_Id := N + 371; - Name_Unrestricted : constant Name_Id := N + 372; - Name_Uppercase : constant Name_Id := N + 373; - Name_User : constant Name_Id := N + 374; - Name_VAX_Float : constant Name_Id := N + 375; - Name_VMS : constant Name_Id := N + 376; - Name_Vtable_Ptr : constant Name_Id := N + 377; - Name_Working_Storage : constant Name_Id := N + 378; + Name_As_Is : constant Name_Id := N + 296; + Name_Assertion : constant Name_Id := N + 297; + Name_Attribute_Name : constant Name_Id := N + 298; + Name_Body_File_Name : constant Name_Id := N + 299; + Name_Boolean_Entry_Barriers : constant Name_Id := N + 300; + Name_Casing : constant Name_Id := N + 301; + Name_Code : constant Name_Id := N + 302; + Name_Component : constant Name_Id := N + 303; + Name_Component_Size_4 : constant Name_Id := N + 304; + Name_Copy : constant Name_Id := N + 305; + Name_D_Float : constant Name_Id := N + 306; + Name_Descriptor : constant Name_Id := N + 307; + Name_Dot_Replacement : constant Name_Id := N + 308; + Name_Dynamic : constant Name_Id := N + 309; + Name_Entity : constant Name_Id := N + 310; + Name_Entry_Count : constant Name_Id := N + 311; + Name_External_Name : constant Name_Id := N + 312; + Name_First_Optional_Parameter : constant Name_Id := N + 313; + Name_Form : constant Name_Id := N + 314; + Name_G_Float : constant Name_Id := N + 315; + Name_Gcc : constant Name_Id := N + 316; + Name_Gnat : constant Name_Id := N + 317; + Name_GPL : constant Name_Id := N + 318; + Name_IEEE_Float : constant Name_Id := N + 319; + Name_Ignore : constant Name_Id := N + 320; + Name_Info : constant Name_Id := N + 321; + Name_Internal : constant Name_Id := N + 322; + Name_Link_Name : constant Name_Id := N + 323; + Name_Lowercase : constant Name_Id := N + 324; + Name_Max_Entry_Queue_Depth : constant Name_Id := N + 325; + Name_Max_Entry_Queue_Length : constant Name_Id := N + 326; + Name_Max_Size : constant Name_Id := N + 327; + Name_Mechanism : constant Name_Id := N + 328; + Name_Message : constant Name_Id := N + 329; + Name_Mixedcase : constant Name_Id := N + 330; + Name_Modified_GPL : constant Name_Id := N + 331; + Name_Name : constant Name_Id := N + 332; + Name_NCA : constant Name_Id := N + 333; + Name_No : constant Name_Id := N + 334; + Name_No_Dependence : constant Name_Id := N + 335; + Name_No_Dynamic_Attachment : constant Name_Id := N + 336; + Name_No_Dynamic_Interrupts : constant Name_Id := N + 337; + Name_No_Requeue : constant Name_Id := N + 338; + Name_No_Requeue_Statements : constant Name_Id := N + 339; + Name_No_Task_Attributes : constant Name_Id := N + 340; + Name_No_Task_Attributes_Package : constant Name_Id := N + 341; + Name_On : constant Name_Id := N + 342; + Name_Parameter_Types : constant Name_Id := N + 343; + Name_Reference : constant Name_Id := N + 344; + Name_Restricted : constant Name_Id := N + 345; + Name_Result_Mechanism : constant Name_Id := N + 346; + Name_Result_Type : constant Name_Id := N + 347; + Name_Runtime : constant Name_Id := N + 348; + Name_SB : constant Name_Id := N + 349; + Name_Secondary_Stack_Size : constant Name_Id := N + 350; + Name_Section : constant Name_Id := N + 351; + Name_Semaphore : constant Name_Id := N + 352; + Name_Short_Descriptor : constant Name_Id := N + 353; + Name_Simple_Barriers : constant Name_Id := N + 354; + Name_Spec_File_Name : constant Name_Id := N + 355; + Name_State : constant Name_Id := N + 356; + Name_Static : constant Name_Id := N + 357; + Name_Stack_Size : constant Name_Id := N + 358; + Name_Subunit_File_Name : constant Name_Id := N + 359; + Name_Task_Stack_Size_Default : constant Name_Id := N + 360; + Name_Task_Type : constant Name_Id := N + 361; + Name_Time_Slicing_Enabled : constant Name_Id := N + 362; + Name_Top_Guard : constant Name_Id := N + 363; + Name_UBA : constant Name_Id := N + 364; + Name_UBS : constant Name_Id := N + 365; + Name_UBSB : constant Name_Id := N + 366; + Name_Unit_Name : constant Name_Id := N + 367; + Name_Unknown : constant Name_Id := N + 368; + Name_Unrestricted : constant Name_Id := N + 369; + Name_Uppercase : constant Name_Id := N + 370; + Name_User : constant Name_Id := N + 371; + Name_VAX_Float : constant Name_Id := N + 372; + Name_VMS : constant Name_Id := N + 373; + Name_Vtable_Ptr : constant Name_Id := N + 374; + Name_Working_Storage : constant Name_Id := N + 375; -- Names of recognized attributes. The entries with the comment "Ada 83" -- are attributes that are defined in Ada 83, but not in Ada 95. These @@ -672,144 +672,147 @@ package Snames is -- The entries marked VMS are recognized only in OpenVMS implementations -- of GNAT, and are treated as illegal in all other contexts. - First_Attribute_Name : constant Name_Id := N + 379; - Name_Abort_Signal : constant Name_Id := N + 379; -- GNAT - Name_Access : constant Name_Id := N + 380; - Name_Address : constant Name_Id := N + 381; - Name_Address_Size : constant Name_Id := N + 382; -- GNAT - Name_Aft : constant Name_Id := N + 383; - Name_Alignment : constant Name_Id := N + 384; - Name_Asm_Input : constant Name_Id := N + 385; -- GNAT - Name_Asm_Output : constant Name_Id := N + 386; -- GNAT - Name_AST_Entry : constant Name_Id := N + 387; -- VMS - Name_Bit : constant Name_Id := N + 388; -- GNAT - Name_Bit_Order : constant Name_Id := N + 389; - Name_Bit_Position : constant Name_Id := N + 390; -- GNAT - Name_Body_Version : constant Name_Id := N + 391; - Name_Callable : constant Name_Id := N + 392; - Name_Caller : constant Name_Id := N + 393; - Name_Code_Address : constant Name_Id := N + 394; -- GNAT - Name_Component_Size : constant Name_Id := N + 395; - Name_Compose : constant Name_Id := N + 396; - Name_Constrained : constant Name_Id := N + 397; - Name_Count : constant Name_Id := N + 398; - Name_Default_Bit_Order : constant Name_Id := N + 399; -- GNAT - Name_Definite : constant Name_Id := N + 400; - Name_Delta : constant Name_Id := N + 401; - Name_Denorm : constant Name_Id := N + 402; - Name_Digits : constant Name_Id := N + 403; - Name_Elaborated : constant Name_Id := N + 404; -- GNAT - Name_Emax : constant Name_Id := N + 405; -- Ada 83 - Name_Enabled : constant Name_Id := N + 406; -- GNAT - Name_Enum_Rep : constant Name_Id := N + 407; -- GNAT - Name_Enum_Val : constant Name_Id := N + 408; -- GNAT - Name_Epsilon : constant Name_Id := N + 409; -- Ada 83 - Name_Exponent : constant Name_Id := N + 410; - Name_External_Tag : constant Name_Id := N + 411; - Name_Fast_Math : constant Name_Id := N + 412; -- GNAT - Name_First : constant Name_Id := N + 413; - Name_First_Bit : constant Name_Id := N + 414; - Name_Fixed_Value : constant Name_Id := N + 415; -- GNAT - Name_Fore : constant Name_Id := N + 416; - Name_Has_Access_Values : constant Name_Id := N + 417; -- GNAT - Name_Has_Discriminants : constant Name_Id := N + 418; -- GNAT - Name_Has_Tagged_Values : constant Name_Id := N + 419; -- GNAT - Name_Identity : constant Name_Id := N + 420; - Name_Img : constant Name_Id := N + 421; -- GNAT - Name_Integer_Value : constant Name_Id := N + 422; -- GNAT - Name_Invalid_Value : constant Name_Id := N + 423; -- GNAT - Name_Large : constant Name_Id := N + 424; -- Ada 83 - Name_Last : constant Name_Id := N + 425; - Name_Last_Bit : constant Name_Id := N + 426; - Name_Leading_Part : constant Name_Id := N + 427; - Name_Length : constant Name_Id := N + 428; - Name_Machine_Emax : constant Name_Id := N + 429; - Name_Machine_Emin : constant Name_Id := N + 430; - Name_Machine_Mantissa : constant Name_Id := N + 431; - Name_Machine_Overflows : constant Name_Id := N + 432; - Name_Machine_Radix : constant Name_Id := N + 433; - Name_Machine_Rounding : constant Name_Id := N + 434; -- Ada 05 - Name_Machine_Rounds : constant Name_Id := N + 435; - Name_Machine_Size : constant Name_Id := N + 436; -- GNAT - Name_Mantissa : constant Name_Id := N + 437; -- Ada 83 - Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 438; - Name_Maximum_Alignment : constant Name_Id := N + 439; -- GNAT - Name_Mechanism_Code : constant Name_Id := N + 440; -- GNAT - Name_Mod : constant Name_Id := N + 441; -- Ada 05 - Name_Model_Emin : constant Name_Id := N + 442; - Name_Model_Epsilon : constant Name_Id := N + 443; - Name_Model_Mantissa : constant Name_Id := N + 444; - Name_Model_Small : constant Name_Id := N + 445; - Name_Modulus : constant Name_Id := N + 446; - Name_Null_Parameter : constant Name_Id := N + 447; -- GNAT - Name_Object_Size : constant Name_Id := N + 448; -- GNAT - Name_Old : constant Name_Id := N + 449; -- GNAT - Name_Partition_ID : constant Name_Id := N + 450; - Name_Passed_By_Reference : constant Name_Id := N + 451; -- GNAT - Name_Pool_Address : constant Name_Id := N + 452; - Name_Pos : constant Name_Id := N + 453; - Name_Position : constant Name_Id := N + 454; - Name_Priority : constant Name_Id := N + 455; -- Ada 05 - Name_Range : constant Name_Id := N + 456; - Name_Range_Length : constant Name_Id := N + 457; -- GNAT - Name_Result : constant Name_Id := N + 458; -- GNAT - Name_Round : constant Name_Id := N + 459; - Name_Safe_Emax : constant Name_Id := N + 460; -- Ada 83 - Name_Safe_First : constant Name_Id := N + 461; - Name_Safe_Large : constant Name_Id := N + 462; -- Ada 83 - Name_Safe_Last : constant Name_Id := N + 463; - Name_Safe_Small : constant Name_Id := N + 464; -- Ada 83 - Name_Scale : constant Name_Id := N + 465; - Name_Scaling : constant Name_Id := N + 466; - Name_Signed_Zeros : constant Name_Id := N + 467; - Name_Size : constant Name_Id := N + 468; - Name_Small : constant Name_Id := N + 469; - Name_Storage_Size : constant Name_Id := N + 470; - Name_Storage_Unit : constant Name_Id := N + 471; -- GNAT - Name_Stream_Size : constant Name_Id := N + 472; -- Ada 05 - Name_Tag : constant Name_Id := N + 473; - Name_Target_Name : constant Name_Id := N + 474; -- GNAT - Name_Terminated : constant Name_Id := N + 475; - Name_To_Address : constant Name_Id := N + 476; -- GNAT - Name_Type_Class : constant Name_Id := N + 477; -- GNAT - Name_UET_Address : constant Name_Id := N + 478; -- GNAT - Name_Unbiased_Rounding : constant Name_Id := N + 479; - Name_Unchecked_Access : constant Name_Id := N + 480; - Name_Unconstrained_Array : constant Name_Id := N + 481; - Name_Universal_Literal_String : constant Name_Id := N + 482; -- GNAT - Name_Unrestricted_Access : constant Name_Id := N + 483; -- GNAT - Name_VADS_Size : constant Name_Id := N + 484; -- GNAT - Name_Val : constant Name_Id := N + 485; - Name_Valid : constant Name_Id := N + 486; - Name_Value_Size : constant Name_Id := N + 487; -- GNAT - Name_Version : constant Name_Id := N + 488; - Name_Wchar_T_Size : constant Name_Id := N + 489; -- GNAT - Name_Wide_Wide_Width : constant Name_Id := N + 490; -- Ada 05 - Name_Wide_Width : constant Name_Id := N + 491; - Name_Width : constant Name_Id := N + 492; - Name_Word_Size : constant Name_Id := N + 493; -- GNAT + First_Attribute_Name : constant Name_Id := N + 376; + Name_Abort_Signal : constant Name_Id := N + 376; -- GNAT + Name_Access : constant Name_Id := N + 377; + Name_Address : constant Name_Id := N + 378; + Name_Address_Size : constant Name_Id := N + 379; -- GNAT + Name_Aft : constant Name_Id := N + 380; + Name_Alignment : constant Name_Id := N + 381; + Name_Asm_Input : constant Name_Id := N + 382; -- GNAT + Name_Asm_Output : constant Name_Id := N + 383; -- GNAT + Name_AST_Entry : constant Name_Id := N + 384; -- VMS + Name_Bit : constant Name_Id := N + 385; -- GNAT + Name_Bit_Order : constant Name_Id := N + 386; + Name_Bit_Position : constant Name_Id := N + 387; -- GNAT + Name_Body_Version : constant Name_Id := N + 388; + Name_Callable : constant Name_Id := N + 389; + Name_Caller : constant Name_Id := N + 390; + Name_Code_Address : constant Name_Id := N + 391; -- GNAT + Name_Component_Size : constant Name_Id := N + 392; + Name_Compose : constant Name_Id := N + 393; + Name_Constrained : constant Name_Id := N + 394; + Name_Count : constant Name_Id := N + 395; + Name_Default_Bit_Order : constant Name_Id := N + 396; -- GNAT + Name_Definite : constant Name_Id := N + 397; + Name_Delta : constant Name_Id := N + 398; + Name_Denorm : constant Name_Id := N + 399; + Name_Digits : constant Name_Id := N + 400; + Name_Elaborated : constant Name_Id := N + 401; -- GNAT + Name_Emax : constant Name_Id := N + 402; -- Ada 83 + Name_Enabled : constant Name_Id := N + 403; -- GNAT + Name_Enum_Rep : constant Name_Id := N + 404; -- GNAT + Name_Enum_Val : constant Name_Id := N + 405; -- GNAT + Name_Epsilon : constant Name_Id := N + 406; -- Ada 83 + Name_Exponent : constant Name_Id := N + 407; + Name_External_Tag : constant Name_Id := N + 408; + Name_Fast_Math : constant Name_Id := N + 409; -- GNAT + Name_First : constant Name_Id := N + 410; + Name_First_Bit : constant Name_Id := N + 411; + Name_Fixed_Value : constant Name_Id := N + 412; -- GNAT + Name_Fore : constant Name_Id := N + 413; + Name_Has_Access_Values : constant Name_Id := N + 414; -- GNAT + Name_Has_Discriminants : constant Name_Id := N + 415; -- GNAT + Name_Has_Tagged_Values : constant Name_Id := N + 416; -- GNAT + Name_Identity : constant Name_Id := N + 417; + Name_Img : constant Name_Id := N + 418; -- GNAT + Name_Integer_Value : constant Name_Id := N + 419; -- GNAT + Name_Invalid_Value : constant Name_Id := N + 420; -- GNAT + Name_Large : constant Name_Id := N + 421; -- Ada 83 + Name_Last : constant Name_Id := N + 422; + Name_Last_Bit : constant Name_Id := N + 423; + Name_Leading_Part : constant Name_Id := N + 424; + Name_Length : constant Name_Id := N + 425; + Name_Machine_Emax : constant Name_Id := N + 426; + Name_Machine_Emin : constant Name_Id := N + 427; + Name_Machine_Mantissa : constant Name_Id := N + 428; + Name_Machine_Overflows : constant Name_Id := N + 429; + Name_Machine_Radix : constant Name_Id := N + 430; + Name_Machine_Rounding : constant Name_Id := N + 431; -- Ada 05 + Name_Machine_Rounds : constant Name_Id := N + 432; + Name_Machine_Size : constant Name_Id := N + 433; -- GNAT + Name_Mantissa : constant Name_Id := N + 434; -- Ada 83 + Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 435; + Name_Maximum_Alignment : constant Name_Id := N + 436; -- GNAT + Name_Mechanism_Code : constant Name_Id := N + 437; -- GNAT + Name_Mod : constant Name_Id := N + 438; -- Ada 05 + Name_Model_Emin : constant Name_Id := N + 439; + Name_Model_Epsilon : constant Name_Id := N + 440; + Name_Model_Mantissa : constant Name_Id := N + 441; + Name_Model_Small : constant Name_Id := N + 442; + Name_Modulus : constant Name_Id := N + 443; + Name_Null_Parameter : constant Name_Id := N + 444; -- GNAT + Name_Object_Size : constant Name_Id := N + 445; -- GNAT + Name_Old : constant Name_Id := N + 446; -- GNAT + Name_Partition_ID : constant Name_Id := N + 447; + Name_Passed_By_Reference : constant Name_Id := N + 448; -- GNAT + Name_Pool_Address : constant Name_Id := N + 449; + Name_Pos : constant Name_Id := N + 450; + Name_Position : constant Name_Id := N + 451; + Name_Priority : constant Name_Id := N + 452; -- Ada 05 + Name_Range : constant Name_Id := N + 453; + Name_Range_Length : constant Name_Id := N + 454; -- GNAT + Name_Result : constant Name_Id := N + 455; -- GNAT + Name_Round : constant Name_Id := N + 456; + Name_Safe_Emax : constant Name_Id := N + 457; -- Ada 83 + Name_Safe_First : constant Name_Id := N + 458; + Name_Safe_Large : constant Name_Id := N + 459; -- Ada 83 + Name_Safe_Last : constant Name_Id := N + 460; + Name_Safe_Small : constant Name_Id := N + 461; -- Ada 83 + Name_Scale : constant Name_Id := N + 462; + Name_Scaling : constant Name_Id := N + 463; + Name_Signed_Zeros : constant Name_Id := N + 464; + Name_Size : constant Name_Id := N + 465; + Name_Small : constant Name_Id := N + 466; + Name_Storage_Size : constant Name_Id := N + 467; + Name_Storage_Unit : constant Name_Id := N + 468; -- GNAT + Name_Stream_Size : constant Name_Id := N + 469; -- Ada 05 + Name_Tag : constant Name_Id := N + 470; + Name_Target_Name : constant Name_Id := N + 471; -- GNAT + Name_Terminated : constant Name_Id := N + 472; + Name_To_Address : constant Name_Id := N + 473; -- GNAT + Name_Type_Class : constant Name_Id := N + 474; -- GNAT + Name_UET_Address : constant Name_Id := N + 475; -- GNAT + Name_Unbiased_Rounding : constant Name_Id := N + 476; + Name_Unchecked_Access : constant Name_Id := N + 477; + Name_Unconstrained_Array : constant Name_Id := N + 478; + Name_Universal_Literal_String : constant Name_Id := N + 479; -- GNAT + Name_Unrestricted_Access : constant Name_Id := N + 480; -- GNAT + Name_VADS_Size : constant Name_Id := N + 481; -- GNAT + Name_Val : constant Name_Id := N + 482; + Name_Valid : constant Name_Id := N + 483; + Name_Value_Size : constant Name_Id := N + 484; -- GNAT + Name_Version : constant Name_Id := N + 485; + Name_Wchar_T_Size : constant Name_Id := N + 486; -- GNAT + Name_Wide_Wide_Width : constant Name_Id := N + 487; -- Ada 05 + Name_Wide_Width : constant Name_Id := N + 488; + Name_Width : constant Name_Id := N + 489; + Name_Word_Size : constant Name_Id := N + 490; -- GNAT -- Attributes that designate attributes returning renamable functions, -- i.e. functions that return other than a universal value and that -- have non-universal arguments. - First_Renamable_Function_Attribute : constant Name_Id := N + 494; - Name_Adjacent : constant Name_Id := N + 494; - Name_Ceiling : constant Name_Id := N + 495; - Name_Copy_Sign : constant Name_Id := N + 496; - Name_Floor : constant Name_Id := N + 497; - Name_Fraction : constant Name_Id := N + 498; - Name_Image : constant Name_Id := N + 499; - Name_Input : constant Name_Id := N + 500; - Name_Machine : constant Name_Id := N + 501; - Name_Max : constant Name_Id := N + 502; - Name_Min : constant Name_Id := N + 503; - Name_Model : constant Name_Id := N + 504; - Name_Pred : constant Name_Id := N + 505; - Name_Remainder : constant Name_Id := N + 506; - Name_Rounding : constant Name_Id := N + 507; - Name_Succ : constant Name_Id := N + 508; - Name_Truncation : constant Name_Id := N + 509; + First_Renamable_Function_Attribute : constant Name_Id := N + 491; + Name_Adjacent : constant Name_Id := N + 491; + Name_Ceiling : constant Name_Id := N + 492; + Name_Copy_Sign : constant Name_Id := N + 493; + Name_Floor : constant Name_Id := N + 494; + Name_Fraction : constant Name_Id := N + 495; + Name_From_Any : constant Name_Id := N + 496; -- GNAT + Name_Image : constant Name_Id := N + 497; + Name_Input : constant Name_Id := N + 498; + Name_Machine : constant Name_Id := N + 499; + Name_Max : constant Name_Id := N + 500; + Name_Min : constant Name_Id := N + 501; + Name_Model : constant Name_Id := N + 502; + Name_Pred : constant Name_Id := N + 503; + Name_Remainder : constant Name_Id := N + 504; + Name_Rounding : constant Name_Id := N + 505; + Name_Succ : constant Name_Id := N + 506; + Name_To_Any : constant Name_Id := N + 507; -- GNAT + Name_Truncation : constant Name_Id := N + 508; + Name_TypeCode : constant Name_Id := N + 509; -- GNAT Name_Value : constant Name_Id := N + 510; Name_Wide_Image : constant Name_Id := N + 511; Name_Wide_Wide_Image : constant Name_Id := N + 512; @@ -1048,105 +1051,107 @@ package Snames is Name_Extends : constant Name_Id := N + 666; Name_Externally_Built : constant Name_Id := N + 667; Name_Finder : constant Name_Id := N + 668; - Name_Global_Configuration_Pragmas : constant Name_Id := N + 669; - Name_Global_Config_File : constant Name_Id := N + 670; - Name_Gnatls : constant Name_Id := N + 671; - Name_Gnatstub : constant Name_Id := N + 672; - Name_Implementation : constant Name_Id := N + 673; - Name_Implementation_Exceptions : constant Name_Id := N + 674; - Name_Implementation_Suffix : constant Name_Id := N + 675; - Name_Include_Switches : constant Name_Id := N + 676; - Name_Include_Path : constant Name_Id := N + 677; - Name_Include_Path_File : constant Name_Id := N + 678; - Name_Inherit_Source_Path : constant Name_Id := N + 679; - Name_Language_Kind : constant Name_Id := N + 680; - Name_Language_Processing : constant Name_Id := N + 681; - Name_Languages : constant Name_Id := N + 682; - Name_Library : constant Name_Id := N + 683; - Name_Library_Ali_Dir : constant Name_Id := N + 684; - Name_Library_Auto_Init : constant Name_Id := N + 685; - Name_Library_Auto_Init_Supported : constant Name_Id := N + 686; - Name_Library_Builder : constant Name_Id := N + 687; - Name_Library_Dir : constant Name_Id := N + 688; - Name_Library_GCC : constant Name_Id := N + 689; - Name_Library_Interface : constant Name_Id := N + 690; - Name_Library_Kind : constant Name_Id := N + 691; - Name_Library_Name : constant Name_Id := N + 692; - Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 693; - Name_Library_Options : constant Name_Id := N + 694; - Name_Library_Partial_Linker : constant Name_Id := N + 695; - Name_Library_Reference_Symbol_File : constant Name_Id := N + 696; - Name_Library_Src_Dir : constant Name_Id := N + 697; - Name_Library_Support : constant Name_Id := N + 698; - Name_Library_Symbol_File : constant Name_Id := N + 699; - Name_Library_Symbol_Policy : constant Name_Id := N + 700; - Name_Library_Version : constant Name_Id := N + 701; - Name_Library_Version_Switches : constant Name_Id := N + 702; - Name_Linker : constant Name_Id := N + 703; - Name_Linker_Executable_Option : constant Name_Id := N + 704; - Name_Linker_Lib_Dir_Option : constant Name_Id := N + 705; - Name_Linker_Lib_Name_Option : constant Name_Id := N + 706; - Name_Local_Config_File : constant Name_Id := N + 707; - Name_Local_Configuration_Pragmas : constant Name_Id := N + 708; - Name_Locally_Removed_Files : constant Name_Id := N + 709; - Name_Map_File_Option : constant Name_Id := N + 710; - Name_Mapping_File_Switches : constant Name_Id := N + 711; - Name_Mapping_Spec_Suffix : constant Name_Id := N + 712; - Name_Mapping_Body_Suffix : constant Name_Id := N + 713; - Name_Metrics : constant Name_Id := N + 714; - Name_Naming : constant Name_Id := N + 715; - Name_Object_Generated : constant Name_Id := N + 716; - Name_Objects_Linked : constant Name_Id := N + 717; - Name_Objects_Path : constant Name_Id := N + 718; - Name_Objects_Path_File : constant Name_Id := N + 719; - Name_Object_Dir : constant Name_Id := N + 720; - Name_Pic_Option : constant Name_Id := N + 721; - Name_Pretty_Printer : constant Name_Id := N + 722; - Name_Prefix : constant Name_Id := N + 723; - Name_Project : constant Name_Id := N + 724; - Name_Roots : constant Name_Id := N + 725; - Name_Required_Switches : constant Name_Id := N + 726; - Name_Run_Path_Option : constant Name_Id := N + 727; - Name_Runtime_Project : constant Name_Id := N + 728; - Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 729; - Name_Shared_Library_Prefix : constant Name_Id := N + 730; - Name_Shared_Library_Suffix : constant Name_Id := N + 731; - Name_Separate_Suffix : constant Name_Id := N + 732; - Name_Source_Dirs : constant Name_Id := N + 733; - Name_Source_Files : constant Name_Id := N + 734; - Name_Source_List_File : constant Name_Id := N + 735; - Name_Spec : constant Name_Id := N + 736; - Name_Spec_Suffix : constant Name_Id := N + 737; - Name_Specification : constant Name_Id := N + 738; - Name_Specification_Exceptions : constant Name_Id := N + 739; - Name_Specification_Suffix : constant Name_Id := N + 740; - Name_Stack : constant Name_Id := N + 741; - Name_Switches : constant Name_Id := N + 742; - Name_Symbolic_Link_Supported : constant Name_Id := N + 743; - Name_Sync : constant Name_Id := N + 744; - Name_Synchronize : constant Name_Id := N + 745; - Name_Toolchain_Description : constant Name_Id := N + 746; - Name_Toolchain_Version : constant Name_Id := N + 747; - Name_Runtime_Library_Dir : constant Name_Id := N + 748; + Name_Global_Compilation_Switches : constant Name_Id := N + 669; + Name_Global_Configuration_Pragmas : constant Name_Id := N + 670; + Name_Global_Config_File : constant Name_Id := N + 671; + Name_Gnatls : constant Name_Id := N + 672; + Name_Gnatstub : constant Name_Id := N + 673; + Name_Implementation : constant Name_Id := N + 674; + Name_Implementation_Exceptions : constant Name_Id := N + 675; + Name_Implementation_Suffix : constant Name_Id := N + 676; + Name_Include_Switches : constant Name_Id := N + 677; + Name_Include_Path : constant Name_Id := N + 678; + Name_Include_Path_File : constant Name_Id := N + 679; + Name_Inherit_Source_Path : constant Name_Id := N + 680; + Name_Language_Kind : constant Name_Id := N + 681; + Name_Language_Processing : constant Name_Id := N + 682; + Name_Languages : constant Name_Id := N + 683; + Name_Library : constant Name_Id := N + 684; + Name_Library_Ali_Dir : constant Name_Id := N + 685; + Name_Library_Auto_Init : constant Name_Id := N + 686; + Name_Library_Auto_Init_Supported : constant Name_Id := N + 687; + Name_Library_Builder : constant Name_Id := N + 688; + Name_Library_Dir : constant Name_Id := N + 689; + Name_Library_GCC : constant Name_Id := N + 690; + Name_Library_Interface : constant Name_Id := N + 691; + Name_Library_Kind : constant Name_Id := N + 692; + Name_Library_Name : constant Name_Id := N + 693; + Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 694; + Name_Library_Options : constant Name_Id := N + 695; + Name_Library_Partial_Linker : constant Name_Id := N + 696; + Name_Library_Reference_Symbol_File : constant Name_Id := N + 697; + Name_Library_Src_Dir : constant Name_Id := N + 698; + Name_Library_Support : constant Name_Id := N + 699; + Name_Library_Symbol_File : constant Name_Id := N + 700; + Name_Library_Symbol_Policy : constant Name_Id := N + 701; + Name_Library_Version : constant Name_Id := N + 702; + Name_Library_Version_Switches : constant Name_Id := N + 703; + Name_Linker : constant Name_Id := N + 704; + Name_Linker_Executable_Option : constant Name_Id := N + 705; + Name_Linker_Lib_Dir_Option : constant Name_Id := N + 706; + Name_Linker_Lib_Name_Option : constant Name_Id := N + 707; + Name_Local_Config_File : constant Name_Id := N + 708; + Name_Local_Configuration_Pragmas : constant Name_Id := N + 709; + Name_Locally_Removed_Files : constant Name_Id := N + 710; + Name_Map_File_Option : constant Name_Id := N + 711; + Name_Mapping_File_Switches : constant Name_Id := N + 712; + Name_Mapping_Spec_Suffix : constant Name_Id := N + 713; + Name_Mapping_Body_Suffix : constant Name_Id := N + 714; + Name_Metrics : constant Name_Id := N + 715; + Name_Naming : constant Name_Id := N + 716; + Name_Object_Generated : constant Name_Id := N + 717; + Name_Objects_Linked : constant Name_Id := N + 718; + Name_Objects_Path : constant Name_Id := N + 719; + Name_Objects_Path_File : constant Name_Id := N + 720; + Name_Object_Dir : constant Name_Id := N + 721; + Name_Path_Syntax : constant Name_Id := N + 722; + Name_Pic_Option : constant Name_Id := N + 723; + Name_Pretty_Printer : constant Name_Id := N + 724; + Name_Prefix : constant Name_Id := N + 725; + Name_Project : constant Name_Id := N + 726; + Name_Roots : constant Name_Id := N + 727; + Name_Required_Switches : constant Name_Id := N + 728; + Name_Run_Path_Option : constant Name_Id := N + 729; + Name_Runtime_Project : constant Name_Id := N + 730; + Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 731; + Name_Shared_Library_Prefix : constant Name_Id := N + 732; + Name_Shared_Library_Suffix : constant Name_Id := N + 733; + Name_Separate_Suffix : constant Name_Id := N + 734; + Name_Source_Dirs : constant Name_Id := N + 735; + Name_Source_Files : constant Name_Id := N + 736; + Name_Source_List_File : constant Name_Id := N + 737; + Name_Spec : constant Name_Id := N + 738; + Name_Spec_Suffix : constant Name_Id := N + 739; + Name_Specification : constant Name_Id := N + 740; + Name_Specification_Exceptions : constant Name_Id := N + 741; + Name_Specification_Suffix : constant Name_Id := N + 742; + Name_Stack : constant Name_Id := N + 743; + Name_Switches : constant Name_Id := N + 744; + Name_Symbolic_Link_Supported : constant Name_Id := N + 745; + Name_Sync : constant Name_Id := N + 746; + Name_Synchronize : constant Name_Id := N + 747; + Name_Toolchain_Description : constant Name_Id := N + 748; + Name_Toolchain_Version : constant Name_Id := N + 749; + Name_Runtime_Library_Dir : constant Name_Id := N + 750; -- Other miscellaneous names used in front end - Name_Unaligned_Valid : constant Name_Id := N + 749; + Name_Unaligned_Valid : constant Name_Id := N + 751; -- Ada 2005 reserved words - First_2005_Reserved_Word : constant Name_Id := N + 750; - Name_Interface : constant Name_Id := N + 750; - Name_Overriding : constant Name_Id := N + 751; - Name_Synchronized : constant Name_Id := N + 752; - Last_2005_Reserved_Word : constant Name_Id := N + 752; + First_2005_Reserved_Word : constant Name_Id := N + 752; + Name_Interface : constant Name_Id := N + 752; + Name_Overriding : constant Name_Id := N + 753; + Name_Synchronized : constant Name_Id := N + 754; + Last_2005_Reserved_Word : constant Name_Id := N + 754; subtype Ada_2005_Reserved_Words is Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 752; + Last_Predefined_Name : constant Name_Id := N + 754; --------------------------------------- -- Subtypes Defining Name Categories -- @@ -1286,6 +1291,7 @@ package Snames is Attribute_Copy_Sign, Attribute_Floor, Attribute_Fraction, + Attribute_From_Any, Attribute_Image, Attribute_Input, Attribute_Machine, @@ -1296,7 +1302,9 @@ package Snames is Attribute_Remainder, Attribute_Rounding, Attribute_Succ, + Attribute_To_Any, Attribute_Truncation, + Attribute_TypeCode, Attribute_Value, Attribute_Wide_Image, Attribute_Wide_Wide_Image, @@ -1387,7 +1395,6 @@ package Snames is Pragma_Ada_2005, Pragma_Assertion_Policy, Pragma_C_Pass_By_Copy, - Pragma_Canonical_Streams, Pragma_Check_Name, Pragma_Check_Policy, Pragma_Compile_Time_Error, diff --git a/gcc/ada/snames.h b/gcc/ada/snames.h index 5c52b59ac57..8f1367f7184 100644 --- a/gcc/ada/snames.h +++ b/gcc/ada/snames.h @@ -164,31 +164,34 @@ extern unsigned char Get_Attribute_Id (int); #define Attr_Copy_Sign 117 #define Attr_Floor 118 #define Attr_Fraction 119 -#define Attr_Image 120 -#define Attr_Input 121 -#define Attr_Machine 122 -#define Attr_Max 123 -#define Attr_Min 124 -#define Attr_Model 125 -#define Attr_Pred 126 -#define Attr_Remainder 127 -#define Attr_Rounding 128 -#define Attr_Succ 129 -#define Attr_Truncation 130 -#define Attr_Value 131 -#define Attr_Wide_Image 132 -#define Attr_Wide_Wide_Image 133 -#define Attr_Wide_Value 134 -#define Attr_Wide_Wide_Value 135 -#define Attr_Output 136 -#define Attr_Read 137 -#define Attr_Write 138 -#define Attr_Elab_Body 139 -#define Attr_Elab_Spec 140 -#define Attr_Storage_Pool 141 -#define Attr_Base 142 -#define Attr_Class 143 -#define Attr_Stub_Type 144 +#define Attr_From_Any 120 +#define Attr_Image 121 +#define Attr_Input 122 +#define Attr_Machine 123 +#define Attr_Max 124 +#define Attr_Min 125 +#define Attr_Model 126 +#define Attr_Pred 127 +#define Attr_Remainder 128 +#define Attr_Rounding 129 +#define Attr_Succ 130 +#define Attr_To_Any 131 +#define Attr_Truncation 132 +#define Attr_TypeCode 133 +#define Attr_Value 134 +#define Attr_Wide_Image 135 +#define Attr_Wide_Wide_Image 136 +#define Attr_Wide_Value 137 +#define Attr_Wide_Wide_Value 138 +#define Attr_Output 139 +#define Attr_Read 140 +#define Attr_Write 141 +#define Attr_Elab_Body 142 +#define Attr_Elab_Spec 143 +#define Attr_Storage_Pool 144 +#define Attr_Base 145 +#define Attr_Class 146 +#define Attr_Stub_Type 147 /* Define the numeric values for the conventions. */ @@ -227,170 +230,169 @@ extern unsigned char Get_Pragma_Id (int); #define Pragma_Ada_2005 3 #define Pragma_Assertion_Policy 4 #define Pragma_C_Pass_By_Copy 5 -#define Pragma_Canonical_Streams 6 -#define Pragma_Check_Name 7 -#define Pragma_Check_Policy 8 -#define Pragma_Compile_Time_Error 9 -#define Pragma_Compile_Time_Warning 10 -#define Pragma_Compiler_Unit 11 -#define Pragma_Component_Alignment 12 -#define Pragma_Convention_Identifier 13 -#define Pragma_Debug_Policy 14 -#define Pragma_Detect_Blocking 15 -#define Pragma_Discard_Names 16 -#define Pragma_Elaboration_Checks 17 -#define Pragma_Eliminate 18 -#define Pragma_Extend_System 19 -#define Pragma_Extensions_Allowed 20 -#define Pragma_External_Name_Casing 21 -#define Pragma_Favor_Top_Level 22 -#define Pragma_Float_Representation 23 -#define Pragma_Implicit_Packing 24 -#define Pragma_Initialize_Scalars 25 -#define Pragma_Interrupt_State 26 -#define Pragma_License 27 -#define Pragma_Locking_Policy 28 -#define Pragma_Long_Float 29 -#define Pragma_No_Run_Time 30 -#define Pragma_No_Strict_Aliasing 31 -#define Pragma_Normalize_Scalars 32 -#define Pragma_Optimize_Alignment 33 -#define Pragma_Persistent_BSS 34 -#define Pragma_Polling 35 -#define Pragma_Priority_Specific_Dispatching 36 -#define Pragma_Profile 37 -#define Pragma_Profile_Warnings 38 -#define Pragma_Propagate_Exceptions 39 -#define Pragma_Queuing_Policy 40 -#define Pragma_Ravenscar 41 -#define Pragma_Restricted_Run_Time 42 -#define Pragma_Restrictions 43 -#define Pragma_Restriction_Warnings 44 -#define Pragma_Reviewable 45 -#define Pragma_Source_File_Name 46 -#define Pragma_Source_File_Name_Project 47 -#define Pragma_Style_Checks 48 -#define Pragma_Suppress 49 -#define Pragma_Suppress_Exception_Locations 50 -#define Pragma_Task_Dispatching_Policy 51 -#define Pragma_Universal_Data 52 -#define Pragma_Unsuppress 53 -#define Pragma_Use_VADS_Size 54 -#define Pragma_Validity_Checks 55 -#define Pragma_Warnings 56 -#define Pragma_Wide_Character_Encoding 57 -#define Pragma_Abort_Defer 58 -#define Pragma_All_Calls_Remote 59 -#define Pragma_Annotate 60 -#define Pragma_Assert 61 -#define Pragma_Asynchronous 62 -#define Pragma_Atomic 63 -#define Pragma_Atomic_Components 64 -#define Pragma_Attach_Handler 65 -#define Pragma_Check 66 -#define Pragma_CIL_Constructor 67 -#define Pragma_Comment 68 -#define Pragma_Common_Object 69 -#define Pragma_Complete_Representation 70 -#define Pragma_Complex_Representation 71 -#define Pragma_Controlled 72 -#define Pragma_Convention 73 -#define Pragma_CPP_Class 74 -#define Pragma_CPP_Constructor 75 -#define Pragma_CPP_Virtual 76 -#define Pragma_CPP_Vtable 77 -#define Pragma_Debug 78 -#define Pragma_Elaborate 79 -#define Pragma_Elaborate_All 80 -#define Pragma_Elaborate_Body 81 -#define Pragma_Export 82 -#define Pragma_Export_Exception 83 -#define Pragma_Export_Function 84 -#define Pragma_Export_Object 85 -#define Pragma_Export_Procedure 86 -#define Pragma_Export_Value 87 -#define Pragma_Export_Valued_Procedure 88 -#define Pragma_External 89 -#define Pragma_Finalize_Storage_Only 90 -#define Pragma_Ident 91 -#define Pragma_Implemented_By_Entry 92 -#define Pragma_Import 93 -#define Pragma_Import_Exception 94 -#define Pragma_Import_Function 95 -#define Pragma_Import_Object 96 -#define Pragma_Import_Procedure 97 -#define Pragma_Import_Valued_Procedure 98 -#define Pragma_Inline 99 -#define Pragma_Inline_Always 100 -#define Pragma_Inline_Generic 101 -#define Pragma_Inspection_Point 102 -#define Pragma_Interface_Name 103 -#define Pragma_Interrupt_Handler 104 -#define Pragma_Interrupt_Priority 105 -#define Pragma_Java_Constructor 106 -#define Pragma_Java_Interface 107 -#define Pragma_Keep_Names 108 -#define Pragma_Link_With 109 -#define Pragma_Linker_Alias 110 -#define Pragma_Linker_Constructor 111 -#define Pragma_Linker_Destructor 112 -#define Pragma_Linker_Options 113 -#define Pragma_Linker_Section 114 -#define Pragma_List 115 -#define Pragma_Machine_Attribute 116 -#define Pragma_Main 117 -#define Pragma_Main_Storage 118 -#define Pragma_Memory_Size 119 -#define Pragma_No_Body 120 -#define Pragma_No_Return 121 -#define Pragma_Obsolescent 122 -#define Pragma_Optimize 123 -#define Pragma_Pack 124 -#define Pragma_Page 125 -#define Pragma_Passive 126 -#define Pragma_Postcondition 127 -#define Pragma_Precondition 128 -#define Pragma_Preelaborable_Initialization 129 -#define Pragma_Preelaborate 130 -#define Pragma_Preelaborate_05 131 -#define Pragma_Psect_Object 132 -#define Pragma_Pure 133 -#define Pragma_Pure_05 134 -#define Pragma_Pure_Function 135 -#define Pragma_Relative_Deadline 136 -#define Pragma_Remote_Call_Interface 137 -#define Pragma_Remote_Types 138 -#define Pragma_Share_Generic 139 -#define Pragma_Shared 140 -#define Pragma_Shared_Passive 141 -#define Pragma_Source_Reference 142 -#define Pragma_Static_Elaboration_Desired 143 -#define Pragma_Stream_Convert 144 -#define Pragma_Subtitle 145 -#define Pragma_Suppress_All 146 -#define Pragma_Suppress_Debug_Info 147 -#define Pragma_Suppress_Initialization 148 -#define Pragma_System_Name 149 -#define Pragma_Task_Info 150 -#define Pragma_Task_Name 151 -#define Pragma_Task_Storage 152 -#define Pragma_Time_Slice 153 -#define Pragma_Title 154 -#define Pragma_Unchecked_Union 155 -#define Pragma_Unimplemented_Unit 156 -#define Pragma_Universal_Aliasing 157 -#define Pragma_Unmodified 158 -#define Pragma_Unreferenced 159 -#define Pragma_Unreferenced_Objects 160 -#define Pragma_Unreserve_All_Interrupts 161 -#define Pragma_Volatile 162 -#define Pragma_Volatile_Components 163 -#define Pragma_Weak_External 164 -#define Pragma_AST_Entry 165 -#define Pragma_Fast_Math 166 -#define Pragma_Interface 167 -#define Pragma_Priority 168 -#define Pragma_Storage_Size 169 -#define Pragma_Storage_Unit 170 +#define Pragma_Check_Name 6 +#define Pragma_Check_Policy 7 +#define Pragma_Compile_Time_Error 8 +#define Pragma_Compile_Time_Warning 9 +#define Pragma_Compiler_Unit 10 +#define Pragma_Component_Alignment 11 +#define Pragma_Convention_Identifier 12 +#define Pragma_Debug_Policy 13 +#define Pragma_Detect_Blocking 14 +#define Pragma_Discard_Names 15 +#define Pragma_Elaboration_Checks 16 +#define Pragma_Eliminate 17 +#define Pragma_Extend_System 18 +#define Pragma_Extensions_Allowed 19 +#define Pragma_External_Name_Casing 20 +#define Pragma_Favor_Top_Level 21 +#define Pragma_Float_Representation 22 +#define Pragma_Implicit_Packing 23 +#define Pragma_Initialize_Scalars 24 +#define Pragma_Interrupt_State 25 +#define Pragma_License 26 +#define Pragma_Locking_Policy 27 +#define Pragma_Long_Float 28 +#define Pragma_No_Run_Time 29 +#define Pragma_No_Strict_Aliasing 30 +#define Pragma_Normalize_Scalars 31 +#define Pragma_Optimize_Alignment 32 +#define Pragma_Persistent_BSS 33 +#define Pragma_Polling 34 +#define Pragma_Priority_Specific_Dispatching 35 +#define Pragma_Profile 36 +#define Pragma_Profile_Warnings 37 +#define Pragma_Propagate_Exceptions 38 +#define Pragma_Queuing_Policy 39 +#define Pragma_Ravenscar 40 +#define Pragma_Restricted_Run_Time 41 +#define Pragma_Restrictions 42 +#define Pragma_Restriction_Warnings 43 +#define Pragma_Reviewable 44 +#define Pragma_Source_File_Name 45 +#define Pragma_Source_File_Name_Project 46 +#define Pragma_Style_Checks 47 +#define Pragma_Suppress 48 +#define Pragma_Suppress_Exception_Locations 49 +#define Pragma_Task_Dispatching_Policy 50 +#define Pragma_Universal_Data 51 +#define Pragma_Unsuppress 52 +#define Pragma_Use_VADS_Size 53 +#define Pragma_Validity_Checks 54 +#define Pragma_Warnings 55 +#define Pragma_Wide_Character_Encoding 56 +#define Pragma_Abort_Defer 57 +#define Pragma_All_Calls_Remote 58 +#define Pragma_Annotate 59 +#define Pragma_Assert 60 +#define Pragma_Asynchronous 61 +#define Pragma_Atomic 62 +#define Pragma_Atomic_Components 63 +#define Pragma_Attach_Handler 64 +#define Pragma_Check 65 +#define Pragma_CIL_Constructor 66 +#define Pragma_Comment 67 +#define Pragma_Common_Object 68 +#define Pragma_Complete_Representation 69 +#define Pragma_Complex_Representation 70 +#define Pragma_Controlled 71 +#define Pragma_Convention 72 +#define Pragma_CPP_Class 73 +#define Pragma_CPP_Constructor 74 +#define Pragma_CPP_Virtual 75 +#define Pragma_CPP_Vtable 76 +#define Pragma_Debug 77 +#define Pragma_Elaborate 78 +#define Pragma_Elaborate_All 79 +#define Pragma_Elaborate_Body 80 +#define Pragma_Export 81 +#define Pragma_Export_Exception 82 +#define Pragma_Export_Function 83 +#define Pragma_Export_Object 84 +#define Pragma_Export_Procedure 85 +#define Pragma_Export_Value 86 +#define Pragma_Export_Valued_Procedure 87 +#define Pragma_External 88 +#define Pragma_Finalize_Storage_Only 89 +#define Pragma_Ident 90 +#define Pragma_Implemented_By_Entry 91 +#define Pragma_Import 92 +#define Pragma_Import_Exception 93 +#define Pragma_Import_Function 94 +#define Pragma_Import_Object 95 +#define Pragma_Import_Procedure 96 +#define Pragma_Import_Valued_Procedure 97 +#define Pragma_Inline 98 +#define Pragma_Inline_Always 99 +#define Pragma_Inline_Generic 100 +#define Pragma_Inspection_Point 101 +#define Pragma_Interface_Name 102 +#define Pragma_Interrupt_Handler 103 +#define Pragma_Interrupt_Priority 104 +#define Pragma_Java_Constructor 105 +#define Pragma_Java_Interface 106 +#define Pragma_Keep_Names 107 +#define Pragma_Link_With 108 +#define Pragma_Linker_Alias 109 +#define Pragma_Linker_Constructor 110 +#define Pragma_Linker_Destructor 111 +#define Pragma_Linker_Options 112 +#define Pragma_Linker_Section 113 +#define Pragma_List 114 +#define Pragma_Machine_Attribute 115 +#define Pragma_Main 116 +#define Pragma_Main_Storage 117 +#define Pragma_Memory_Size 118 +#define Pragma_No_Body 119 +#define Pragma_No_Return 120 +#define Pragma_Obsolescent 121 +#define Pragma_Optimize 122 +#define Pragma_Pack 123 +#define Pragma_Page 124 +#define Pragma_Passive 125 +#define Pragma_Postcondition 126 +#define Pragma_Precondition 127 +#define Pragma_Preelaborable_Initialization 128 +#define Pragma_Preelaborate 129 +#define Pragma_Preelaborate_05 130 +#define Pragma_Psect_Object 131 +#define Pragma_Pure 132 +#define Pragma_Pure_05 133 +#define Pragma_Pure_Function 134 +#define Pragma_Relative_Deadline 135 +#define Pragma_Remote_Call_Interface 136 +#define Pragma_Remote_Types 137 +#define Pragma_Share_Generic 138 +#define Pragma_Shared 139 +#define Pragma_Shared_Passive 140 +#define Pragma_Source_Reference 141 +#define Pragma_Static_Elaboration_Desired 142 +#define Pragma_Stream_Convert 143 +#define Pragma_Subtitle 144 +#define Pragma_Suppress_All 145 +#define Pragma_Suppress_Debug_Info 146 +#define Pragma_Suppress_Initialization 147 +#define Pragma_System_Name 148 +#define Pragma_Task_Info 149 +#define Pragma_Task_Name 150 +#define Pragma_Task_Storage 151 +#define Pragma_Time_Slice 152 +#define Pragma_Title 153 +#define Pragma_Unchecked_Union 154 +#define Pragma_Unimplemented_Unit 155 +#define Pragma_Universal_Aliasing 156 +#define Pragma_Unmodified 157 +#define Pragma_Unreferenced 158 +#define Pragma_Unreferenced_Objects 159 +#define Pragma_Unreserve_All_Interrupts 160 +#define Pragma_Volatile 161 +#define Pragma_Volatile_Components 162 +#define Pragma_Weak_External 163 +#define Pragma_AST_Entry 164 +#define Pragma_Fast_Math 165 +#define Pragma_Interface 166 +#define Pragma_Priority 167 +#define Pragma_Storage_Size 168 +#define Pragma_Storage_Unit 169 /* End of snames.h (C version of Snames package spec) */ diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index cf59c8198cd..63a1a6d83aa 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -371,6 +371,16 @@ package body Switch.C is Full_Path_Name_For_Brief_Errors := True; return; + -- -gnateG (save preprocessor output) + + when 'G' => + if Ptr < Max then + Bad_Switch (Switch_Chars); + end if; + + Generate_Processed_File := True; + Ptr := Ptr + 1; + -- -gnateI (index of unit in multi-unit source) when 'I' => diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index 20761f417cd..7be075d9896 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -267,14 +267,16 @@ package body Switch.M is when 'e' => - -- Only -gnateD and -gnatep= need storing in ALI file + -- Store -gnateD, -gnatep= and -gnateG in the ALI file. + -- The other -gnate switches do not need to be stored. Storing (First_Stored) := 'e'; Ptr := Ptr + 1; if Ptr > Max or else (Switch_Chars (Ptr) /= 'D' - and then Switch_Chars (Ptr) /= 'p') + and then Switch_Chars (Ptr) /= 'G' + and then Switch_Chars (Ptr) /= 'p') then Last := 0; return; @@ -292,7 +294,7 @@ package body Switch.M is -- Processing for -gnatep= - else + elsif Switch_Chars (Ptr) = 'p' then Ptr := Ptr + 1; if Ptr = Max then @@ -316,6 +318,9 @@ package body Switch.M is Switch_Chars (Ptr .. Max); Add_Switch_Component (To_Store); end; + + elsif Switch_Chars (Ptr) = 'G' then + Add_Switch_Component ("-gnateG"); end if; return; diff --git a/gcc/ada/system-darwin-x86.ads b/gcc/ada/system-darwin-x86.ads index 04cdbbcf94f..1b846813d4b 100644 --- a/gcc/ada/system-darwin-x86.ads +++ b/gcc/ada/system-darwin-x86.ads @@ -51,7 +51,7 @@ package System is Max_Int : constant := Long_Long_Integer'Last; Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; - Max_Nonbinary_Modulus : constant := Integer'Last; + Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1; Max_Base_Digits : constant := Long_Long_Float'Digits; Max_Digits : constant := Long_Long_Float'Digits; diff --git a/gcc/ada/system-mingw-x86_64.ads b/gcc/ada/system-mingw-x86_64.ads new file mode 100644 index 00000000000..332b283b0a0 --- /dev/null +++ b/gcc/ada/system-mingw-x86_64.ads @@ -0,0 +1,199 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M -- +-- -- +-- S p e c -- +-- (Windows Version) -- +-- -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package System is + pragma Pure; + -- Note that we take advantage of the implementation permission to make + -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada + -- 2005, this is Pure in any case (AI-362). + + type Name is (SYSTEM_NAME_GNAT); + System_Name : constant Name := SYSTEM_NAME_GNAT; + + -- System-Dependent Named Numbers + + Min_Int : constant := Long_Long_Integer'First; + Max_Int : constant := Long_Long_Integer'Last; + + Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; + Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1; + + Max_Base_Digits : constant := Long_Long_Float'Digits; + Max_Digits : constant := Long_Long_Float'Digits; + + Max_Mantissa : constant := 63; + Fine_Delta : constant := 2.0 ** (-Max_Mantissa); + + Tick : constant := 0.01; + + -- Storage-related Declarations + + type Address is private; + pragma Preelaborable_Initialization (Address); + Null_Address : constant Address; + + Storage_Unit : constant := 8; + Word_Size : constant := 64; + Memory_Size : constant := 2 ** 64; + + -- Address comparison + + function "<" (Left, Right : Address) return Boolean; + function "<=" (Left, Right : Address) return Boolean; + function ">" (Left, Right : Address) return Boolean; + function ">=" (Left, Right : Address) return Boolean; + function "=" (Left, Right : Address) return Boolean; + + pragma Import (Intrinsic, "<"); + pragma Import (Intrinsic, "<="); + pragma Import (Intrinsic, ">"); + pragma Import (Intrinsic, ">="); + pragma Import (Intrinsic, "="); + + -- Other System-Dependent Declarations + + type Bit_Order is (High_Order_First, Low_Order_First); + Default_Bit_Order : constant Bit_Order := Low_Order_First; + pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning + + -- Priority-related Declarations (RM D.1) + + Max_Priority : constant Positive := 30; + Max_Interrupt_Priority : constant Positive := 31; + + subtype Any_Priority is Integer range 0 .. 31; + subtype Priority is Any_Priority range 0 .. 30; + subtype Interrupt_Priority is Any_Priority range 31 .. 31; + + Default_Priority : constant Priority := 15; + +private + + type Address is mod Memory_Size; + Null_Address : constant Address := 0; + + -------------------------------------- + -- System Implementation Parameters -- + -------------------------------------- + + -- These parameters provide information about the target that is used + -- by the compiler. They are in the private part of System, where they + -- can be accessed using the special circuitry in the Targparm unit + -- whose source should be consulted for more detailed descriptions + -- of the individual switch values. + + Backend_Divide_Checks : constant Boolean := False; + Backend_Overflow_Checks : constant Boolean := False; + Command_Line_Args : constant Boolean := True; + Configurable_Run_Time : constant Boolean := False; + Denorm : constant Boolean := True; + Duration_32_Bits : constant Boolean := False; + Exit_Status_Supported : constant Boolean := True; + Fractional_Fixed_Ops : constant Boolean := False; + Frontend_Layout : constant Boolean := False; + Machine_Overflows : constant Boolean := False; + Machine_Rounds : constant Boolean := True; + Preallocated_Stacks : constant Boolean := False; + Signed_Zeros : constant Boolean := True; + Stack_Check_Default : constant Boolean := False; + Stack_Check_Probes : constant Boolean := True; + Stack_Check_Limits : constant Boolean := False; + Support_64_Bit_Divides : constant Boolean := True; + Support_Aggregates : constant Boolean := True; + Support_Composite_Assign : constant Boolean := True; + Support_Composite_Compare : constant Boolean := True; + Support_Long_Shifts : constant Boolean := True; + Always_Compatible_Rep : constant Boolean := False; + Suppress_Standard_Library : constant Boolean := False; + Use_Ada_Main_Program_Name : constant Boolean := False; + ZCX_By_Default : constant Boolean := True; + GCC_ZCX_Support : constant Boolean := True; + + --------------------------- + -- Underlying Priorities -- + --------------------------- + + -- Important note: this section of the file must come AFTER the + -- definition of the system implementation parameters to ensure + -- that the value of these parameters is available for analysis + -- of the declarations here (using Rtsfind at compile time). + + -- The underlying priorities table provides a generalized mechanism + -- for mapping from Ada priorities to system priorities. In some + -- cases a 1-1 mapping is not the convenient or optimal choice. + + type Priorities_Mapping is array (Any_Priority) of Integer; + pragma Suppress_Initialization (Priorities_Mapping); + -- Suppress initialization in case gnat.adc specifies Normalize_Scalars + + Underlying_Priorities : constant Priorities_Mapping := + (Priority'First .. + Default_Priority - 8 => -15, + Default_Priority - 7 => -7, + Default_Priority - 6 => -6, + Default_Priority - 5 => -5, + Default_Priority - 4 => -4, + Default_Priority - 3 => -3, + Default_Priority - 2 => -2, + Default_Priority - 1 => -1, + Default_Priority => 0, + Default_Priority + 1 => 1, + Default_Priority + 2 => 2, + Default_Priority + 3 => 3, + Default_Priority + 4 => 4, + Default_Priority + 5 => 5, + Default_Priority + 6 .. + Priority'Last => 6, + Interrupt_Priority => 15); + -- The default mapping preserves the standard 31 priorities of the Ada + -- model, but maps them using compression onto the 7 priority levels + -- available in NT and on the 16 priority levels available in 2000/XP. + + -- To replace the default values of the Underlying_Priorities mapping, + -- copy this source file into your build directory, edit the file to + -- reflect your desired behavior, and recompile using Makefile.adalib + -- which can be found under the adalib directory of your gnat installation + + pragma Linker_Options ("-Wl,--stack=0x2000000"); + -- This is used to change the default stack (32 MB) size for non tasking + -- programs. We change this value for GNAT on Windows here because the + -- binutils on this platform have switched to a too low value for Ada + -- programs. Note that we also set the stack size for tasking programs in + -- System.Task_Primitives.Operations. + +end System; diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index b3ddd631946..4f25eda7462 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -498,7 +498,7 @@ package body Tbuild is Get_Name_String (Related_Id); if Prefix /= ' ' then - pragma Assert (Is_OK_Internal_Letter (Prefix)); + pragma Assert (Is_OK_Internal_Letter (Prefix) or else Prefix = '_'); for J in reverse 1 .. Name_Len loop Name_Buffer (J + 1) := Name_Buffer (J); diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index a25cfae44fa..5fb53ae339e 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -531,17 +531,44 @@ package body Treepr is begin case M is - when Default_Mechanism => Write_Str ("Default"); - when By_Copy => Write_Str ("By_Copy"); - when By_Reference => Write_Str ("By_Reference"); - when By_Descriptor => Write_Str ("By_Descriptor"); - when By_Descriptor_UBS => Write_Str ("By_Descriptor_UBS"); - when By_Descriptor_UBSB => Write_Str ("By_Descriptor_UBSB"); - when By_Descriptor_UBA => Write_Str ("By_Descriptor_UBA"); - when By_Descriptor_S => Write_Str ("By_Descriptor_S"); - when By_Descriptor_SB => Write_Str ("By_Descriptor_SB"); - when By_Descriptor_A => Write_Str ("By_Descriptor_A"); - when By_Descriptor_NCA => Write_Str ("By_Descriptor_NCA"); + when Default_Mechanism + => Write_Str ("Default"); + when By_Copy + => Write_Str ("By_Copy"); + when By_Reference + => Write_Str ("By_Reference"); + when By_Descriptor + => Write_Str ("By_Descriptor"); + when By_Descriptor_UBS + => Write_Str ("By_Descriptor_UBS"); + when By_Descriptor_UBSB + => Write_Str ("By_Descriptor_UBSB"); + when By_Descriptor_UBA + => Write_Str ("By_Descriptor_UBA"); + when By_Descriptor_S + => Write_Str ("By_Descriptor_S"); + when By_Descriptor_SB + => Write_Str ("By_Descriptor_SB"); + when By_Descriptor_A + => Write_Str ("By_Descriptor_A"); + when By_Descriptor_NCA + => Write_Str ("By_Descriptor_NCA"); + when By_Short_Descriptor + => Write_Str ("By_Short_Descriptor"); + when By_Short_Descriptor_UBS + => Write_Str ("By_Short_Descriptor_UBS"); + when By_Short_Descriptor_UBSB + => Write_Str ("By_Short_Descriptor_UBSB"); + when By_Short_Descriptor_UBA + => Write_Str ("By_Short_Descriptor_UBA"); + when By_Short_Descriptor_S + => Write_Str ("By_Short_Descriptor_S"); + when By_Short_Descriptor_SB + => Write_Str ("By_Short_Descriptor_SB"); + when By_Short_Descriptor_A + => Write_Str ("By_Short_Descriptor_A"); + when By_Short_Descriptor_NCA + => Write_Str ("By_Short_Descriptor_NCA"); when 1 .. Mechanism_Type'Last => Write_Str ("By_Copy if size <= "); diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 9b4bfb825e4..de9c54bfe5f 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -736,7 +736,7 @@ package Types is -- passing mechanism. See specification of Sem_Mech for full details. -- The following subtype is used to represent values of this type: - subtype Mechanism_Type is Int range -10 .. Int'Last; + subtype Mechanism_Type is Int range -18 .. Int'Last; -- Type used to represent a mechanism value. This is a subtype rather -- than a type to avoid some annoying processing problems with certain -- routines in Einfo (processing them to create the corresponding C). diff --git a/gcc/ada/types.h b/gcc/ada/types.h index fb218c203a6..1d4fd67065b 100644 --- a/gcc/ada/types.h +++ b/gcc/ada/types.h @@ -328,6 +328,15 @@ typedef Int Mechanism_Type; #define By_Descriptor_A (-9) #define By_Descriptor_NCA (-10) #define By_Descriptor_Last (-10) +#define By_Short_Descriptor (-11) +#define By_Short_Descriptor_UBS (-12) +#define By_Short_Descriptor_UBSB (-13) +#define By_Short_Descriptor_UBA (-14) +#define By_Short_Descriptor_S (-15) +#define By_Short_Descriptor_SB (-16) +#define By_Short_Descriptor_A (-17) +#define By_Short_Descriptor_NCA (-18) +#define By_Short_Descriptor_Last (-18) /* Internal to Gigi. */ #define By_Copy_Return (-128) diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index 7f8e9577e86..2cab6da2dea 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -61,6 +61,7 @@ gcc -c ^ GNAT COMPILE -gnatec ^ /CONFIGURATION_PRAGMAS_FILE -gnateD ^ /SYMBOL_PREPROCESSING -gnatef ^ /FULL_PATH_IN_BRIEF_MESSAGES +-gnateG ^ /GENERATE_PROCESSED_SOURCE -gnatem ^ /MAPPING_FILE -gnatep ^ /DATA_PREPROCESSING -gnatE ^ /CHECKS=ELABORATION diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 5a1f4827eab..e4a9446ef2c 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -167,6 +167,11 @@ begin Write_Switch_Char ("ef"); Write_Line ("Full source path in brief error messages"); + -- Line for -gnateG switch + + Write_Switch_Char ("eG"); + Write_Line ("Generate preprocessed source"); + -- Line for -gnateI switch Write_Switch_Char ("eInn"); @@ -450,10 +455,10 @@ begin Write_Line (" .X* turn off warnings for non-local exceptions"); Write_Line (" y* turn on warnings for Ada 2005 incompatibility"); Write_Line (" Y turn off warnings for Ada 2005 incompatibility"); - Write_Line (" z* turn on convention/size/align warnings for " & - "unchecked conversion"); - Write_Line (" Z turn off convention/size/align warnings for " & - "unchecked conversion"); + Write_Line (" z* turn on warnings for convention/size/align " & + "mismatch on unchecked conversion"); + Write_Line (" Z turn off warnings for convention/size/align " & + "mismatch on unchecked conversion"); Write_Line (" * indicates default in above list"); -- Line for -gnatW switch diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 3270e8f55b5..63ba1df8d05 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -1526,6 +1526,14 @@ package VMS_Data is -- /VERBOSE), then error lines start with the full path name of the -- project file, rather than its simple file name. + S_GCC_Generate : aliased constant S := "/GENERATE_PROCESSED_SOURCE " & + "-gnateG"; + -- /NOGENERATE_PROCESSED_SOURCE (D) + -- /GENERATE_PROCESSED_SOURCE + -- + -- Generate a file <source>_prep if the integrated preprocessing + -- is modifying the source text. + S_GCC_GNAT : aliased constant S := "/GNAT_INTERNAL " & "-gnatg"; -- /NOGNAT_INTERNAL (D) @@ -1745,6 +1753,15 @@ package VMS_Data is -- a body is compiled, the corresponding spec is also listed, along -- with any subunits. + S_GCC_Machine : aliased constant S := "/MACHINE_CODE_LISTING " & + "-source-listing"; + -- /NOMACHINE_CODE_LISTING (D) + -- /MACHINE_CODE_LISTING + -- + -- Cause a full machine code listing of the file to be generated to + -- <filename>.lis. Interspersed source is included if the /DEBUG + -- qualifier is also present. + S_GCC_Mapping : aliased constant S := "/MAPPING_FILE=<" & "-gnatem>"; -- /MAPPING_FILE=file_name @@ -3302,6 +3319,7 @@ package VMS_Data is S_GCC_Follow 'Access, S_GCC_Force 'Access, S_GCC_Full 'Access, + S_GCC_Generate'Access, S_GCC_GNAT 'Access, S_GCC_Help 'Access, S_GCC_Ident 'Access, @@ -3316,6 +3334,7 @@ package VMS_Data is S_GCC_Length 'Access, S_GCC_List 'Access, S_GCC_Output 'Access, + S_GCC_Machine 'Access, S_GCC_Mapping 'Access, S_GCC_Mess 'Access, S_GCC_Nesting 'Access, diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb index b09cc70e773..116f364bea1 100644 --- a/gcc/ada/xref_lib.adb +++ b/gcc/ada/xref_lib.adb @@ -903,7 +903,6 @@ package body Xref_Lib is P_Line, P_Column : Natural; pragma Warnings (Off, P_Line); pragma Warnings (Off, P_Column); - begin Ptr := Ptr + 1; Parse_Number (Ali, Ptr, P_Line); diff --git a/gcc/builtins.c b/gcc/builtins.c index 2dffd53e604..953fb7bddc6 100644 --- a/gcc/builtins.c +++ b/gcc/builtins.c @@ -2911,7 +2911,7 @@ expand_builtin_pow (tree exp, rtx target, rtx subtarget) if (real_identical (&c, &cint) && ((n >= -1 && n <= 2) || (flag_unsafe_math_optimizations - && !optimize_size + && optimize_insn_for_speed_p () && powi_cost (n) <= POWI_MAX_MULTS))) { op = expand_expr (arg0, subtarget, VOIDmode, EXPAND_NORMAL); @@ -2935,7 +2935,7 @@ expand_builtin_pow (tree exp, rtx target, rtx subtarget) real_from_integer (&cint, VOIDmode, n, n < 0 ? -1 : 0, 0); if (real_identical (&c2, &cint) && ((flag_unsafe_math_optimizations - && !optimize_size + && optimize_insn_for_speed_p () && powi_cost (n/2) <= POWI_MAX_MULTS) || n == 1)) { @@ -2980,7 +2980,7 @@ expand_builtin_pow (tree exp, rtx target, rtx subtarget) real_arithmetic (&c2, RDIV_EXPR, &cint, &dconst3); real_convert (&c2, mode, &c2); if (real_identical (&c2, &c) - && ((!optimize_size + && ((optimize_insn_for_speed_p () && powi_cost (n/3) <= POWI_MAX_MULTS) || n == 1)) { @@ -3042,7 +3042,7 @@ expand_builtin_powi (tree exp, rtx target, rtx subtarget) if ((TREE_INT_CST_HIGH (arg1) == 0 || TREE_INT_CST_HIGH (arg1) == -1) && ((n >= -1 && n <= 2) - || (! optimize_size + || (optimize_insn_for_speed_p () && powi_cost (n) <= POWI_MAX_MULTS))) { op0 = expand_expr (arg0, subtarget, VOIDmode, EXPAND_NORMAL); @@ -4464,7 +4464,7 @@ expand_builtin_strcat (tree fndecl, tree exp, rtx target, enum machine_mode mode if (p && *p == '\0') return expand_expr (dst, target, mode, EXPAND_NORMAL); - if (!optimize_size) + if (optimize_insn_for_speed_p ()) { /* See if we can store by pieces into (dst + strlen(dst)). */ tree newsrc, newdst, diff --git a/gcc/cfgexpand.c b/gcc/cfgexpand.c index c9faa49d4ab..a943eff6ec1 100644 --- a/gcc/cfgexpand.c +++ b/gcc/cfgexpand.c @@ -2226,6 +2226,9 @@ expand_stack_alignment (void) gcc_assert (targetm.calls.get_drap_rtx != NULL); drap_rtx = targetm.calls.get_drap_rtx (); + /* stack_realign_drap and drap_rtx must match. */ + gcc_assert ((stack_realign_drap != 0) == (drap_rtx != NULL)); + /* Do nothing if NULL is returned, which means DRAP is not needed. */ if (NULL != drap_rtx) { diff --git a/gcc/config/i386/i386.c b/gcc/config/i386/i386.c index 46505cc4804..aed74be112e 100644 --- a/gcc/config/i386/i386.c +++ b/gcc/config/i386/i386.c @@ -3045,9 +3045,9 @@ override_options (bool main_args_p) ix86_force_align_arg_pointer = STACK_REALIGN_DEFAULT; /* Validate -mincoming-stack-boundary= value or default it to - ABI_STACK_BOUNDARY/PREFERRED_STACK_BOUNDARY. */ + MIN_STACK_BOUNDARY/PREFERRED_STACK_BOUNDARY. */ if (ix86_force_align_arg_pointer) - ix86_default_incoming_stack_boundary = ABI_STACK_BOUNDARY; + ix86_default_incoming_stack_boundary = MIN_STACK_BOUNDARY; else ix86_default_incoming_stack_boundary = PREFERRED_STACK_BOUNDARY; ix86_incoming_stack_boundary = ix86_default_incoming_stack_boundary; @@ -7287,7 +7287,8 @@ ix86_compute_frame_layout (struct ix86_frame *frame) frame->hard_frame_pointer_offset = offset; - /* Set offset to aligned because the realigned frame tarts from here. */ + /* Set offset to aligned because the realigned frame starts from + here. */ if (stack_realign_fp) offset = (offset + stack_alignment_needed -1) & -stack_alignment_needed; @@ -7520,10 +7521,10 @@ ix86_update_stack_boundary (void) /* Incoming stack alignment can be changed on individual functions via force_align_arg_pointer attribute. We use the smallest incoming stack boundary. */ - if (ix86_incoming_stack_boundary > ABI_STACK_BOUNDARY + if (ix86_incoming_stack_boundary > MIN_STACK_BOUNDARY && lookup_attribute (ix86_force_align_arg_pointer_string, TYPE_ATTRIBUTES (TREE_TYPE (current_function_decl)))) - ix86_incoming_stack_boundary = ABI_STACK_BOUNDARY; + ix86_incoming_stack_boundary = MIN_STACK_BOUNDARY; /* Stack at entrance of main is aligned by runtime. We use the smallest incoming stack boundary. */ @@ -7710,7 +7711,7 @@ ix86_expand_prologue (void) if (stack_realign_fp) { int align_bytes = crtl->stack_alignment_needed / BITS_PER_UNIT; - gcc_assert (align_bytes > STACK_BOUNDARY / BITS_PER_UNIT); + gcc_assert (align_bytes > MIN_STACK_BOUNDARY / BITS_PER_UNIT); /* Align the stack. */ insn = emit_insn ((*ix86_gen_andsp) (stack_pointer_rtx, @@ -25176,7 +25177,7 @@ ix86_expand_vector_init_one_nonzero (bool mmx_ok, enum machine_mode mode, else tmp = new_target; - emit_insn (gen_sse_shufps_1 (tmp, tmp, tmp, + emit_insn (gen_sse_shufps_v4sf (tmp, tmp, tmp, GEN_INT (1), GEN_INT (one_var == 1 ? 0 : 1), GEN_INT (one_var == 2 ? 0+4 : 1+4), @@ -25740,7 +25741,7 @@ ix86_expand_vector_set (bool mmx_ok, rtx target, rtx val, int elt) /* target = X A B B */ ix86_expand_vector_set (false, target, val, 0); /* target = A X C D */ - emit_insn (gen_sse_shufps_1 (target, target, tmp, + emit_insn (gen_sse_shufps_v4sf (target, target, tmp, GEN_INT (1), GEN_INT (0), GEN_INT (2+4), GEN_INT (3+4))); return; @@ -25751,7 +25752,7 @@ ix86_expand_vector_set (bool mmx_ok, rtx target, rtx val, int elt) /* tmp = X B C D */ ix86_expand_vector_set (false, tmp, val, 0); /* target = A B X D */ - emit_insn (gen_sse_shufps_1 (target, target, tmp, + emit_insn (gen_sse_shufps_v4sf (target, target, tmp, GEN_INT (0), GEN_INT (1), GEN_INT (0+4), GEN_INT (3+4))); return; @@ -25762,7 +25763,7 @@ ix86_expand_vector_set (bool mmx_ok, rtx target, rtx val, int elt) /* tmp = X B C D */ ix86_expand_vector_set (false, tmp, val, 0); /* target = A B X D */ - emit_insn (gen_sse_shufps_1 (target, target, tmp, + emit_insn (gen_sse_shufps_v4sf (target, target, tmp, GEN_INT (0), GEN_INT (1), GEN_INT (2+4), GEN_INT (0+4))); return; @@ -25883,7 +25884,7 @@ ix86_expand_vector_extract (bool mmx_ok, rtx target, rtx vec, int elt) case 1: case 3: tmp = gen_reg_rtx (mode); - emit_insn (gen_sse_shufps_1 (tmp, vec, vec, + emit_insn (gen_sse_shufps_v4sf (tmp, vec, vec, GEN_INT (elt), GEN_INT (elt), GEN_INT (elt+4), GEN_INT (elt+4))); break; @@ -26000,7 +26001,7 @@ ix86_expand_reduc_v4sf (rtx (*fn) (rtx, rtx, rtx), rtx dest, rtx in) emit_insn (gen_sse_movhlps (tmp1, in, in)); emit_insn (fn (tmp2, tmp1, in)); - emit_insn (gen_sse_shufps_1 (tmp3, tmp2, tmp2, + emit_insn (gen_sse_shufps_v4sf (tmp3, tmp2, tmp2, GEN_INT (1), GEN_INT (1), GEN_INT (1+4), GEN_INT (1+4))); emit_insn (fn (dest, tmp2, tmp3)); diff --git a/gcc/config/i386/i386.h b/gcc/config/i386/i386.h index a98e278e9ad..3247c10d430 100644 --- a/gcc/config/i386/i386.h +++ b/gcc/config/i386/i386.h @@ -651,14 +651,14 @@ enum target_cpu_default /* Stack boundary of the main function guaranteed by OS. */ #define MAIN_STACK_BOUNDARY (TARGET_64BIT ? 128 : 32) -/* Stack boundary guaranteed by ABI. */ -#define ABI_STACK_BOUNDARY (TARGET_64BIT ? 128 : 32) +/* Minimum stack boundary. */ +#define MIN_STACK_BOUNDARY (TARGET_64BIT ? 128 : 32) /* Boundary (in *bits*) on which the stack pointer prefers to be aligned; the compiler cannot rely on having this alignment. */ #define PREFERRED_STACK_BOUNDARY ix86_preferred_stack_boundary -/* It should be ABI_STACK_BOUNDARY. But we set it to 128 bits for +/* It should be MIN_STACK_BOUNDARY. But we set it to 128 bits for both 32bit and 64bit, to support codes that need 128 bit stack alignment for SSE instructions, but can't realign the stack. */ #define PREFERRED_STACK_BOUNDARY_DEFAULT 128 diff --git a/gcc/config/i386/mmx.md b/gcc/config/i386/mmx.md index 0a507e07a2f..8e77a30d353 100644 --- a/gcc/config/i386/mmx.md +++ b/gcc/config/i386/mmx.md @@ -65,9 +65,9 @@ (define_insn "*mov<mode>_internal_rex64" [(set (match_operand:MMXMODEI8 0 "nonimmediate_operand" - "=rm,r,!?y,!?y ,m ,!y,Y2,x,x ,m,r,x") + "=rm,r,!?y,!?y ,m ,!y,*Y2,x,x ,m,r,Yi") (match_operand:MMXMODEI8 1 "vector_move_operand" - "Cr ,m,C ,!?ym,!?y,Y2,!y,C,xm,x,x,r"))] + "Cr ,m,C ,!?ym,!?y,*Y2,!y,C,xm,x,Yi,r"))] "TARGET_64BIT && TARGET_MMX && !(MEM_P (operands[0]) && MEM_P (operands[1]))" "@ @@ -124,9 +124,9 @@ (define_insn "*movv2sf_internal_rex64" [(set (match_operand:V2SF 0 "nonimmediate_operand" - "=rm,r ,!?y,!?y ,m ,!y,Y2,x,x,x,m,r,x") + "=rm,r ,!?y,!?y ,m ,!y,*Y2,x,x,x,m,r,Yi") (match_operand:V2SF 1 "vector_move_operand" - "Cr ,m ,C ,!?ym,!y,Y2,!y,C,x,m,x,x,r"))] + "Cr ,m ,C ,!?ym,!y,*Y2,!y,C,x,m,x,Yi,r"))] "TARGET_64BIT && TARGET_MMX && !(MEM_P (operands[0]) && MEM_P (operands[1]))" "@ diff --git a/gcc/config/i386/sse.md b/gcc/config/i386/sse.md index c1d306054ad..baa9976d400 100644 --- a/gcc/config/i386/sse.md +++ b/gcc/config/i386/sse.md @@ -36,6 +36,10 @@ (define_mode_iterator SSEMODEF4 [SF DF V4SF V2DF]) (define_mode_iterator SSEMODEF2P [V4SF V2DF]) +;; Int-float size matches +(define_mode_iterator SSEMODE4S [V4SF V4SI]) +(define_mode_iterator SSEMODE2D [V2DF V2DI]) + ;; Mapping from float mode to required SSE level (define_mode_attr sse [(SF "sse") (DF "sse2") (V4SF "sse") (V2DF "sse2")]) @@ -57,6 +61,10 @@ (V16QI "QI") (V8HI "HI") (V4SI "SI") (V2DI "DI")]) +;; Mapping of vector modes to a vector mode of double size +(define_mode_attr ssedoublesizemode [(V2DF "V4DF") (V2DI "V4DI") + (V4SF "V8SF") (V4SI "V8SI")]) + ;; Number of scalar elements in each vector type (define_mode_attr ssescalarnum [(V4SF "4") (V2DF "2") (V16QI "16") (V8HI "8") @@ -2129,7 +2137,7 @@ "TARGET_SSE" { int mask = INTVAL (operands[3]); - emit_insn (gen_sse_shufps_1 (operands[0], operands[1], operands[2], + emit_insn (gen_sse_shufps_v4sf (operands[0], operands[1], operands[2], GEN_INT ((mask >> 0) & 3), GEN_INT ((mask >> 2) & 3), GEN_INT (((mask >> 4) & 3) + 4), @@ -2137,12 +2145,12 @@ DONE; }) -(define_insn "sse_shufps_1" - [(set (match_operand:V4SF 0 "register_operand" "=x") - (vec_select:V4SF - (vec_concat:V8SF - (match_operand:V4SF 1 "register_operand" "0") - (match_operand:V4SF 2 "nonimmediate_operand" "xm")) +(define_insn "sse_shufps_<mode>" + [(set (match_operand:SSEMODE4S 0 "register_operand" "=x") + (vec_select:SSEMODE4S + (vec_concat:<ssedoublesizemode> + (match_operand:SSEMODE4S 1 "register_operand" "0") + (match_operand:SSEMODE4S 2 "nonimmediate_operand" "xm")) (parallel [(match_operand 3 "const_0_to_3_operand" "") (match_operand 4 "const_0_to_3_operand" "") (match_operand 5 "const_4_to_7_operand" "") @@ -2540,18 +2548,62 @@ "TARGET_SSE2" { int mask = INTVAL (operands[3]); - emit_insn (gen_sse2_shufpd_1 (operands[0], operands[1], operands[2], + emit_insn (gen_sse2_shufpd_v2df (operands[0], operands[1], operands[2], GEN_INT (mask & 1), GEN_INT (mask & 2 ? 3 : 2))); DONE; }) -(define_insn "sse2_shufpd_1" - [(set (match_operand:V2DF 0 "register_operand" "=x") - (vec_select:V2DF - (vec_concat:V4DF - (match_operand:V2DF 1 "register_operand" "0") - (match_operand:V2DF 2 "nonimmediate_operand" "xm")) +(define_expand "vec_extract_even<mode>" + [(set (match_operand:SSEMODE4S 0 "register_operand" "") + (vec_select:SSEMODE4S + (vec_concat:<ssedoublesizemode> + (match_operand:SSEMODE4S 1 "register_operand" "") + (match_operand:SSEMODE4S 2 "nonimmediate_operand" "")) + (parallel [(const_int 0) + (const_int 2) + (const_int 4) + (const_int 6)])))] + "TARGET_SSE") + +(define_expand "vec_extract_odd<mode>" + [(set (match_operand:SSEMODE4S 0 "register_operand" "") + (vec_select:SSEMODE4S + (vec_concat:<ssedoublesizemode> + (match_operand:SSEMODE4S 1 "register_operand" "") + (match_operand:SSEMODE4S 2 "nonimmediate_operand" "")) + (parallel [(const_int 1) + (const_int 3) + (const_int 5) + (const_int 7)])))] + "TARGET_SSE") + +(define_expand "vec_extract_even<mode>" + [(set (match_operand:SSEMODE2D 0 "register_operand" "") + (vec_select:SSEMODE2D + (vec_concat:<ssedoublesizemode> + (match_operand:SSEMODE2D 1 "register_operand" "") + (match_operand:SSEMODE2D 2 "nonimmediate_operand" "")) + (parallel [(const_int 0) + (const_int 2)])))] + "TARGET_SSE2") + +(define_expand "vec_extract_odd<mode>" + [(set (match_operand:SSEMODE2D 0 "register_operand" "") + (vec_select:SSEMODE2D + (vec_concat:<ssedoublesizemode> + (match_operand:SSEMODE2D 1 "register_operand" "") + (match_operand:SSEMODE2D 2 "nonimmediate_operand" "")) + (parallel [(const_int 1) + (const_int 3)])))] + "TARGET_SSE2") + +(define_insn "sse2_shufpd_<mode>" + [(set (match_operand:SSEMODE2D 0 "register_operand" "=x") + (vec_select:SSEMODE2D + (vec_concat:<ssedoublesizemode> + (match_operand:SSEMODE2D 1 "register_operand" "0") + (match_operand:SSEMODE2D 2 "nonimmediate_operand" "xm")) (parallel [(match_operand 3 "const_0_to_1_operand" "") (match_operand 4 "const_2_to_3_operand" "")])))] "TARGET_SSE2" @@ -4195,6 +4247,46 @@ DONE; }) +(define_expand "vec_interleave_highv4sf" + [(set (match_operand:V4SF 0 "register_operand" "") + (vec_select:V4SF + (vec_concat:V8SF + (match_operand:V4SF 1 "register_operand" "") + (match_operand:V4SF 2 "nonimmediate_operand" "")) + (parallel [(const_int 2) (const_int 6) + (const_int 3) (const_int 7)])))] + "TARGET_SSE") + +(define_expand "vec_interleave_lowv4sf" + [(set (match_operand:V4SF 0 "register_operand" "") + (vec_select:V4SF + (vec_concat:V8SF + (match_operand:V4SF 1 "register_operand" "") + (match_operand:V4SF 2 "nonimmediate_operand" "")) + (parallel [(const_int 0) (const_int 4) + (const_int 1) (const_int 5)])))] + "TARGET_SSE") + +(define_expand "vec_interleave_highv2df" + [(set (match_operand:V2DF 0 "register_operand" "") + (vec_select:V2DF + (vec_concat:V4DF + (match_operand:V2DF 1 "register_operand" "") + (match_operand:V2DF 2 "nonimmediate_operand" "")) + (parallel [(const_int 1) + (const_int 3)])))] + "TARGET_SSE2") + +(define_expand "vec_interleave_lowv2df" + [(set (match_operand:V2DF 0 "register_operand" "") + (vec_select:V2DF + (vec_concat:V4DF + (match_operand:V2DF 1 "register_operand" "") + (match_operand:V2DF 2 "nonimmediate_operand" "")) + (parallel [(const_int 0) + (const_int 2)])))] + "TARGET_SSE2") + (define_insn "sse2_packsswb" [(set (match_operand:V16QI 0 "register_operand" "=x") (vec_concat:V16QI @@ -4685,7 +4777,7 @@ "") (define_insn "*sse2_storeq_rex64" - [(set (match_operand:DI 0 "nonimmediate_operand" "=mx,r,r") + [(set (match_operand:DI 0 "nonimmediate_operand" "=mx,*r,r") (vec_select:DI (match_operand:V2DI 1 "nonimmediate_operand" "x,Yi,o") (parallel [(const_int 0)])))] @@ -4848,10 +4940,10 @@ (set_attr "mode" "TI,V4SF,V2SF")]) (define_insn "vec_concatv2di" - [(set (match_operand:V2DI 0 "register_operand" "=Y2,?Y2,Y2,x,x,x") + [(set (match_operand:V2DI 0 "register_operand" "=Y2 ,?Y2,Y2,x,x,x") (vec_concat:V2DI - (match_operand:DI 1 "nonimmediate_operand" " m,*y ,0 ,0,0,m") - (match_operand:DI 2 "vector_move_operand" " C, C,Y2,x,m,0")))] + (match_operand:DI 1 "nonimmediate_operand" " mY2,*y ,0 ,0,0,m") + (match_operand:DI 2 "vector_move_operand" " C , C,Y2,x,m,0")))] "!TARGET_64BIT && TARGET_SSE" "@ movq\t{%1, %0|%0, %1} @@ -4864,10 +4956,10 @@ (set_attr "mode" "TI,TI,TI,V4SF,V2SF,V2SF")]) (define_insn "*vec_concatv2di_rex64_sse4_1" - [(set (match_operand:V2DI 0 "register_operand" "=x,x,Yi,!x,x,x,x,x") + [(set (match_operand:V2DI 0 "register_operand" "=x ,x ,Yi,!x,x,x,x,x") (vec_concat:V2DI - (match_operand:DI 1 "nonimmediate_operand" " 0,m,r ,*y,0,0,0,m") - (match_operand:DI 2 "vector_move_operand" "rm,C,C ,C ,x,x,m,0")))] + (match_operand:DI 1 "nonimmediate_operand" " 0 ,mx,r ,*y,0,0,0,m") + (match_operand:DI 2 "vector_move_operand" " rm,C ,C ,C ,x,x,m,0")))] "TARGET_64BIT && TARGET_SSE4_1" "@ pinsrq\t{$0x1, %2, %0|%0, %2, 0x1} @@ -4883,10 +4975,10 @@ (set_attr "mode" "TI,TI,TI,TI,TI,V4SF,V2SF,V2SF")]) (define_insn "*vec_concatv2di_rex64_sse" - [(set (match_operand:V2DI 0 "register_operand" "=Y2,Yi,!Y2,Y2,x,x,x") + [(set (match_operand:V2DI 0 "register_operand" "=Y2 ,Yi,!Y2,Y2,x,x,x") (vec_concat:V2DI - (match_operand:DI 1 "nonimmediate_operand" " m,r ,*y ,0 ,0,0,m") - (match_operand:DI 2 "vector_move_operand" " C,C ,C ,Y2,x,m,0")))] + (match_operand:DI 1 "nonimmediate_operand" " mY2,r ,*y ,0 ,0,0,m") + (match_operand:DI 2 "vector_move_operand" " C ,C ,C ,Y2,x,m,0")))] "TARGET_64BIT && TARGET_SSE" "@ movq\t{%1, %0|%0, %1} diff --git a/gcc/configure b/gcc/configure index 218989bf3d9..e802afa8091 100755 --- a/gcc/configure +++ b/gcc/configure @@ -458,7 +458,7 @@ ac_includes_default="\ # include <unistd.h> #endif" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical build_libsubdir build_subdir host_subdir target_subdir GENINSRC CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT GNATBIND ac_ct_GNATBIND GNATMAKE ac_ct_GNATMAKE NO_MINUS_C_MINUS_O OUTPUT_OPTION CPP EGREP ppllibs pplinc ltdllibs ltdlinc ltdl_ldflags gdbmlibs gdbminc gdbm_ldflags COMPILER_PROBE_OBJECT BASILYSMELT_OBJECT loose_warn strict_warn warn_cflags nocommon_flag TREEBROWSER valgrind_path valgrind_path_defines valgrind_command coverage_flags enable_multilib enable_decimal_float enable_fixed_point enable_shared TARGET_SYSTEM_ROOT TARGET_SYSTEM_ROOT_DEFINE CROSS_SYSTEM_HEADER_DIR onestep PKGVERSION REPORT_BUGS_TO REPORT_BUGS_TEXI datarootdir docdir htmldir SET_MAKE AWK LN_S LN RANLIB ac_ct_RANLIB ranlib_flags INSTALL INSTALL_PROGRAM INSTALL_DATA make_compare_target have_mktemp_command MAKEINFO BUILD_INFO GENERATED_MANPAGES FLEX BISON NM AR COLLECT2_LIBS GNAT_LIBEXC LDEXP_LIB TARGET_GETGROUPS_T LIBICONV LTLIBICONV LIBICONV_DEP manext objext gthread_flags extra_modes_file extra_opt_files USE_NLS LIBINTL LIBINTL_DEP INCINTL XGETTEXT GMSGFMT POSUB CATALOGS DATADIRNAME INSTOBJEXT GENCAT CATOBJEXT host_cc_for_libada CROSS ALL SYSTEM_HEADER_DIR inhibit_libc CC_FOR_BUILD BUILD_CFLAGS BUILD_LDFLAGS STMP_FIXINC STMP_FIXPROTO collect2 LIBTOOL SED FGREP GREP LD DUMPBIN ac_ct_DUMPBIN ac_ct_AR STRIP ac_ct_STRIP lt_ECHO objdir enable_fast_install gcc_cv_as ORIGINAL_AS_FOR_TARGET gcc_cv_ld ORIGINAL_LD_FOR_TARGET gcc_cv_nm ORIGINAL_NM_FOR_TARGET gcc_cv_objdump libgcc_visibility GGC zlibdir zlibinc MAINT gcc_tooldir dollar slibdir subdirs srcdir all_compilers all_gtfiles all_lang_makefrags all_lang_makefiles all_languages all_selected_languages build_exeext build_install_headers_dir build_xm_file_list build_xm_include_list build_xm_defines build_file_translate check_languages cpp_install_dir xmake_file tmake_file extra_gcc_objs extra_headers_list extra_objs extra_parts extra_passes extra_programs float_h_file gcc_config_arguments gcc_gxx_include_dir host_exeext host_xm_file_list host_xm_include_list host_xm_defines out_host_hook_obj install lang_opt_files lang_specs_files lang_tree_files local_prefix md_file objc_boehm_gc out_file out_object_file thread_file tm_file_list tm_include_list tm_defines tm_p_file_list tm_p_include_list xm_file_list xm_include_list xm_defines c_target_objs cxx_target_objs fortran_target_objs target_cpu_default GMPLIBS GMPINC LIBOBJS LTLIBOBJS' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical build_libsubdir build_subdir host_subdir target_subdir GENINSRC CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT GNATBIND ac_ct_GNATBIND GNATMAKE ac_ct_GNATMAKE NO_MINUS_C_MINUS_O OUTPUT_OPTION CPP EGREP ppllibs pplinc ltdllibs ltdlinc ltdl_ldflags gdbmlibs gdbminc gdbm_ldflags COMPILER_PROBE_OBJECT BASILYSMELT_OBJECT loose_warn strict_warn warn_cflags nocommon_flag TREEBROWSER valgrind_path valgrind_path_defines valgrind_command coverage_flags enable_multilib enable_decimal_float enable_fixed_point enable_shared TARGET_SYSTEM_ROOT TARGET_SYSTEM_ROOT_DEFINE CROSS_SYSTEM_HEADER_DIR onestep PKGVERSION REPORT_BUGS_TO REPORT_BUGS_TEXI datarootdir docdir htmldir SET_MAKE AWK LN_S LN RANLIB ac_ct_RANLIB ranlib_flags INSTALL INSTALL_PROGRAM INSTALL_DATA make_compare_target have_mktemp_command MAKEINFO BUILD_INFO GENERATED_MANPAGES FLEX BISON NM AR COLLECT2_LIBS GNAT_LIBEXC LDEXP_LIB TARGET_GETGROUPS_T LIBICONV LTLIBICONV LIBICONV_DEP manext objext gthread_flags extra_modes_file extra_opt_files USE_NLS LIBINTL LIBINTL_DEP INCINTL XGETTEXT GMSGFMT POSUB CATALOGS DATADIRNAME INSTOBJEXT GENCAT CATOBJEXT CROSS ALL SYSTEM_HEADER_DIR inhibit_libc CC_FOR_BUILD BUILD_CFLAGS BUILD_LDFLAGS STMP_FIXINC STMP_FIXPROTO collect2 LIBTOOL SED FGREP GREP LD DUMPBIN ac_ct_DUMPBIN ac_ct_AR STRIP ac_ct_STRIP lt_ECHO objdir enable_fast_install gcc_cv_as ORIGINAL_AS_FOR_TARGET gcc_cv_ld ORIGINAL_LD_FOR_TARGET gcc_cv_nm ORIGINAL_NM_FOR_TARGET gcc_cv_objdump libgcc_visibility GGC zlibdir zlibinc MAINT gcc_tooldir dollar slibdir subdirs srcdir all_compilers all_gtfiles all_lang_makefrags all_lang_makefiles all_languages all_selected_languages build_exeext build_install_headers_dir build_xm_file_list build_xm_include_list build_xm_defines build_file_translate check_languages cpp_install_dir xmake_file tmake_file extra_gcc_objs extra_headers_list extra_objs extra_parts extra_passes extra_programs float_h_file gcc_config_arguments gcc_gxx_include_dir host_exeext host_xm_file_list host_xm_include_list host_xm_defines out_host_hook_obj install lang_opt_files lang_specs_files lang_tree_files local_prefix md_file objc_boehm_gc out_file out_object_file thread_file tm_file_list tm_include_list tm_defines tm_p_file_list tm_p_include_list xm_file_list xm_include_list xm_defines c_target_objs cxx_target_objs fortran_target_objs target_cpu_default GMPLIBS GMPINC LIBOBJS LTLIBOBJS' ac_subst_files='language_hooks' ac_pwd=`pwd` @@ -14611,10 +14611,6 @@ do done tmake_file="${tmake_file_}" -# This is a terrible hack which will go away some day. -host_cc_for_libada=${CC} - - out_object_file=`basename $out_file .c`.o tm_file_list="options.h" @@ -15372,13 +15368,13 @@ if test "${lt_cv_nm_interface+set}" = set; then else lt_cv_nm_interface="BSD nm" echo "int some_variable = 0;" > conftest.$ac_ext - (eval echo "\"\$as_me:15375: $ac_compile\"" >&5) + (eval echo "\"\$as_me:15371: $ac_compile\"" >&5) (eval "$ac_compile" 2>conftest.err) cat conftest.err >&5 - (eval echo "\"\$as_me:15378: $NM \\\"conftest.$ac_objext\\\"\"" >&5) + (eval echo "\"\$as_me:15374: $NM \\\"conftest.$ac_objext\\\"\"" >&5) (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) cat conftest.err >&5 - (eval echo "\"\$as_me:15381: output\"" >&5) + (eval echo "\"\$as_me:15377: output\"" >&5) cat conftest.out >&5 if $GREP 'External.*some_variable' conftest.out > /dev/null; then lt_cv_nm_interface="MS dumpbin" @@ -16433,7 +16429,7 @@ ia64-*-hpux*) ;; *-*-irix6*) # Find out which ABI we are using. - echo '#line 16436 "configure"' > conftest.$ac_ext + echo '#line 16432 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? @@ -17053,11 +17049,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:17056: $lt_compile\"" >&5) + (eval echo "\"\$as_me:17052: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:17060: \$? = $ac_status" >&5 + echo "$as_me:17056: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. @@ -17375,11 +17371,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:17378: $lt_compile\"" >&5) + (eval echo "\"\$as_me:17374: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:17382: \$? = $ac_status" >&5 + echo "$as_me:17378: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. @@ -17480,11 +17476,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:17483: $lt_compile\"" >&5) + (eval echo "\"\$as_me:17479: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 - echo "$as_me:17487: \$? = $ac_status" >&5 + echo "$as_me:17483: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized @@ -17535,11 +17531,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:17538: $lt_compile\"" >&5) + (eval echo "\"\$as_me:17534: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 - echo "$as_me:17542: \$? = $ac_status" >&5 + echo "$as_me:17538: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized @@ -20332,7 +20328,7 @@ else lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF -#line 20335 "configure" +#line 20331 "configure" #include "confdefs.h" #if HAVE_DLFCN_H @@ -20432,7 +20428,7 @@ else lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF -#line 20435 "configure" +#line 20431 "configure" #include "confdefs.h" #if HAVE_DLFCN_H @@ -24234,7 +24230,7 @@ lang_tree_files= # `language' must be a single word so is spelled singularly. all_languages= all_compilers= -all_outputs='Makefile gccbug libada-mk' +all_outputs='Makefile gccbug' # List of language makefile fragments. all_lang_makefrags= # List of language subdirectory makefiles. Deprecated. @@ -25271,7 +25267,6 @@ s,@DATADIRNAME@,$DATADIRNAME,;t t s,@INSTOBJEXT@,$INSTOBJEXT,;t t s,@GENCAT@,$GENCAT,;t t s,@CATOBJEXT@,$CATOBJEXT,;t t -s,@host_cc_for_libada@,$host_cc_for_libada,;t t s,@CROSS@,$CROSS,;t t s,@ALL@,$ALL,;t t s,@SYSTEM_HEADER_DIR@,$SYSTEM_HEADER_DIR,;t t diff --git a/gcc/configure.ac b/gcc/configure.ac index 7e9a5a3e86e..5ba1d8c1215 100644 --- a/gcc/configure.ac +++ b/gcc/configure.ac @@ -1914,10 +1914,6 @@ do done tmake_file="${tmake_file_}" -# This is a terrible hack which will go away some day. -host_cc_for_libada=${CC} -AC_SUBST(host_cc_for_libada) - out_object_file=`basename $out_file .c`.o tm_file_list="options.h" @@ -3876,7 +3872,7 @@ lang_tree_files= # `language' must be a single word so is spelled singularly. all_languages= all_compilers= -all_outputs='Makefile gccbug libada-mk' +all_outputs='Makefile gccbug' # List of language makefile fragments. all_lang_makefrags= # List of language subdirectory makefiles. Deprecated. diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index 7e29d2af746..e5128d4886d 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -1256,10 +1256,10 @@ compute_barrier_args_size (void) { while (!VEC_empty (rtx, worklist)) { - rtx prev, body; + rtx prev, body, first_insn; HOST_WIDE_INT cur_args_size; - insn = VEC_pop (rtx, worklist); + first_insn = insn = VEC_pop (rtx, worklist); cur_args_size = barrier_args_size[INSN_UID (insn)]; prev = prev_nonnote_insn (insn); if (prev && BARRIER_P (prev)) @@ -1274,10 +1274,21 @@ compute_barrier_args_size (void) if (LABEL_P (insn)) { - gcc_assert (barrier_args_size[INSN_UID (insn)] < 0 - || barrier_args_size[INSN_UID (insn)] + if (insn == first_insn) + continue; + else if (barrier_args_size[INSN_UID (insn)] < 0) + { + barrier_args_size[INSN_UID (insn)] = cur_args_size; + continue; + } + else + { + /* The insns starting with this label have been + already scanned or are in the worklist. */ + gcc_assert (barrier_args_size[INSN_UID (insn)] == cur_args_size); - continue; + break; + } } body = PATTERN (insn); @@ -1356,11 +1367,18 @@ dwarf2out_stack_adjust (rtx insn, bool after_p) } else if (BARRIER_P (insn)) { - if (barrier_args_size == NULL) + /* Don't call compute_barrier_args_size () if the only + BARRIER is at the end of function. */ + if (barrier_args_size == NULL && next_nonnote_insn (insn)) compute_barrier_args_size (); - offset = barrier_args_size[INSN_UID (insn)]; - if (offset < 0) + if (barrier_args_size == NULL) offset = 0; + else + { + offset = barrier_args_size[INSN_UID (insn)]; + if (offset < 0) + offset = 0; + } offset -= args_size; #ifndef STACK_GROWS_DOWNWARD diff --git a/gcc/expmed.c b/gcc/expmed.c index d5127b3c344..b102241dbb1 100644 --- a/gcc/expmed.c +++ b/gcc/expmed.c @@ -3487,7 +3487,7 @@ expand_smod_pow2 (enum machine_mode mode, rtx op0, HOST_WIDE_INT d) /* Avoid conditional branches when they're expensive. */ if (BRANCH_COST >= 2 - && !optimize_size) + && optimize_insn_for_speed_p ()) { rtx signmask = emit_store_flag (result, LT, op0, const0_rtx, mode, 0, -1); diff --git a/gcc/function.c b/gcc/function.c index b9d9ec59cc0..637775160eb 100644 --- a/gcc/function.c +++ b/gcc/function.c @@ -1215,10 +1215,10 @@ instantiate_new_reg (rtx x, HOST_WIDE_INT *poffset) if (x == virtual_incoming_args_rtx) { - /* Replace virtual_incoming_args_rtx to internal arg pointer here */ - if (crtl->args.internal_arg_pointer != virtual_incoming_args_rtx) + if (stack_realign_drap) { - gcc_assert (stack_realign_drap); + /* Replace virtual_incoming_args_rtx with internal arg + pointer if DRAP is used to realign stack. */ new = crtl->args.internal_arg_pointer; offset = 0; } diff --git a/gcc/gimplify.c b/gcc/gimplify.c index 0f5605abf81..e7fc1679aa3 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -2465,7 +2465,7 @@ gimplify_call_expr (tree *expr_p, gimple_seq *pre_p, bool want_value) } else { - *expr_p = NULL_TREE; + *expr_p = error_mark_node; return GS_ERROR; } diff --git a/gcc/libada-mk.in b/gcc/libada-mk.in deleted file mode 100644 index 2b795d6a693..00000000000 --- a/gcc/libada-mk.in +++ /dev/null @@ -1,29 +0,0 @@ -# Copyright 2004, 2007 Free Software Foundation, Inc. - -#This file is part of GCC. - -#GCC is free software; you can redistribute it and/or modify -#it under the terms of the GNU General Public License as published by -#the Free Software Foundation; either version 3, or (at your option) -#any later version. - -#GCC is distributed in the hope that it will be useful, -#but WITHOUT ANY WARRANTY; without even the implied warranty of -#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -#GNU General Public License for more details. - -#You should have received a copy of the GNU General Public License -#along with GCC; see the file COPYING3. If not see -#<http://www.gnu.org/licenses/>. - -# GCC's Makefile fragment for libada. -# libada needs some information from the GCC configure file at the moment, -# and this exists to transfer that information in as clean a way as possible. - -exeext=@host_exeext@ -libdir=@libdir@ -NOCOMMON_FLAG=@nocommon_flag@ -WARN_CFLAGS=@warn_cflags@ -gcc_tmake_file=@tmake_file@ -gcc_xmake_file=@xmake_file@ -host_cc_for_libada=@host_cc_for_libada@ diff --git a/gcc/matrix-reorg.c b/gcc/matrix-reorg.c index 9ebbcde5608..846a813898f 100644 --- a/gcc/matrix-reorg.c +++ b/gcc/matrix-reorg.c @@ -143,8 +143,6 @@ along with GCC; see the file COPYING3. If not see #include "tree-chrec.h" #include "tree-scalar-evolution.h" - /* FIXME tuples. */ -#if 0 /* We need to collect a lot of data from the original malloc, particularly as the gimplifier has converted: @@ -163,11 +161,14 @@ along with GCC; see the file COPYING3. If not see struct malloc_call_data { - tree call_stmt; /* Tree for "T4 = malloc (T3);" */ + gimple call_stmt; /* Tree for "T4 = malloc (T3);" */ tree size_var; /* Var decl for T3. */ tree malloc_size; /* Tree for "<constant>", the rhs assigned to T3. */ }; +static tree can_calculate_expr_before_stmt (tree, sbitmap); +static tree can_calculate_stmt_before_stmt (gimple, sbitmap); + /* The front end of the compiler, when parsing statements of the form: var = (type_cast) malloc (sizeof (type)); @@ -187,24 +188,20 @@ struct malloc_call_data need to find the rest of the variables/statements on our own. That is what the following function does. */ static void -collect_data_for_malloc_call (tree stmt, struct malloc_call_data *m_data) +collect_data_for_malloc_call (gimple stmt, struct malloc_call_data *m_data) { tree size_var = NULL; tree malloc_fn_decl; - tree tmp; tree arg1; - gcc_assert (TREE_CODE (stmt) == GIMPLE_MODIFY_STMT); + gcc_assert (is_gimple_call (stmt)); - tmp = get_call_expr_in (stmt); - malloc_fn_decl = CALL_EXPR_FN (tmp); - if (TREE_CODE (malloc_fn_decl) != ADDR_EXPR - || TREE_CODE (TREE_OPERAND (malloc_fn_decl, 0)) != FUNCTION_DECL - || DECL_FUNCTION_CODE (TREE_OPERAND (malloc_fn_decl, 0)) != - BUILT_IN_MALLOC) + malloc_fn_decl = gimple_call_fndecl (stmt); + if (malloc_fn_decl == NULL + || DECL_FUNCTION_CODE (malloc_fn_decl) != BUILT_IN_MALLOC) return; - arg1 = CALL_EXPR_ARG (tmp, 0); + arg1 = gimple_call_arg (stmt, 0); size_var = arg1; m_data->call_stmt = stmt; @@ -223,7 +220,7 @@ collect_data_for_malloc_call (tree stmt, struct malloc_call_data *m_data) struct access_site_info { /* The statement (INDIRECT_REF or POINTER_PLUS_EXPR). */ - tree stmt; + gimple stmt; /* In case of POINTER_PLUS_EXPR, what is the offset. */ tree offset; @@ -262,7 +259,7 @@ struct matrix_info 0 to ACTUAL_DIM - k escapes. */ int min_indirect_level_escape; - tree min_indirect_level_escape_stmt; + gimple min_indirect_level_escape_stmt; /* Is the matrix transposed. */ bool is_transposed_p; @@ -271,7 +268,7 @@ struct matrix_info We can use NUM_DIMS as the upper bound and allocate the array once with this number of elements and no need to use realloc and MAX_MALLOCED_LEVEL. */ - tree *malloc_for_level; + gimple *malloc_for_level; int max_malloced_level; @@ -282,7 +279,7 @@ struct matrix_info /* The calls to free for each level of indirection. */ struct free_info { - tree stmt; + gimple stmt; tree func; } *free_stmts; @@ -322,7 +319,7 @@ struct matrix_info struct matrix_access_phi_node { - tree phi; + gimple phi; int indirection_level; }; @@ -408,28 +405,20 @@ mtt_info_eq (const void *mtt1, const void *mtt2) return false; } -/* Return the inner most tree that is not a cast. */ -static tree -get_inner_of_cast_expr (tree t) -{ - while (CONVERT_EXPR_P (t) - || TREE_CODE (t) == VIEW_CONVERT_EXPR) - t = TREE_OPERAND (t, 0); - - return t; -} - /* Return false if STMT may contain a vector expression. In this situation, all matrices should not be flattened. */ static bool -may_flatten_matrices_1 (tree stmt) +may_flatten_matrices_1 (gimple stmt) { tree t; - switch (TREE_CODE (stmt)) + switch (gimple_code (stmt)) { - case GIMPLE_MODIFY_STMT: - t = TREE_OPERAND (stmt, 1); + case GIMPLE_ASSIGN: + if (!gimple_assign_cast_p (stmt)) + return true; + + t = gimple_assign_rhs1 (stmt); while (CONVERT_EXPR_P (t)) { if (TREE_TYPE (t) && POINTER_TYPE_P (TREE_TYPE (t))) @@ -450,7 +439,7 @@ may_flatten_matrices_1 (tree stmt) t = TREE_OPERAND (t, 0); } break; - case ASM_EXPR: + case GIMPLE_ASM: /* Asm code could contain vector operations. */ return false; break; @@ -468,15 +457,15 @@ may_flatten_matrices (struct cgraph_node *node) tree decl; struct function *func; basic_block bb; - block_stmt_iterator bsi; + gimple_stmt_iterator gsi; decl = node->decl; if (node->analyzed) { func = DECL_STRUCT_FUNCTION (decl); FOR_EACH_BB_FN (bb, func) - for (bsi = bsi_start (bb); !bsi_end_p (bsi); bsi_next (&bsi)) - if (!may_flatten_matrices_1 (bsi_stmt (bsi))) + for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) + if (!may_flatten_matrices_1 (gsi_stmt (gsi))) return false; } return true; @@ -597,7 +586,7 @@ find_matrices_decl (void) /* Mark that the matrix MI escapes at level L. */ static void -mark_min_matrix_escape_level (struct matrix_info *mi, int l, tree s) +mark_min_matrix_escape_level (struct matrix_info *mi, int l, gimple s) { if (mi->min_indirect_level_escape == -1 || (mi->min_indirect_level_escape > l)) @@ -610,19 +599,13 @@ mark_min_matrix_escape_level (struct matrix_info *mi, int l, tree s) /* Find if the SSA variable is accessed inside the tree and record the tree containing it. The only relevant uses are the case of SSA_NAME, or SSA inside - INDIRECT_REF, CALL_EXPR, PLUS_EXPR, POINTER_PLUS_EXPR, MULT_EXPR. */ + INDIRECT_REF, PLUS_EXPR, POINTER_PLUS_EXPR, MULT_EXPR. */ static void ssa_accessed_in_tree (tree t, struct ssa_acc_in_tree *a) { - tree call, decl; - tree arg; - call_expr_arg_iterator iter; - a->t_code = TREE_CODE (t); switch (a->t_code) { - tree op1, op2; - case SSA_NAME: if (t == a->ssa_var) a->var_found = true; @@ -632,24 +615,59 @@ ssa_accessed_in_tree (tree t, struct ssa_acc_in_tree *a) && TREE_OPERAND (t, 0) == a->ssa_var) a->var_found = true; break; - case CALL_EXPR: - FOR_EACH_CALL_EXPR_ARG (arg, iter, t) - { - if (arg == a->ssa_var) - { - a->var_found = true; - call = get_call_expr_in (t); - if (call && (decl = get_callee_fndecl (call))) - a->t_tree = decl; - break; - } - } + default: + break; + } +} + +/* Find if the SSA variable is accessed on the right hand side of + gimple call STMT. */ + +static void +ssa_accessed_in_call_rhs (gimple stmt, struct ssa_acc_in_tree *a) +{ + tree decl; + tree arg; + size_t i; + + a->t_code = CALL_EXPR; + for (i = 0; i < gimple_call_num_args (stmt); i++) + { + arg = gimple_call_arg (stmt, i); + if (arg == a->ssa_var) + { + a->var_found = true; + decl = gimple_call_fndecl (stmt); + a->t_tree = decl; + break; + } + } +} + +/* Find if the SSA variable is accessed on the right hand side of + gimple assign STMT. */ + +static void +ssa_accessed_in_assign_rhs (gimple stmt, struct ssa_acc_in_tree *a) +{ + + a->t_code = gimple_assign_rhs_code (stmt); + switch (a->t_code) + { + tree op1, op2; + + case SSA_NAME: + case INDIRECT_REF: + case CONVERT_EXPR: + case NOP_EXPR: + case VIEW_CONVERT_EXPR: + ssa_accessed_in_tree (gimple_assign_rhs1 (stmt), a); break; case POINTER_PLUS_EXPR: case PLUS_EXPR: case MULT_EXPR: - op1 = TREE_OPERAND (t, 0); - op2 = TREE_OPERAND (t, 1); + op1 = gimple_assign_rhs1 (stmt); + op2 = gimple_assign_rhs2 (stmt); if (op1 == a->ssa_var) { @@ -670,7 +688,7 @@ ssa_accessed_in_tree (tree t, struct ssa_acc_in_tree *a) /* Record the access/allocation site information for matrix MI so we can handle it later in transformation. */ static void -record_access_alloc_site_info (struct matrix_info *mi, tree stmt, tree offset, +record_access_alloc_site_info (struct matrix_info *mi, gimple stmt, tree offset, tree index, int level, bool is_alloc) { struct access_site_info *acc_info; @@ -697,7 +715,7 @@ record_access_alloc_site_info (struct matrix_info *mi, tree stmt, tree offset, all the allocation sites could be pre-calculated before the call to the malloc of level 0 (the main malloc call). */ static void -add_allocation_site (struct matrix_info *mi, tree stmt, int level) +add_allocation_site (struct matrix_info *mi, gimple stmt, int level) { struct malloc_call_data mcd; @@ -740,13 +758,13 @@ add_allocation_site (struct matrix_info *mi, tree stmt, int level) calls like calloc and realloc. */ if (!mi->malloc_for_level) { - mi->malloc_for_level = XCNEWVEC (tree, level + 1); + mi->malloc_for_level = XCNEWVEC (gimple, level + 1); mi->max_malloced_level = level + 1; } else if (mi->max_malloced_level <= level) { mi->malloc_for_level - = XRESIZEVEC (tree, mi->malloc_for_level, level + 1); + = XRESIZEVEC (gimple, mi->malloc_for_level, level + 1); /* Zero the newly allocated items. */ memset (&(mi->malloc_for_level[mi->max_malloced_level + 1]), @@ -769,79 +787,74 @@ add_allocation_site (struct matrix_info *mi, tree stmt, int level) Return if STMT is related to an allocation site. */ static void -analyze_matrix_allocation_site (struct matrix_info *mi, tree stmt, +analyze_matrix_allocation_site (struct matrix_info *mi, gimple stmt, int level, sbitmap visited) { - if (TREE_CODE (stmt) == GIMPLE_MODIFY_STMT) + if (gimple_assign_copy_p (stmt) || gimple_assign_cast_p (stmt)) { - tree rhs = TREE_OPERAND (stmt, 1); + tree rhs = gimple_assign_rhs1 (stmt); - rhs = get_inner_of_cast_expr (rhs); if (TREE_CODE (rhs) == SSA_NAME) { - tree def = SSA_NAME_DEF_STMT (rhs); + gimple def = SSA_NAME_DEF_STMT (rhs); analyze_matrix_allocation_site (mi, def, level, visited); return; } + /* If we are back to the original matrix variable then we + are sure that this is analyzed as an access site. */ + else if (rhs == mi->decl) + return; + } + /* A result of call to malloc. */ + else if (is_gimple_call (stmt)) + { + int call_flags = gimple_call_flags (stmt); - /* A result of call to malloc. */ - else if (TREE_CODE (rhs) == CALL_EXPR) + if (!(call_flags & ECF_MALLOC)) { - int call_flags = call_expr_flags (rhs); + mark_min_matrix_escape_level (mi, level, stmt); + return; + } + else + { + tree malloc_fn_decl; + const char *malloc_fname; - if (!(call_flags & ECF_MALLOC)) + malloc_fn_decl = gimple_call_fndecl (stmt); + if (malloc_fn_decl == NULL_TREE) { mark_min_matrix_escape_level (mi, level, stmt); return; } - else - { - tree malloc_fn_decl; - const char *malloc_fname; - - malloc_fn_decl = CALL_EXPR_FN (rhs); - if (TREE_CODE (malloc_fn_decl) != ADDR_EXPR - || TREE_CODE (TREE_OPERAND (malloc_fn_decl, 0)) != - FUNCTION_DECL) - { - mark_min_matrix_escape_level (mi, level, stmt); - return; - } - malloc_fn_decl = TREE_OPERAND (malloc_fn_decl, 0); - malloc_fname = IDENTIFIER_POINTER (DECL_NAME (malloc_fn_decl)); - if (DECL_FUNCTION_CODE (malloc_fn_decl) != BUILT_IN_MALLOC) - { - if (dump_file) - fprintf (dump_file, - "Matrix %s is an argument to function %s\n", - get_name (mi->decl), get_name (malloc_fn_decl)); - mark_min_matrix_escape_level (mi, level, stmt); - return; - } - } - /* This is a call to malloc of level 'level'. - mi->max_malloced_level-1 == level means that we've - seen a malloc statement of level 'level' before. - If the statement is not the same one that we've - seen before, then there's another malloc statement - for the same level, which means that we need to mark - it escaping. */ - if (mi->malloc_for_level - && mi->max_malloced_level-1 == level - && mi->malloc_for_level[level] != stmt) + malloc_fname = IDENTIFIER_POINTER (DECL_NAME (malloc_fn_decl)); + if (DECL_FUNCTION_CODE (malloc_fn_decl) != BUILT_IN_MALLOC) { + if (dump_file) + fprintf (dump_file, + "Matrix %s is an argument to function %s\n", + get_name (mi->decl), get_name (malloc_fn_decl)); mark_min_matrix_escape_level (mi, level, stmt); return; } - else - add_allocation_site (mi, stmt, level); + } + /* This is a call to malloc of level 'level'. + mi->max_malloced_level-1 == level means that we've + seen a malloc statement of level 'level' before. + If the statement is not the same one that we've + seen before, then there's another malloc statement + for the same level, which means that we need to mark + it escaping. */ + if (mi->malloc_for_level + && mi->max_malloced_level-1 == level + && mi->malloc_for_level[level] != stmt) + { + mark_min_matrix_escape_level (mi, level, stmt); return; } - /* If we are back to the original matrix variable then we - are sure that this is analyzed as an access site. */ - else if (rhs == mi->decl) - return; + else + add_allocation_site (mi, stmt, level); + return; } /* Looks like we don't know what is happening in this statement so be in the safe side and mark it as escaping. */ @@ -909,7 +922,7 @@ analyze_transpose (void **slot, void *data ATTRIBUTE_UNUSED) for (i = 0; VEC_iterate (access_site_info_p, mi->access_l, i, acc_info); i++) { - if (TREE_CODE (TREE_OPERAND (acc_info->stmt, 1)) == POINTER_PLUS_EXPR + if (gimple_assign_rhs_code (acc_info->stmt) == POINTER_PLUS_EXPR && acc_info->level < min_escape_l) { loop = loop_containing_stmt (acc_info->stmt); @@ -945,19 +958,21 @@ analyze_transpose (void **slot, void *data ATTRIBUTE_UNUSED) /* Find the index which defines the OFFSET from base. We walk from use to def until we find how the offset was defined. */ static tree -get_index_from_offset (tree offset, tree def_stmt) +get_index_from_offset (tree offset, gimple def_stmt) { - tree op1, op2, expr, index; + tree op1, op2, index; - if (TREE_CODE (def_stmt) == PHI_NODE) + if (gimple_code (def_stmt) == GIMPLE_PHI) return NULL; - expr = get_inner_of_cast_expr (TREE_OPERAND (def_stmt, 1)); - if (TREE_CODE (expr) == SSA_NAME) - return get_index_from_offset (offset, SSA_NAME_DEF_STMT (expr)); - else if (TREE_CODE (expr) == MULT_EXPR) + if ((gimple_assign_copy_p (def_stmt) || gimple_assign_cast_p (def_stmt)) + && TREE_CODE (gimple_assign_rhs1 (def_stmt)) == SSA_NAME) + return get_index_from_offset (offset, + SSA_NAME_DEF_STMT (gimple_assign_rhs1 (def_stmt))); + else if (is_gimple_assign (def_stmt) + && gimple_assign_rhs_code (def_stmt) == MULT_EXPR) { - op1 = TREE_OPERAND (expr, 0); - op2 = TREE_OPERAND (expr, 1); + op1 = gimple_assign_rhs1 (def_stmt); + op2 = gimple_assign_rhs2 (def_stmt); if (TREE_CODE (op1) != INTEGER_CST && TREE_CODE (op2) != INTEGER_CST) return NULL; index = (TREE_CODE (op1) == INTEGER_CST) ? op2 : op1; @@ -971,17 +986,17 @@ get_index_from_offset (tree offset, tree def_stmt) of the type related to the SSA_VAR, or the type related to the lhs of STMT, in the case that it is an INDIRECT_REF. */ static void -update_type_size (struct matrix_info *mi, tree stmt, tree ssa_var, +update_type_size (struct matrix_info *mi, gimple stmt, tree ssa_var, int current_indirect_level) { tree lhs; HOST_WIDE_INT type_size; /* Update type according to the type of the INDIRECT_REF expr. */ - if (TREE_CODE (stmt) == GIMPLE_MODIFY_STMT - && TREE_CODE (TREE_OPERAND (stmt, 0)) == INDIRECT_REF) + if (is_gimple_assign (stmt) + && TREE_CODE (gimple_assign_lhs (stmt)) == INDIRECT_REF) { - lhs = TREE_OPERAND (stmt, 0); + lhs = gimple_assign_lhs (stmt); gcc_assert (POINTER_TYPE_P (TREE_TYPE (SSA_NAME_VAR (TREE_OPERAND (lhs, 0))))); type_size = @@ -1026,24 +1041,66 @@ update_type_size (struct matrix_info *mi, tree stmt, tree ssa_var, } } -/* USE_STMT represents a call_expr ,where one of the arguments is the +/* USE_STMT represents a GIMPLE_CALL, where one of the arguments is the ssa var that we want to check because it came from some use of matrix MI. CURRENT_INDIRECT_LEVEL is the indirection level we reached so far. */ -static void -analyze_accesses_for_call_expr (struct matrix_info *mi, tree use_stmt, - int current_indirect_level) +static int +analyze_accesses_for_call_stmt (struct matrix_info *mi, tree ssa_var, + gimple use_stmt, int current_indirect_level) { - tree call = get_call_expr_in (use_stmt); - if (call && get_callee_fndecl (call)) + tree fndecl = gimple_call_fndecl (use_stmt); + + if (gimple_call_lhs (use_stmt)) { - if (DECL_FUNCTION_CODE (get_callee_fndecl (call)) != BUILT_IN_FREE) + tree lhs = gimple_call_lhs (use_stmt); + struct ssa_acc_in_tree lhs_acc, rhs_acc; + + memset (&lhs_acc, 0, sizeof (lhs_acc)); + memset (&rhs_acc, 0, sizeof (rhs_acc)); + + lhs_acc.ssa_var = ssa_var; + lhs_acc.t_code = ERROR_MARK; + ssa_accessed_in_tree (lhs, &lhs_acc); + rhs_acc.ssa_var = ssa_var; + rhs_acc.t_code = ERROR_MARK; + ssa_accessed_in_call_rhs (use_stmt, &rhs_acc); + + /* The SSA must be either in the left side or in the right side, + to understand what is happening. + In case the SSA_NAME is found in both sides we should be escaping + at this level because in this case we cannot calculate the + address correctly. */ + if ((lhs_acc.var_found && rhs_acc.var_found + && lhs_acc.t_code == INDIRECT_REF) + || (!rhs_acc.var_found && !lhs_acc.var_found)) + { + mark_min_matrix_escape_level (mi, current_indirect_level, use_stmt); + return current_indirect_level; + } + gcc_assert (!rhs_acc.var_found || !lhs_acc.var_found); + + /* If we are storing to the matrix at some level, then mark it as + escaping at that level. */ + if (lhs_acc.var_found) + { + int l = current_indirect_level + 1; + + gcc_assert (lhs_acc.t_code == INDIRECT_REF); + mark_min_matrix_escape_level (mi, l, use_stmt); + return current_indirect_level; + } + } + + if (fndecl) + { + if (DECL_FUNCTION_CODE (fndecl) != BUILT_IN_FREE) { if (dump_file) fprintf (dump_file, "Matrix %s: Function call %s, level %d escapes.\n", - get_name (mi->decl), get_name (get_callee_fndecl (call)), + get_name (mi->decl), get_name (fndecl), current_indirect_level); mark_min_matrix_escape_level (mi, current_indirect_level, use_stmt); } @@ -1060,6 +1117,7 @@ analyze_accesses_for_call_expr (struct matrix_info *mi, tree use_stmt, mi->free_stmts[l].func = current_function_decl; } } + return current_indirect_level; } /* USE_STMT represents a phi node of the ssa var that we want to @@ -1073,7 +1131,7 @@ analyze_accesses_for_call_expr (struct matrix_info *mi, tree use_stmt, CURRENT_INDIRECT_LEVEL is the indirection level we reached so far. */ static void -analyze_accesses_for_phi_node (struct matrix_info *mi, tree use_stmt, +analyze_accesses_for_phi_node (struct matrix_info *mi, gimple use_stmt, int current_indirect_level, sbitmap visited, bool record_accesses) { @@ -1090,18 +1148,18 @@ analyze_accesses_for_phi_node (struct matrix_info *mi, tree use_stmt, { int level = MIN (maphi->indirection_level, current_indirect_level); - int j; - tree t = NULL_TREE; + size_t j; + gimple stmt = NULL; maphi->indirection_level = level; - for (j = 0; j < PHI_NUM_ARGS (use_stmt); j++) + for (j = 0; j < gimple_phi_num_args (use_stmt); j++) { tree def = PHI_ARG_DEF (use_stmt, j); - if (TREE_CODE (SSA_NAME_DEF_STMT (def)) != PHI_NODE) - t = SSA_NAME_DEF_STMT (def); + if (gimple_code (SSA_NAME_DEF_STMT (def)) != GIMPLE_PHI) + stmt = SSA_NAME_DEF_STMT (def); } - mark_min_matrix_escape_level (mi, level, t); + mark_min_matrix_escape_level (mi, level, stmt); } return; } @@ -1126,20 +1184,17 @@ analyze_accesses_for_phi_node (struct matrix_info *mi, tree use_stmt, } } -/* USE_STMT represents a modify statement (the rhs or lhs include +/* USE_STMT represents an assign statement (the rhs or lhs include the ssa var that we want to check because it came from some use of matrix - MI. - CURRENT_INDIRECT_LEVEL is the indirection level we reached so far. */ + MI. CURRENT_INDIRECT_LEVEL is the indirection level we reached so far. */ static int -analyze_accesses_for_modify_stmt (struct matrix_info *mi, tree ssa_var, - tree use_stmt, int current_indirect_level, +analyze_accesses_for_assign_stmt (struct matrix_info *mi, tree ssa_var, + gimple use_stmt, int current_indirect_level, bool last_op, sbitmap visited, bool record_accesses) { - - tree lhs = TREE_OPERAND (use_stmt, 0); - tree rhs = TREE_OPERAND (use_stmt, 1); + tree lhs = gimple_get_lhs (use_stmt); struct ssa_acc_in_tree lhs_acc, rhs_acc; memset (&lhs_acc, 0, sizeof (lhs_acc)); @@ -1150,7 +1205,7 @@ analyze_accesses_for_modify_stmt (struct matrix_info *mi, tree ssa_var, ssa_accessed_in_tree (lhs, &lhs_acc); rhs_acc.ssa_var = ssa_var; rhs_acc.t_code = ERROR_MARK; - ssa_accessed_in_tree (get_inner_of_cast_expr (rhs), &rhs_acc); + ssa_accessed_in_assign_rhs (use_stmt, &rhs_acc); /* The SSA must be either in the left side or in the right side, to understand what is happening. @@ -1170,17 +1225,18 @@ analyze_accesses_for_modify_stmt (struct matrix_info *mi, tree ssa_var, escaping at that level. */ if (lhs_acc.var_found) { - tree def; int l = current_indirect_level + 1; gcc_assert (lhs_acc.t_code == INDIRECT_REF); - def = get_inner_of_cast_expr (rhs); - if (TREE_CODE (def) != SSA_NAME) + + if (!(gimple_assign_copy_p (use_stmt) + || gimple_assign_cast_p (use_stmt)) + || (TREE_CODE (gimple_assign_rhs1 (use_stmt)) != SSA_NAME)) mark_min_matrix_escape_level (mi, l, use_stmt); else { - def = SSA_NAME_DEF_STMT (def); - analyze_matrix_allocation_site (mi, def, l, visited); + gimple def_stmt = SSA_NAME_DEF_STMT (gimple_assign_rhs1 (use_stmt)); + analyze_matrix_allocation_site (mi, def_stmt, l, visited); if (record_accesses) record_access_alloc_site_info (mi, use_stmt, NULL_TREE, NULL_TREE, l, true); @@ -1192,17 +1248,6 @@ analyze_accesses_for_modify_stmt (struct matrix_info *mi, tree ssa_var, is used. */ if (rhs_acc.var_found) { - /* If we are passing the ssa name to a function call and - the pointer escapes when passed to the function - (not the case of free), then we mark the matrix as - escaping at this level. */ - if (rhs_acc.t_code == CALL_EXPR) - { - analyze_accesses_for_call_expr (mi, use_stmt, - current_indirect_level); - - return current_indirect_level; - } if (rhs_acc.t_code != INDIRECT_REF && rhs_acc.t_code != POINTER_PLUS_EXPR && rhs_acc.t_code != SSA_NAME) { @@ -1235,8 +1280,8 @@ analyze_accesses_for_modify_stmt (struct matrix_info *mi, tree ssa_var, tree index; tree op1, op2; - op1 = TREE_OPERAND (rhs, 0); - op2 = TREE_OPERAND (rhs, 1); + op1 = gimple_assign_rhs1 (use_stmt); + op2 = gimple_assign_rhs2 (use_stmt); op2 = (op1 == ssa_var) ? op2 : op1; if (TREE_CODE (op2) == INTEGER_CST) @@ -1331,8 +1376,8 @@ analyze_matrix_accesses (struct matrix_info *mi, tree ssa_var, FOR_EACH_IMM_USE_FAST (use_p, imm_iter, ssa_var) { - tree use_stmt = USE_STMT (use_p); - if (TREE_CODE (use_stmt) == PHI_NODE) + gimple use_stmt = USE_STMT (use_p); + if (gimple_code (use_stmt) == GIMPLE_PHI) /* We check all the escaping levels that get to the PHI node and make sure they are all the same escaping; if not (which is rare) we let the escaping level be the @@ -1342,16 +1387,22 @@ analyze_matrix_accesses (struct matrix_info *mi, tree ssa_var, analyze_accesses_for_phi_node (mi, use_stmt, current_indirect_level, visited, record_accesses); - else if (TREE_CODE (use_stmt) == CALL_EXPR) - analyze_accesses_for_call_expr (mi, use_stmt, current_indirect_level); - else if (TREE_CODE (use_stmt) == GIMPLE_MODIFY_STMT) + else if (is_gimple_call (use_stmt)) + analyze_accesses_for_call_stmt (mi, ssa_var, use_stmt, + current_indirect_level); + else if (is_gimple_assign (use_stmt)) current_indirect_level = - analyze_accesses_for_modify_stmt (mi, ssa_var, use_stmt, + analyze_accesses_for_assign_stmt (mi, ssa_var, use_stmt, current_indirect_level, last_op, visited, record_accesses); } } +typedef struct +{ + tree fn; + gimple stmt; +} check_var_data; /* A walk_tree function to go over the VAR_DECL, PARM_DECL nodes of the malloc size expression and check that those aren't changed @@ -1361,22 +1412,26 @@ check_var_notmodified_p (tree * tp, int *walk_subtrees, void *data) { basic_block bb; tree t = *tp; - tree fn = (tree) data; - block_stmt_iterator bsi; - tree stmt; + check_var_data *callback_data = (check_var_data*) data; + tree fn = callback_data->fn; + gimple_stmt_iterator gsi; + gimple stmt; if (TREE_CODE (t) != VAR_DECL && TREE_CODE (t) != PARM_DECL) return NULL_TREE; FOR_EACH_BB_FN (bb, DECL_STRUCT_FUNCTION (fn)) { - for (bsi = bsi_start (bb); !bsi_end_p (bsi); bsi_next (&bsi)) + for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) { - stmt = bsi_stmt (bsi); - if (TREE_CODE (stmt) != GIMPLE_MODIFY_STMT) + stmt = gsi_stmt (gsi); + if (!is_gimple_assign (stmt) && !is_gimple_call (stmt)) continue; - if (TREE_OPERAND (stmt, 0) == t) - return stmt; + if (gimple_get_lhs (stmt) == t) + { + callback_data->stmt = stmt; + return t; + } } } *walk_subtrees = 1; @@ -1384,58 +1439,63 @@ check_var_notmodified_p (tree * tp, int *walk_subtrees, void *data) } /* Go backwards in the use-def chains and find out the expression - represented by the possible SSA name in EXPR, until it is composed + represented by the possible SSA name in STMT, until it is composed of only VAR_DECL, PARM_DECL and INT_CST. In case of phi nodes we make sure that all the arguments represent the same subexpression, otherwise we fail. */ + static tree -can_calculate_expr_before_stmt (tree expr, sbitmap visited) +can_calculate_stmt_before_stmt (gimple stmt, sbitmap visited) { - tree def_stmt, op1, op2, res; + tree op1, op2, res; + enum tree_code code; - switch (TREE_CODE (expr)) + switch (gimple_code (stmt)) { - case SSA_NAME: - /* Case of loop, we don't know to represent this expression. */ - if (TEST_BIT (visited, SSA_NAME_VERSION (expr))) - return NULL_TREE; + case GIMPLE_ASSIGN: + code = gimple_assign_rhs_code (stmt); + op1 = gimple_assign_rhs1 (stmt); + + switch (code) + { + case POINTER_PLUS_EXPR: + case PLUS_EXPR: + case MINUS_EXPR: + case MULT_EXPR: + + op2 = gimple_assign_rhs2 (stmt); + op1 = can_calculate_expr_before_stmt (op1, visited); + if (!op1) + return NULL_TREE; + op2 = can_calculate_expr_before_stmt (op2, visited); + if (op2) + return fold_build2 (code, gimple_expr_type (stmt), op1, op2); + return NULL_TREE; + + CASE_CONVERT: + res = can_calculate_expr_before_stmt (op1, visited); + if (res != NULL_TREE) + return build1 (code, gimple_expr_type (stmt), res); + else + return NULL_TREE; - SET_BIT (visited, SSA_NAME_VERSION (expr)); - def_stmt = SSA_NAME_DEF_STMT (expr); - res = can_calculate_expr_before_stmt (def_stmt, visited); - RESET_BIT (visited, SSA_NAME_VERSION (expr)); - return res; - case VAR_DECL: - case PARM_DECL: - case INTEGER_CST: - return expr; - case POINTER_PLUS_EXPR: - case PLUS_EXPR: - case MINUS_EXPR: - case MULT_EXPR: - op1 = TREE_OPERAND (expr, 0); - op2 = TREE_OPERAND (expr, 1); + default: + if (gimple_assign_single_p (stmt)) + return can_calculate_expr_before_stmt (op1, visited); + else + return NULL_TREE; + } - op1 = can_calculate_expr_before_stmt (op1, visited); - if (!op1) - return NULL_TREE; - op2 = can_calculate_expr_before_stmt (op2, visited); - if (op2) - return fold_build2 (TREE_CODE (expr), TREE_TYPE (expr), op1, op2); - return NULL_TREE; - case GIMPLE_MODIFY_STMT: - return can_calculate_expr_before_stmt (TREE_OPERAND (expr, 1), - visited); - case PHI_NODE: + case GIMPLE_PHI: { - int j; + size_t j; res = NULL_TREE; /* Make sure all the arguments represent the same value. */ - for (j = 0; j < PHI_NUM_ARGS (expr); j++) + for (j = 0; j < gimple_phi_num_args (stmt); j++) { tree new_res; - tree def = PHI_ARG_DEF (expr, j); + tree def = PHI_ARG_DEF (stmt, j); new_res = can_calculate_expr_before_stmt (def, visited); if (res == NULL_TREE) @@ -1445,13 +1505,40 @@ can_calculate_expr_before_stmt (tree expr, sbitmap visited) } return res; } - CASE_CONVERT: - res = can_calculate_expr_before_stmt (TREE_OPERAND (expr, 0), visited); - if (res != NULL_TREE) - return build1 (TREE_CODE (expr), TREE_TYPE (expr), res); - else + + default: + return NULL_TREE; + } +} + +/* Go backwards in the use-def chains and find out the expression + represented by the possible SSA name in EXPR, until it is composed + of only VAR_DECL, PARM_DECL and INT_CST. In case of phi nodes + we make sure that all the arguments represent the same subexpression, + otherwise we fail. */ +static tree +can_calculate_expr_before_stmt (tree expr, sbitmap visited) +{ + gimple def_stmt; + tree res; + + switch (TREE_CODE (expr)) + { + case SSA_NAME: + /* Case of loop, we don't know to represent this expression. */ + if (TEST_BIT (visited, SSA_NAME_VERSION (expr))) return NULL_TREE; + SET_BIT (visited, SSA_NAME_VERSION (expr)); + def_stmt = SSA_NAME_DEF_STMT (expr); + res = can_calculate_stmt_before_stmt (def_stmt, visited); + RESET_BIT (visited, SSA_NAME_VERSION (expr)); + return res; + case VAR_DECL: + case PARM_DECL: + case INTEGER_CST: + return expr; + default: return NULL_TREE; } @@ -1483,7 +1570,7 @@ static int check_allocation_function (void **slot, void *data ATTRIBUTE_UNUSED) { int level; - block_stmt_iterator bsi; + gimple_stmt_iterator gsi; basic_block bb_level_0; struct matrix_info *mi = (struct matrix_info *) *slot; sbitmap visited; @@ -1504,16 +1591,17 @@ check_allocation_function (void **slot, void *data ATTRIBUTE_UNUSED) if (!mi->malloc_for_level[level]) break; - mark_min_matrix_escape_level (mi, level, NULL_TREE); + mark_min_matrix_escape_level (mi, level, NULL); - bsi = bsi_for_stmt (mi->malloc_for_level[0]); - bb_level_0 = bsi.bb; + gsi = gsi_for_stmt (mi->malloc_for_level[0]); + bb_level_0 = gsi.bb; /* Check if the expression of the size passed to malloc could be pre-calculated before the malloc of level 0. */ for (level = 1; level < mi->min_indirect_level_escape; level++) { - tree call_stmt, size; + gimple call_stmt; + tree size; struct malloc_call_data mcd; call_stmt = mi->malloc_for_level[level]; @@ -1574,8 +1662,8 @@ find_sites_in_func (bool record) { sbitmap visited_stmts_1; - block_stmt_iterator bsi; - tree stmt; + gimple_stmt_iterator gsi; + gimple stmt; basic_block bb; struct matrix_info tmpmi, *mi; @@ -1583,13 +1671,16 @@ find_sites_in_func (bool record) FOR_EACH_BB (bb) { - for (bsi = bsi_start (bb); !bsi_end_p (bsi); bsi_next (&bsi)) + for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) { - stmt = bsi_stmt (bsi); - if (TREE_CODE (stmt) == GIMPLE_MODIFY_STMT - && TREE_CODE (TREE_OPERAND (stmt, 0)) == VAR_DECL) + tree lhs; + + stmt = gsi_stmt (gsi); + lhs = gimple_get_lhs (stmt); + if (lhs != NULL_TREE + && TREE_CODE (lhs) == VAR_DECL) { - tmpmi.decl = TREE_OPERAND (stmt, 0); + tmpmi.decl = lhs; if ((mi = (struct matrix_info *) htab_find (matrices_to_reorg, &tmpmi))) { @@ -1597,17 +1688,17 @@ find_sites_in_func (bool record) analyze_matrix_allocation_site (mi, stmt, 0, visited_stmts_1); } } - if (TREE_CODE (stmt) == GIMPLE_MODIFY_STMT - && TREE_CODE (TREE_OPERAND (stmt, 0)) == SSA_NAME - && TREE_CODE (TREE_OPERAND (stmt, 1)) == VAR_DECL) + if (is_gimple_assign (stmt) + && gimple_assign_single_p (stmt) + && TREE_CODE (lhs) == SSA_NAME + && TREE_CODE (gimple_assign_rhs1 (stmt)) == VAR_DECL) { - tmpmi.decl = TREE_OPERAND (stmt, 1); + tmpmi.decl = gimple_assign_rhs1 (stmt); if ((mi = (struct matrix_info *) htab_find (matrices_to_reorg, &tmpmi))) { sbitmap_zero (visited_stmts_1); - analyze_matrix_accesses (mi, - TREE_OPERAND (stmt, 0), 0, + analyze_matrix_accesses (mi, lhs, 0, false, visited_stmts_1, record); } } @@ -1639,10 +1730,11 @@ record_all_accesses_in_func (void) tree rhs, lhs; if (!ssa_var - || TREE_CODE (SSA_NAME_DEF_STMT (ssa_var)) != GIMPLE_MODIFY_STMT) + || !is_gimple_assign (SSA_NAME_DEF_STMT (ssa_var)) + || !gimple_assign_single_p (SSA_NAME_DEF_STMT (ssa_var))) continue; - rhs = TREE_OPERAND (SSA_NAME_DEF_STMT (ssa_var), 1); - lhs = TREE_OPERAND (SSA_NAME_DEF_STMT (ssa_var), 0); + rhs = gimple_assign_rhs1 (SSA_NAME_DEF_STMT (ssa_var)); + lhs = gimple_assign_lhs (SSA_NAME_DEF_STMT (ssa_var)); if (TREE_CODE (rhs) != VAR_DECL && TREE_CODE (lhs) != VAR_DECL) continue; @@ -1718,10 +1810,11 @@ compute_offset (HOST_WIDE_INT orig, HOST_WIDE_INT new, tree result) static int transform_access_sites (void **slot, void *data ATTRIBUTE_UNUSED) { - block_stmt_iterator bsi; + gimple_stmt_iterator gsi; struct matrix_info *mi = (struct matrix_info *) *slot; int min_escape_l = mi->min_indirect_level_escape; struct access_site_info *acc_info; + enum tree_code code; int i; if (min_escape_l < 2 || !mi->access_l) @@ -1729,8 +1822,6 @@ transform_access_sites (void **slot, void *data ATTRIBUTE_UNUSED) for (i = 0; VEC_iterate (access_site_info_p, mi->access_l, i, acc_info); i++) { - tree orig, type; - /* This is possible because we collect the access sites before we determine the final minimum indirection level. */ if (acc_info->level >= min_escape_l) @@ -1744,69 +1835,61 @@ transform_access_sites (void **slot, void *data ATTRIBUTE_UNUSED) { ssa_op_iter iter; tree def; - tree stmt = acc_info->stmt; + gimple stmt = acc_info->stmt; + tree lhs; FOR_EACH_SSA_TREE_OPERAND (def, stmt, iter, SSA_OP_DEF) mark_sym_for_renaming (SSA_NAME_VAR (def)); - bsi = bsi_for_stmt (stmt); - gcc_assert (TREE_CODE (acc_info->stmt) == GIMPLE_MODIFY_STMT); - if (TREE_CODE (TREE_OPERAND (acc_info->stmt, 0)) == - SSA_NAME && acc_info->level < min_escape_l - 1) + gsi = gsi_for_stmt (stmt); + gcc_assert (is_gimple_assign (acc_info->stmt)); + lhs = gimple_assign_lhs (acc_info->stmt); + if (TREE_CODE (lhs) == SSA_NAME + && acc_info->level < min_escape_l - 1) { imm_use_iterator imm_iter; use_operand_p use_p; - tree use_stmt; + gimple use_stmt; - FOR_EACH_IMM_USE_STMT (use_stmt, imm_iter, - TREE_OPERAND (acc_info->stmt, - 0)) + FOR_EACH_IMM_USE_STMT (use_stmt, imm_iter, lhs) FOR_EACH_IMM_USE_ON_STMT (use_p, imm_iter) { - tree conv, tmp, stmts; + tree rhs, tmp; + gimple new_stmt; + gcc_assert (gimple_assign_rhs_code (acc_info->stmt) + == INDIRECT_REF); /* Emit convert statement to convert to type of use. */ - conv = - fold_build1 (CONVERT_EXPR, - TREE_TYPE (TREE_OPERAND - (acc_info->stmt, 0)), - TREE_OPERAND (TREE_OPERAND - (acc_info->stmt, 1), 0)); - tmp = - create_tmp_var (TREE_TYPE - (TREE_OPERAND - (acc_info->stmt, 0)), "new"); + tmp = create_tmp_var (TREE_TYPE (lhs), "new"); add_referenced_var (tmp); - stmts = - fold_build2 (GIMPLE_MODIFY_STMT, - TREE_TYPE (TREE_OPERAND - (acc_info->stmt, 0)), tmp, - conv); - tmp = make_ssa_name (tmp, stmts); - TREE_OPERAND (stmts, 0) = tmp; - bsi = bsi_for_stmt (acc_info->stmt); - bsi_insert_after (&bsi, stmts, BSI_SAME_STMT); + rhs = gimple_assign_rhs1 (acc_info->stmt); + new_stmt = gimple_build_assign (tmp, + TREE_OPERAND (rhs, 0)); + tmp = make_ssa_name (tmp, new_stmt); + gimple_assign_set_lhs (new_stmt, tmp); + gsi = gsi_for_stmt (acc_info->stmt); + gsi_insert_after (&gsi, new_stmt, GSI_SAME_STMT); SET_USE (use_p, tmp); } } if (acc_info->level < min_escape_l - 1) - bsi_remove (&bsi, true); + gsi_remove (&gsi, true); } free (acc_info); continue; } - orig = TREE_OPERAND (acc_info->stmt, 1); - type = TREE_TYPE (orig); - if (TREE_CODE (orig) == INDIRECT_REF + code = gimple_assign_rhs_code (acc_info->stmt); + if (code == INDIRECT_REF && acc_info->level < min_escape_l - 1) { /* Replace the INDIRECT_REF with NOP (cast) usually we are casting from "pointer to type" to "type". */ - orig = - build1 (NOP_EXPR, TREE_TYPE (orig), - TREE_OPERAND (orig, 0)); - TREE_OPERAND (acc_info->stmt, 1) = orig; + tree t = + build1 (NOP_EXPR, TREE_TYPE (gimple_assign_rhs1 (acc_info->stmt)), + TREE_OPERAND (gimple_assign_rhs1 (acc_info->stmt), 0)); + gimple_assign_set_rhs_code (acc_info->stmt, NOP_EXPR); + gimple_assign_set_rhs1 (acc_info->stmt, t); } - else if (TREE_CODE (orig) == POINTER_PLUS_EXPR + else if (code == POINTER_PLUS_EXPR && acc_info->level < (min_escape_l)) { imm_use_iterator imm_iter; @@ -1840,10 +1923,10 @@ transform_access_sites (void **slot, void *data ATTRIBUTE_UNUSED) total_elements = new_offset; if (new_offset != offset) { - bsi = bsi_for_stmt (acc_info->stmt); - tmp1 = force_gimple_operand_bsi (&bsi, total_elements, + gsi = gsi_for_stmt (acc_info->stmt); + tmp1 = force_gimple_operand_gsi (&gsi, total_elements, true, NULL, - true, BSI_SAME_STMT); + true, GSI_SAME_STMT); } else tmp1 = offset; @@ -1856,16 +1939,16 @@ transform_access_sites (void **slot, void *data ATTRIBUTE_UNUSED) fold_build2 (MULT_EXPR, sizetype, fold_convert (sizetype, acc_info->index), fold_convert (sizetype, d_size)); add_referenced_var (d_size); - bsi = bsi_for_stmt (acc_info->stmt); - tmp1 = force_gimple_operand_bsi (&bsi, num_elements, true, - NULL, true, BSI_SAME_STMT); + gsi = gsi_for_stmt (acc_info->stmt); + tmp1 = force_gimple_operand_gsi (&gsi, num_elements, true, + NULL, true, GSI_SAME_STMT); } /* Replace the offset if needed. */ if (tmp1 != offset) { if (TREE_CODE (offset) == SSA_NAME) { - tree use_stmt; + gimple use_stmt; FOR_EACH_IMM_USE_STMT (use_stmt, imm_iter, offset) FOR_EACH_IMM_USE_ON_STMT (use_p, imm_iter) @@ -1875,7 +1958,7 @@ transform_access_sites (void **slot, void *data ATTRIBUTE_UNUSED) else { gcc_assert (TREE_CODE (offset) == INTEGER_CST); - TREE_OPERAND (orig, 1) = tmp1; + gimple_assign_set_rhs2 (acc_info->stmt, tmp1); } } } @@ -1934,10 +2017,11 @@ transform_allocation_sites (void **slot, void *data ATTRIBUTE_UNUSED) { int i; struct matrix_info *mi; - tree type, call_stmt_0, malloc_stmt, oldfn, prev_dim_size, use_stmt; + tree type, oldfn, prev_dim_size; + gimple call_stmt_0, use_stmt; struct cgraph_node *c_node; struct cgraph_edge *e; - block_stmt_iterator bsi; + gimple_stmt_iterator gsi; struct malloc_call_data mcd; HOST_WIDE_INT element_size; @@ -2020,17 +2104,20 @@ transform_allocation_sites (void **slot, void *data ATTRIBUTE_UNUSED) for (i = 1; i < mi->min_indirect_level_escape; i++) { tree t; + check_var_data data; /* mi->dimension_size must contain the expression of the size calculated in check_allocation_function. */ gcc_assert (mi->dimension_size[i]); + data.fn = mi->allocation_function_decl; + data.stmt = NULL; t = walk_tree_without_duplicates (&(mi->dimension_size[i]), check_var_notmodified_p, - mi->allocation_function_decl); + &data); if (t != NULL_TREE) { - mark_min_matrix_escape_level (mi, i, t); + mark_min_matrix_escape_level (mi, i, data.stmt); break; } } @@ -2040,7 +2127,7 @@ transform_allocation_sites (void **slot, void *data ATTRIBUTE_UNUSED) /* Since we should make sure that the size expression is available before the call to malloc of level 0. */ - bsi = bsi_for_stmt (call_stmt_0); + gsi = gsi_for_stmt (call_stmt_0); /* Find out the size of each dimension by looking at the malloc sites and create a global variable to hold it. @@ -2059,7 +2146,8 @@ transform_allocation_sites (void **slot, void *data ATTRIBUTE_UNUSED) for (i = mi->min_indirect_level_escape - 1; i >= 0; i--) { - tree dim_size, dim_var, tmp; + tree dim_size, dim_var; + gimple stmt; tree d_type_size; /* Now put the size expression in a global variable and initialize it to @@ -2090,24 +2178,22 @@ transform_allocation_sites (void **slot, void *data ATTRIBUTE_UNUSED) dim_size = fold_build2 (MULT_EXPR, type, dim_size, prev_dim_size); } - dim_size = force_gimple_operand_bsi (&bsi, dim_size, true, NULL, - true, BSI_SAME_STMT); + dim_size = force_gimple_operand_gsi (&gsi, dim_size, true, NULL, + true, GSI_SAME_STMT); /* GLOBAL_HOLDING_THE_SIZE = DIM_SIZE. */ - tmp = fold_build2 (GIMPLE_MODIFY_STMT, type, dim_var, dim_size); - TREE_OPERAND (tmp, 0) = dim_var; - mark_symbols_for_renaming (tmp); - bsi_insert_before (&bsi, tmp, BSI_SAME_STMT); + stmt = gimple_build_assign (dim_var, dim_size); + mark_symbols_for_renaming (stmt); + gsi_insert_before (&gsi, stmt, GSI_SAME_STMT); prev_dim_size = mi->dimension_size[i] = dim_var; } update_ssa (TODO_update_ssa); /* Replace the malloc size argument in the malloc of level 0 to be the size of all the dimensions. */ - malloc_stmt = TREE_OPERAND (call_stmt_0, 1); c_node = cgraph_node (mi->allocation_function_decl); - old_size_0 = CALL_EXPR_ARG (malloc_stmt, 0); - tmp = force_gimple_operand_bsi (&bsi, mi->dimension_size[0], true, - NULL, true, BSI_SAME_STMT); + old_size_0 = gimple_call_arg (call_stmt_0, 0); + tmp = force_gimple_operand_gsi (&gsi, mi->dimension_size[0], true, + NULL, true, GSI_SAME_STMT); if (TREE_CODE (old_size_0) == SSA_NAME) { FOR_EACH_IMM_USE_STMT (use_stmt, imm_iter, old_size_0) @@ -2122,33 +2208,31 @@ transform_allocation_sites (void **slot, void *data ATTRIBUTE_UNUSED) check this outside of "cgraph.c". */ for (i = 1; i < mi->min_indirect_level_escape; i++) { - block_stmt_iterator bsi; - tree use_stmt1 = NULL; - tree call; + gimple_stmt_iterator gsi; + gimple use_stmt1 = NULL; - tree call_stmt = mi->malloc_for_level[i]; - call = TREE_OPERAND (call_stmt, 1); - gcc_assert (TREE_CODE (call) == CALL_EXPR); + gimple call_stmt = mi->malloc_for_level[i]; + gcc_assert (is_gimple_call (call_stmt)); e = cgraph_edge (c_node, call_stmt); gcc_assert (e); cgraph_remove_edge (e); - bsi = bsi_for_stmt (call_stmt); + gsi = gsi_for_stmt (call_stmt); /* Remove the call stmt. */ - bsi_remove (&bsi, true); + gsi_remove (&gsi, true); /* remove the type cast stmt. */ FOR_EACH_IMM_USE_STMT (use_stmt, imm_iter, - TREE_OPERAND (call_stmt, 0)) + gimple_call_lhs (call_stmt)) { use_stmt1 = use_stmt; - bsi = bsi_for_stmt (use_stmt); - bsi_remove (&bsi, true); + gsi = gsi_for_stmt (use_stmt); + gsi_remove (&gsi, true); } /* Remove the assignment of the allocated area. */ FOR_EACH_IMM_USE_STMT (use_stmt, imm_iter, - TREE_OPERAND (use_stmt1, 0)) + gimple_get_lhs (use_stmt1)) { - bsi = bsi_for_stmt (use_stmt); - bsi_remove (&bsi, true); + gsi = gsi_for_stmt (use_stmt); + gsi_remove (&gsi, true); } } update_ssa (TODO_update_ssa); @@ -2158,24 +2242,21 @@ transform_allocation_sites (void **slot, void *data ATTRIBUTE_UNUSED) /* Delete the calls to free. */ for (i = 1; i < mi->min_indirect_level_escape; i++) { - block_stmt_iterator bsi; - tree call; + gimple_stmt_iterator gsi; /* ??? wonder why this case is possible but we failed on it once. */ if (!mi->free_stmts[i].stmt) continue; - call = TREE_OPERAND (mi->free_stmts[i].stmt, 1); c_node = cgraph_node (mi->free_stmts[i].func); - - gcc_assert (TREE_CODE (mi->free_stmts[i].stmt) == CALL_EXPR); + gcc_assert (is_gimple_call (mi->free_stmts[i].stmt)); e = cgraph_edge (c_node, mi->free_stmts[i].stmt); gcc_assert (e); cgraph_remove_edge (e); current_function_decl = mi->free_stmts[i].func; set_cfun (DECL_STRUCT_FUNCTION (mi->free_stmts[i].func)); - bsi = bsi_for_stmt (mi->free_stmts[i].stmt); - bsi_remove (&bsi, true); + gsi = gsi_for_stmt (mi->free_stmts[i].stmt); + gsi_remove (&gsi, true); } /* Return to the previous situation. */ current_function_decl = oldfn; @@ -2203,13 +2284,11 @@ dump_matrix_reorg_analysis (void **slot, void *data ATTRIBUTE_UNUSED) return 1; } -#endif /* Perform matrix flattening. */ static unsigned int matrix_reorg (void) { -#if 0 /* FIXME tuples */ struct cgraph_node *node; if (profile_info) @@ -2316,9 +2395,6 @@ matrix_reorg (void) set_cfun (NULL); matrices_to_reorg = NULL; return 0; -#else - gcc_unreachable (); -#endif } @@ -2326,12 +2402,7 @@ matrix_reorg (void) static bool gate_matrix_reorg (void) { - /* FIXME tuples */ -#if 0 return flag_ipa_matrix_reorg && flag_whole_program; -#else - return false; -#endif } struct simple_ipa_opt_pass pass_ipa_matrix_reorg = diff --git a/gcc/optabs.c b/gcc/optabs.c index ee5bec11a41..158e75999d8 100644 --- a/gcc/optabs.c +++ b/gcc/optabs.c @@ -1786,7 +1786,7 @@ expand_binop (enum machine_mode mode, optab binoptab, rtx op0, rtx op1, if ((binoptab == lshr_optab || binoptab == ashl_optab || binoptab == ashr_optab) && mclass == MODE_INT - && (GET_CODE (op1) == CONST_INT || !optimize_size) + && (GET_CODE (op1) == CONST_INT || optimize_insn_for_speed_p ()) && GET_MODE_SIZE (mode) == 2 * UNITS_PER_WORD && optab_handler (binoptab, word_mode)->insn_code != CODE_FOR_nothing && optab_handler (ashl_optab, word_mode)->insn_code != CODE_FOR_nothing diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6f9210d8336..8c0f18eb123 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,79 @@ +2008-08-04 Arnaud Charlet <charlet@adacore.com> + + * gnat.dg/bip_aggregate_bug.adb: New test. + * gnat.dg/test_ai254.adb: New test. + +2008-08-03 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + * gfortran.dg/fmt_t_7.f: Replace CR-LF with LF. + +2008-08-03 Uros Bizjak <ubizjak@gmail.com> + + PR target/36992 + * gcc.target/i386/pr36992-1.c: New test. + * gcc.target/i386/pr36992-2.c: Ditto. + +2008-08-02 Richard Guenther <rguenther@suse.de> + + PR target/35252 + * lib/target-supports.exp (vect_extract_even_odd_wide) Add. + (vect_strided_wide): Likewise. + * gcc.dg/vect/fast-math-pr35982.c: Enable for + vect_extract_even_odd_wide. + * gcc.dg/vect/fast-math-vect-complex-3.c: Likewise. + * gcc.dg/vect/vect-1.c: Likewise. + * gcc.dg/vect/vect-107.c: Likewise. + * gcc.dg/vect/vect-98.c: Likewise. + * gcc.dg/vect/vect-strided-float.c: Likewise. + * gcc.dg/vect/slp-11.c: Enable for vect_strided_wide. + * gcc.dg/vect/slp-12a.c: Likewise. + * gcc.dg/vect/slp-12b.c: Likewise. + * gcc.dg/vect/slp-19.c: Likewise. + * gcc.dg/vect/slp-23.c: Likewise. + * gcc.dg/vect/slp-5.c: Likewise. + +2008-08-02 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/boolean_expr2.adb: New test. + +2008-08-01 Arnaud Charlet <charlet@adacore.com> + + * gnat.dg/conv4.adb: New test. + * gnat.dg/overloading.adb: New test. + +2008-08-01 Jakub Jelinek <jakub@redhat.com> + + PR tree-optimization/36991 + * gcc.dg/pr36991.c: New test. + +2008-08-01 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/boolean_expr.ad[sb]: Rename to boolean_expr1.ad[sb]. + +2008-08-01 Richard Guenther <rguenther@suse.de> + + PR middle-end/36997 + * gcc.dg/pr36997.c: New testcase. + +2008-08-01 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/deferred_const1.adb: New test. + * gnat.dg/deferred_const2.adb: Likewise. + * gnat.dg/deferred_const2_pkg.ad[sb]: New helper. + * gnat.dg/deferred_const3.adb: New test. + * gnat.dg/deferred_const3_pkg.ad[sb]: New helper. + +2008-08-01 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/36988 + * gcc.c-torture/compile/pr36988.c: New testcase. + +2008-08-01 Olivier Hainque <hainque@adacore.com> + + * gnat.dg/raise_from_pure.ad[bs], + * gnat.dg/wrap_raise_from_pure.ad[bs]: Support for ... + * gnat.dg/test_raise_from_pure.adb: New test. + 2008-07-31 Adam Nemet <anemet@caviumnetworks.com> * gcc.target/mips/ext-1.c: New test. @@ -402,16 +478,16 @@ 2008-07-21 Paolo Carlini <paolo.carlini@oracle.com> - PR c++/36871 + PR c++/36871 PR c++/36872 - * g++.dg/ext/has_nothrow_copy.C: Rename to... - * g++.dg/ext/has_nothrow_copy-1.C: ... this. - * g++.dg/ext/has_nothrow_copy-2.C: New. - * g++.dg/ext/has_nothrow_copy-3.C: Likewise. - * g++.dg/ext/has_nothrow_copy-4.C: Likewise. - * g++.dg/ext/has_nothrow_copy-5.C: Likewise. - * g++.dg/ext/has_nothrow_copy-6.C: Likewise. - * g++.dg/ext/has_nothrow_copy-7.C: Likewise. + * g++.dg/ext/has_nothrow_copy.C: Rename to... + * g++.dg/ext/has_nothrow_copy-1.C: ... this. + * g++.dg/ext/has_nothrow_copy-2.C: New. + * g++.dg/ext/has_nothrow_copy-3.C: Likewise. + * g++.dg/ext/has_nothrow_copy-4.C: Likewise. + * g++.dg/ext/has_nothrow_copy-5.C: Likewise. + * g++.dg/ext/has_nothrow_copy-6.C: Likewise. + * g++.dg/ext/has_nothrow_copy-7.C: Likewise. 2008-07-21 Thomas Koenig <tkoenig@gcc.gnu.org> diff --git a/gcc/testsuite/gcc.c-torture/compile/pr36988.c b/gcc/testsuite/gcc.c-torture/compile/pr36988.c new file mode 100644 index 00000000000..44118d5dda3 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/pr36988.c @@ -0,0 +1,11 @@ +typedef struct { + unsigned char mbxCommand; +} MAILBOX_t; +void lpfc_sli_brdrestart(void) +{ + volatile unsigned int word0; + MAILBOX_t *mb; + mb = (MAILBOX_t *) &word0; + mb->mbxCommand = 0x1A; + __writel((*(unsigned int *) mb)); +} diff --git a/gcc/testsuite/gcc.dg/pr36991.c b/gcc/testsuite/gcc.dg/pr36991.c new file mode 100644 index 00000000000..d090ba105c7 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr36991.c @@ -0,0 +1,12 @@ +/* PR tree-optimization/36991 */ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ + +typedef float V __attribute__ ((vector_size (16))); +typedef union { V v[4][4]; } U; + +void +foo (float x, float y, U *z) +{ + z->v[1][0] = z->v[0][1] = (V) { x, y, 0, 0 }; +} diff --git a/gcc/testsuite/gcc.dg/pr36997.c b/gcc/testsuite/gcc.dg/pr36997.c new file mode 100644 index 00000000000..34ee54a6827 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr36997.c @@ -0,0 +1,8 @@ +/* { dg-do compile { target x86_64-*-* i?86-*-* } } */ +/* { dg-options "-std=c99" } */ + +typedef int __m64 __attribute__ ((__vector_size__ (8), __may_alias__)); +__m64 _mm_add_si64 (__m64 __m1, __m64 __m2) +{ + return (__m64) __builtin_ia32_paddq ((long long)__m1, (long long)__m2); /* { dg-error "incompatible type" } */ +} diff --git a/gcc/testsuite/gcc.dg/vect/fast-math-pr35982.c b/gcc/testsuite/gcc.dg/vect/fast-math-pr35982.c index d21c61dd934..2c788606771 100644 --- a/gcc/testsuite/gcc.dg/vect/fast-math-pr35982.c +++ b/gcc/testsuite/gcc.dg/vect/fast-math-pr35982.c @@ -19,7 +19,7 @@ float method2_int16 (struct mem *mem) return avg; } -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target vect_extract_even_odd } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" { xfail vect_extract_even_odd } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target vect_extract_even_odd_wide } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" { xfail vect_extract_even_odd_wide } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/fast-math-vect-complex-3.c b/gcc/testsuite/gcc.dg/vect/fast-math-vect-complex-3.c index 1dff116dd5a..6110a231987 100644 --- a/gcc/testsuite/gcc.dg/vect/fast-math-vect-complex-3.c +++ b/gcc/testsuite/gcc.dg/vect/fast-math-vect-complex-3.c @@ -57,5 +57,5 @@ main (void) return 0; } -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { vect_interleave && vect_extract_even_odd } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { vect_interleave && vect_extract_even_odd_wide } } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/slp-11.c b/gcc/testsuite/gcc.dg/vect/slp-11.c index 118818c97bd..d606438fd20 100644 --- a/gcc/testsuite/gcc.dg/vect/slp-11.c +++ b/gcc/testsuite/gcc.dg/vect/slp-11.c @@ -106,8 +106,8 @@ int main (void) return 0; } -/* { dg-final { scan-tree-dump-times "vectorized 3 loops" 1 "vect" { target { vect_strided && vect_int_mult } } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" {target { ! { vect_int_mult && vect_strided } } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 3 loops" 1 "vect" { target { vect_strided_wide && vect_int_mult } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" {target { ! { vect_int_mult && vect_strided_wide } } } } } */ /* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 0 "vect" } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/slp-12a.c b/gcc/testsuite/gcc.dg/vect/slp-12a.c index 066bf7ff9a3..5cf404100ba 100644 --- a/gcc/testsuite/gcc.dg/vect/slp-12a.c +++ b/gcc/testsuite/gcc.dg/vect/slp-12a.c @@ -95,11 +95,11 @@ int main (void) return 0; } -/* { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect" {target { vect_strided && vect_int_mult} } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" {target { {! {vect_strided}} && vect_int_mult } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect" {target { vect_strided_wide && vect_int_mult} } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" {target { {! {vect_strided_wide}} && vect_int_mult } } } } */ /* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" {target { ! vect_int_mult } } } } */ -/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 2 "vect" {target { vect_strided && vect_int_mult } } } } */ -/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 1 "vect" {target { {! {vect_strided}} && vect_int_mult } } } } */ +/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 2 "vect" {target { vect_strided_wide && vect_int_mult } } } } */ +/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 1 "vect" {target { {! {vect_strided_wide}} && vect_int_mult } } } } */ /* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 0 "vect" {target { ! vect_int_mult } } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/slp-12b.c b/gcc/testsuite/gcc.dg/vect/slp-12b.c index 39570016f38..7b65dfcfe35 100644 --- a/gcc/testsuite/gcc.dg/vect/slp-12b.c +++ b/gcc/testsuite/gcc.dg/vect/slp-12b.c @@ -43,9 +43,9 @@ int main (void) return 0; } -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" {target { vect_strided && vect_int_mult } } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" {target { { ! { vect_int_mult }} || { ! {vect_strided}}} } } } */ -/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 1 "vect" {target { vect_strided && vect_int_mult } } } } */ -/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 0 "vect" {target { { ! { vect_int_mult }} || { ! {vect_strided}}} } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" {target { vect_strided_wide && vect_int_mult } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" {target { { ! { vect_int_mult }} || { ! {vect_strided_wide}}} } } } */ +/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 1 "vect" {target { vect_strided_wide && vect_int_mult } } } } */ +/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 0 "vect" {target { { ! { vect_int_mult }} || { ! {vect_strided_wide}}} } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/slp-19.c b/gcc/testsuite/gcc.dg/vect/slp-19.c index d9a68cd69d4..1133df4f4e6 100644 --- a/gcc/testsuite/gcc.dg/vect/slp-19.c +++ b/gcc/testsuite/gcc.dg/vect/slp-19.c @@ -147,9 +147,9 @@ int main (void) return 0; } -/* { dg-final { scan-tree-dump-times "vectorized 3 loops" 1 "vect" { target vect_strided } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { ! { vect_strided } } } } } */ -/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 3 "vect" { target vect_strided } } } */ -/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 1 "vect" { target { ! { vect_strided } } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 3 loops" 1 "vect" { target vect_strided_wide } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { ! { vect_strided_wide } } } } } */ +/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 3 "vect" { target vect_strided_wide } } } */ +/* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 1 "vect" { target { ! { vect_strided_wide } } } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/slp-23.c b/gcc/testsuite/gcc.dg/vect/slp-23.c index 2bba580271d..27ec12587f4 100644 --- a/gcc/testsuite/gcc.dg/vect/slp-23.c +++ b/gcc/testsuite/gcc.dg/vect/slp-23.c @@ -106,8 +106,8 @@ int main (void) return 0; } -/* { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect" { target { vect_strided } && {! { vect_no_align} } } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { ! { vect_strided || vect_no_align} } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect" { target { vect_strided_wide } && {! { vect_no_align} } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { ! { vect_strided_wide || vect_no_align} } } } } */ /* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 1 "vect" { xfail vect_no_align } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/slp-5.c b/gcc/testsuite/gcc.dg/vect/slp-5.c index 0f9c2eefb21..57e9e5df55f 100644 --- a/gcc/testsuite/gcc.dg/vect/slp-5.c +++ b/gcc/testsuite/gcc.dg/vect/slp-5.c @@ -121,8 +121,8 @@ int main (void) return 0; } -/* { dg-final { scan-tree-dump-times "vectorized 3 loops" 1 "vect" { target { vect_strided } } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect" { target { ! { vect_strided } } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 3 loops" 1 "vect" { target { vect_strided_wide } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect" { target { ! { vect_strided_wide } } } } } */ /* { dg-final { scan-tree-dump-times "vectorizing stmts using SLP" 2 "vect" } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-1.c b/gcc/testsuite/gcc.dg/vect/vect-1.c index 1ec195c5352..7a570541c73 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-1.c +++ b/gcc/testsuite/gcc.dg/vect/vect-1.c @@ -86,6 +86,6 @@ foo (int n) fbar (a); } -/* { dg-final { scan-tree-dump-times "vectorized 4 loops" 1 "vect" { target vect_extract_even_odd } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 3 loops" 1 "vect" { xfail vect_extract_even_odd } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 4 loops" 1 "vect" { target vect_extract_even_odd_wide } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 3 loops" 1 "vect" { xfail vect_extract_even_odd_wide } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-107.c b/gcc/testsuite/gcc.dg/vect/vect-107.c index 8c6a6950848..514fc362068 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-107.c +++ b/gcc/testsuite/gcc.dg/vect/vect-107.c @@ -39,6 +39,6 @@ int main (void) return main1 (); } -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target vect_extract_even_odd } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" { xfail vect_extract_even_odd } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target vect_extract_even_odd_wide } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" { xfail vect_extract_even_odd_wide } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-98.c b/gcc/testsuite/gcc.dg/vect/vect-98.c index 0987ec885dc..118f28fd334 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-98.c +++ b/gcc/testsuite/gcc.dg/vect/vect-98.c @@ -38,6 +38,6 @@ int main (void) } /* Needs interleaving support. */ -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { vect_interleave && vect_extract_even_odd } } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 0 "vect" { xfail { vect_interleave && vect_extract_even_odd } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { vect_interleave && vect_extract_even_odd_wide } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 0 "vect" { xfail { vect_interleave && vect_extract_even_odd_wide } } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-strided-float.c b/gcc/testsuite/gcc.dg/vect/vect-strided-float.c index 690cf94a47a..2417f2acd39 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-strided-float.c +++ b/gcc/testsuite/gcc.dg/vect/vect-strided-float.c @@ -38,7 +38,7 @@ int main (void) } /* Needs interleaving support. */ -/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { vect_interleave && vect_extract_even_odd } } } } */ -/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" { xfail { vect_interleave && vect_extract_even_odd } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { vect_interleave && vect_extract_even_odd_wide } } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" { xfail { vect_interleave && vect_extract_even_odd_wide } } } } */ /* { dg-final { cleanup-tree-dump "vect" } } */ diff --git a/gcc/testsuite/gcc.target/i386/pr36992-1.c b/gcc/testsuite/gcc.target/i386/pr36992-1.c new file mode 100644 index 00000000000..aad6f7cd14d --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr36992-1.c @@ -0,0 +1,12 @@ +/* { dg-do compile } +/* { dg-options "-O2 -msse2" } */ + +#include <emmintrin.h> + +__m128i +test (__m128i b) +{ + return _mm_move_epi64 (b); +} + +/* { dg-final { scan-assembler-times "mov\[qd\]\[ \\t\]+.*%xmm" 1 } } */ diff --git a/gcc/testsuite/gcc.target/i386/pr36992-2.c b/gcc/testsuite/gcc.target/i386/pr36992-2.c new file mode 100644 index 00000000000..eb9c3a28fee --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr36992-2.c @@ -0,0 +1,12 @@ +/* { dg-do compile } +/* { dg-options "-O0 -msse2" } */ + +#include <emmintrin.h> + +__m128i +test (__m128i b) +{ + return _mm_move_epi64 (b); +} + +/* { dg-final { scan-assembler-not "%mm" } } */ diff --git a/gcc/testsuite/gnat.dg/bip_aggregate_bug.adb b/gcc/testsuite/gnat.dg/bip_aggregate_bug.adb new file mode 100644 index 00000000000..ce8daeb5e16 --- /dev/null +++ b/gcc/testsuite/gnat.dg/bip_aggregate_bug.adb @@ -0,0 +1,49 @@ +-- { dg-do run } + +procedure BIP_Aggregate_Bug is + + package Limited_Types is + + type Lim_Tagged is tagged limited record + Root_Comp : Integer; + end record; + + type Lim_Ext is new Lim_Tagged with record + Ext_Comp : Integer; + end record; + + function Func_Lim_Tagged (Choice : Integer) return Lim_Tagged'Class; + + end Limited_Types; + + package body Limited_Types is + + function Func_Lim_Tagged (Choice : Integer) return Lim_Tagged'Class is + begin + case Choice is + when 111 => + return Lim_Ext'(Root_Comp => Choice, Ext_Comp => Choice); + when 222 => + return Result : Lim_Tagged'Class + := Lim_Ext'(Root_Comp => Choice, Ext_Comp => Choice); + when others => + return Lim_Tagged'(Root_Comp => Choice); + end case; + end Func_Lim_Tagged; + + end Limited_Types; + + use Limited_Types; + + LT_Root : Lim_Tagged'Class := Func_Lim_Tagged (Choice => 999); + LT_Ext1 : Lim_Tagged'Class := Func_Lim_Tagged (Choice => 111); + LT_Ext2 : Lim_Tagged'Class := Func_Lim_Tagged (Choice => 222); + +begin + if LT_Root.Root_Comp /= 999 + or else Lim_Ext (LT_Ext1).Ext_Comp /= 111 + or else Lim_Ext (LT_Ext2).Ext_Comp /= 222 + then + raise Program_Error; + end if; +end BIP_Aggregate_Bug; diff --git a/gcc/testsuite/gnat.dg/boolean_expr.adb b/gcc/testsuite/gnat.dg/boolean_expr1.adb index 6ac086dfe6d..ddfe32bfb64 100644 --- a/gcc/testsuite/gnat.dg/boolean_expr.adb +++ b/gcc/testsuite/gnat.dg/boolean_expr1.adb @@ -4,7 +4,7 @@ -- { dg-do compile } -- { dg-options "-O2" } -package body Boolean_Expr is +package body Boolean_Expr1 is function Long_Float_Is_Valid (X : in Long_Float) return Boolean is Is_Nan : constant Boolean := X /= X; @@ -27,4 +27,4 @@ package body Boolean_Expr is return "ERROR"; end S; -end Boolean_Expr; +end Boolean_Expr1; diff --git a/gcc/testsuite/gnat.dg/boolean_expr.ads b/gcc/testsuite/gnat.dg/boolean_expr1.ads index 8190ce77bd5..526551135f5 100644 --- a/gcc/testsuite/gnat.dg/boolean_expr.ads +++ b/gcc/testsuite/gnat.dg/boolean_expr1.ads @@ -1,5 +1,5 @@ -package Boolean_Expr is +package Boolean_Expr1 is function S (V : in Long_Float) return String; -end Boolean_Expr; +end Boolean_Expr1; diff --git a/gcc/testsuite/gnat.dg/boolean_expr2.adb b/gcc/testsuite/gnat.dg/boolean_expr2.adb new file mode 100644 index 00000000000..8bdcb84e933 --- /dev/null +++ b/gcc/testsuite/gnat.dg/boolean_expr2.adb @@ -0,0 +1,18 @@ +-- { dg-do run } + +procedure Boolean_Expr2 is + + function Ident_Bool (B : Boolean) return Boolean is + begin + return B; + end; + +begin + if Boolean'Succ (Ident_Bool(False)) /= True then + raise Program_Error; + end if; + + if Boolean'Pred (Ident_Bool(True)) /= False then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/deferred_const1.adb b/gcc/testsuite/gnat.dg/deferred_const1.adb new file mode 100644 index 00000000000..79b9f4a0325 --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const1.adb @@ -0,0 +1,12 @@ +-- { dg-do compile } + +with Text_IO; use Text_IO; + +procedure Deferred_Const1 is + I : Integer := 16#20_3A_2D_28#; + S : constant string(1..4); + for S'address use I'address; -- { dg-warning "constant overlays a variable" } + pragma Import (Ada, S); +begin + Put_Line (S); +end; diff --git a/gcc/testsuite/gnat.dg/deferred_const2.adb b/gcc/testsuite/gnat.dg/deferred_const2.adb new file mode 100644 index 00000000000..ee06db79cc9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const2.adb @@ -0,0 +1,11 @@ +-- { dg-do run } + +with System; use System; +with Deferred_Const2_Pkg; use Deferred_Const2_Pkg; + +procedure Deferred_Const2 is +begin + if I'Address /= S'Address then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/deferred_const2_pkg.adb b/gcc/testsuite/gnat.dg/deferred_const2_pkg.adb new file mode 100644 index 00000000000..b81d448863b --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const2_pkg.adb @@ -0,0 +1,11 @@ +with System; use System; + +package body Deferred_Const2_Pkg is + + procedure Dummy is begin null; end; + +begin + if S'Address /= I'Address then + raise Program_Error; + end if; +end Deferred_Const2_Pkg; diff --git a/gcc/testsuite/gnat.dg/deferred_const2_pkg.ads b/gcc/testsuite/gnat.dg/deferred_const2_pkg.ads new file mode 100644 index 00000000000..c76e5fdb802 --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const2_pkg.ads @@ -0,0 +1,12 @@ +package Deferred_Const2_Pkg is + + I : Integer := 16#20_3A_2D_28#; + + pragma Warnings (Off); + S : constant string(1..4); + for S'address use I'address; + pragma Import (Ada, S); + + procedure Dummy; + +end Deferred_Const2_Pkg; diff --git a/gcc/testsuite/gnat.dg/deferred_const3.adb b/gcc/testsuite/gnat.dg/deferred_const3.adb new file mode 100644 index 00000000000..84554d3063f --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const3.adb @@ -0,0 +1,19 @@ +-- { dg-do run } + +with System; use System; +with Deferred_Const3_Pkg; use Deferred_Const3_Pkg; + +procedure Deferred_Const3 is +begin + if C1'Address /= C'Address then + raise Program_Error; + end if; + + if C2'Address /= C'Address then + raise Program_Error; + end if; + + if C3'Address /= C'Address then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/deferred_const3_pkg.adb b/gcc/testsuite/gnat.dg/deferred_const3_pkg.adb new file mode 100644 index 00000000000..e865494454b --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const3_pkg.adb @@ -0,0 +1,19 @@ +with System; use System; + +package body Deferred_Const3_Pkg is + + procedure Dummy is begin null; end; + +begin + if C1'Address /= C'Address then + raise Program_Error; + end if; + + if C2'Address /= C'Address then + raise Program_Error; + end if; + + if C3'Address /= C'Address then + raise Program_Error; + end if; +end Deferred_Const3_Pkg; diff --git a/gcc/testsuite/gnat.dg/deferred_const3_pkg.ads b/gcc/testsuite/gnat.dg/deferred_const3_pkg.ads new file mode 100644 index 00000000000..de6af3d52ac --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const3_pkg.ads @@ -0,0 +1,21 @@ +package Deferred_Const3_Pkg is + + C : constant Natural := 1; + + C1 : constant Natural := 1; + for C1'Address use C'Address; + + C2 : constant Natural; + for C2'Address use C'Address; + + C3 : constant Natural; + + procedure Dummy; + +private + C2 : constant Natural := 1; + + C3 : constant Natural := 1; + for C3'Address use C'Address; + +end Deferred_Const3_Pkg; diff --git a/gcc/testsuite/gnat.dg/raise_from_pure.adb b/gcc/testsuite/gnat.dg/raise_from_pure.adb new file mode 100644 index 00000000000..62e543e94db --- /dev/null +++ b/gcc/testsuite/gnat.dg/raise_from_pure.adb @@ -0,0 +1,11 @@ +package body raise_from_pure is + function Raise_CE_If_0 (P : Integer) return Integer is + begin + if P = 0 then + raise Constraint_error; + end if; + return 1; + end; +end; + + diff --git a/gcc/testsuite/gnat.dg/raise_from_pure.ads b/gcc/testsuite/gnat.dg/raise_from_pure.ads new file mode 100644 index 00000000000..9c363a5be48 --- /dev/null +++ b/gcc/testsuite/gnat.dg/raise_from_pure.ads @@ -0,0 +1,5 @@ + +package raise_from_pure is + pragma Pure; + function Raise_CE_If_0 (P : Integer) return Integer; +end; diff --git a/gcc/testsuite/gnat.dg/test_ai254.adb b/gcc/testsuite/gnat.dg/test_ai254.adb new file mode 100644 index 00000000000..18f65837259 --- /dev/null +++ b/gcc/testsuite/gnat.dg/test_ai254.adb @@ -0,0 +1,12 @@ +-- { dg-do compile } + +procedure test_ai254 is + function Func + (Obj : not null access protected function (X : Float) return Float) + return not null access protected function (X : Float) return Float is + begin + return null; + end; +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/test_raise_from_pure.adb b/gcc/testsuite/gnat.dg/test_raise_from_pure.adb new file mode 100644 index 00000000000..ab1ed16db5c --- /dev/null +++ b/gcc/testsuite/gnat.dg/test_raise_from_pure.adb @@ -0,0 +1,9 @@ +-- { dg-do run } +-- { dg-options "-O2" } +with Wrap_Raise_From_Pure; use Wrap_Raise_From_Pure; +procedure test_raise_from_pure is +begin + Wrap_Raise_From_Pure.Check; +exception + when Constraint_Error => null; +end; diff --git a/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb new file mode 100644 index 00000000000..ec8f342c6b5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.adb @@ -0,0 +1,10 @@ +with Ada.Text_Io; use Ada.Text_Io; +with Raise_From_Pure; use Raise_From_Pure; +package body Wrap_Raise_From_Pure is + procedure Check is + K : Integer; + begin + K := Raise_CE_If_0 (0); + Put_Line ("Should never reach here"); + end; +end; diff --git a/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads new file mode 100644 index 00000000000..521c04a5fc9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/wrap_raise_from_pure.ads @@ -0,0 +1,4 @@ + +package Wrap_Raise_From_Pure is + procedure Check; +end; diff --git a/gcc/testsuite/lib/target-supports.exp b/gcc/testsuite/lib/target-supports.exp index f56b3f4f212..d82829e2058 100644 --- a/gcc/testsuite/lib/target-supports.exp +++ b/gcc/testsuite/lib/target-supports.exp @@ -2078,6 +2078,27 @@ proc check_effective_target_vect_extract_even_odd { } { return $et_vect_extract_even_odd_saved } +# Return 1 if the target supports vector even/odd elements extraction of +# vectors with SImode elements or larger, 0 otherwise. + +proc check_effective_target_vect_extract_even_odd_wide { } { + global et_vect_extract_even_odd_wide_saved + + if [info exists et_vect_extract_even_odd_wide_saved] { + verbose "check_effective_target_vect_extract_even_odd_wide: using cached result" 2 + } else { + set et_vect_extract_even_odd_wide_saved 0 + if { [istarget powerpc*-*-*] + || [istarget i?86-*-*] + || [istarget x86_64-*-*] } { + set et_vect_extract_even_odd_wide_saved 1 + } + } + + verbose "check_effective_target_vect_extract_even_wide_odd: returning $et_vect_extract_even_odd_wide_saved" 2 + return $et_vect_extract_even_odd_wide_saved +} + # Return 1 if the target supports vector interleaving, 0 otherwise. proc check_effective_target_vect_interleave { } { @@ -2116,6 +2137,25 @@ proc check_effective_target_vect_strided { } { return $et_vect_strided_saved } +# Return 1 if the target supports vector interleaving and extract even/odd +# for wide element types, 0 otherwise. +proc check_effective_target_vect_strided_wide { } { + global et_vect_strided_wide_saved + + if [info exists et_vect_strided_wide_saved] { + verbose "check_effective_target_vect_strided_wide: using cached result" 2 + } else { + set et_vect_strided_wide_saved 0 + if { [check_effective_target_vect_interleave] + && [check_effective_target_vect_extract_even_odd_wide] } { + set et_vect_strided_wide_saved 1 + } + } + + verbose "check_effective_target_vect_strided_wide: returning $et_vect_strided_wide_saved" 2 + return $et_vect_strided_wide_saved +} + # Return 1 if the target supports section-anchors proc check_effective_target_section_anchors { } { diff --git a/gcc/tree-ssa-ccp.c b/gcc/tree-ssa-ccp.c index 44b5523263d..b867bba08d5 100644 --- a/gcc/tree-ssa-ccp.c +++ b/gcc/tree-ssa-ccp.c @@ -989,7 +989,13 @@ ccp_fold (gimple stmt) allowed places. */ if ((subcode == NOP_EXPR || subcode == CONVERT_EXPR) && ((POINTER_TYPE_P (TREE_TYPE (lhs)) - && POINTER_TYPE_P (TREE_TYPE (op0))) + && POINTER_TYPE_P (TREE_TYPE (op0)) + /* Do not allow differences in volatile qualification + as this might get us confused as to whether a + propagation destination statement is volatile + or not. See PR36988. */ + && (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (lhs))) + == TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (op0))))) || useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (op0)))) return op0; diff --git a/gcc/tree-ssa-loop-ivcanon.c b/gcc/tree-ssa-loop-ivcanon.c index dc863f8b8a5..00965465342 100644 --- a/gcc/tree-ssa-loop-ivcanon.c +++ b/gcc/tree-ssa-loop-ivcanon.c @@ -184,10 +184,6 @@ try_unroll_loop_completely (struct loop *loop, ninsns = tree_num_loop_insns (loop, &eni_size_weights); - if (n_unroll * ninsns - > (unsigned) PARAM_VALUE (PARAM_MAX_COMPLETELY_PEELED_INSNS)) - return false; - unr_insns = estimated_unrolled_size (ninsns, n_unroll); if (dump_file && (dump_flags & TDF_DETAILS)) { @@ -196,6 +192,17 @@ try_unroll_loop_completely (struct loop *loop, (int) unr_insns); } + if (unr_insns > ninsns + && (unr_insns + > (unsigned) PARAM_VALUE (PARAM_MAX_COMPLETELY_PEELED_INSNS))) + { + if (dump_file && (dump_flags & TDF_DETAILS)) + fprintf (dump_file, "Not unrolling loop %d " + "(--param max-completely-peeled-insns limit reached).\n", + loop->num); + return false; + } + if (ul == UL_NO_GROWTH && unr_insns > ninsns) { diff --git a/gcc/tree-ssa-pre.c b/gcc/tree-ssa-pre.c index c98a18a772c..336c54ec700 100644 --- a/gcc/tree-ssa-pre.c +++ b/gcc/tree-ssa-pre.c @@ -4086,7 +4086,7 @@ init_pre (bool do_fre) /* Deallocate data structures used by PRE. */ static void -fini_pre (void) +fini_pre (bool do_fre) { basic_block bb; @@ -4117,7 +4117,7 @@ fini_pre (void) BITMAP_FREE (need_eh_cleanup); - if (current_loops != NULL) + if (!do_fre) loop_optimizer_finalize (); } @@ -4192,7 +4192,7 @@ execute_pre (bool do_fre ATTRIBUTE_UNUSED) if (!do_fre) remove_dead_inserted_code (); - fini_pre (); + fini_pre (do_fre); return todo; } diff --git a/gnattools/ChangeLog b/gnattools/ChangeLog index 81f32c10965..169a0143f99 100644 --- a/gnattools/ChangeLog +++ b/gnattools/ChangeLog @@ -1,3 +1,14 @@ +2008-08-01 Paolo Bonzini <bonzini@gnu.org> + + * configure.ac (warn_cflags): Substitute. + * configure: Regenerate. + * Makefile.in (libdir, exeext, WARN_CFLAGS): Substitute. + (GCC_WARN_CFLAGS): Remove NOCOMMON_FLAG. + (ADA_INCLUDE_DIR, ADA_RTL_OBJ_DIR): Remove as they were unused. + (libsubdir): Remove. + (libada-mk): Do not include. Include libgcc.mvars instead. + (xmake_file): Remove, do not include. + 2008-07-30 Paolo Bonzini <bonzini@gnu.org> * configure.ac (x_ada_cflags): Remove. diff --git a/gnattools/Makefile.in b/gnattools/Makefile.in index f28bc685a49..ed40ba54411 100644 --- a/gnattools/Makefile.in +++ b/gnattools/Makefile.in @@ -21,6 +21,7 @@ all: gnattools # Standard autoconf-set variables. SHELL = @SHELL@ srcdir = @srcdir@ +libdir = @libdir@ build = @build@ target = @target@ prefix = @prefix@ @@ -33,6 +34,7 @@ LN_S=@LN_S@ target_noncanonical=@target_noncanonical@ # Variables for the user (or the top level) to override. +exeext = @EXEEXT@ objext=.o TRACE=no ADA_FOR_BUILD= @@ -43,27 +45,16 @@ PWD_COMMAND = $${PWDCMD-pwd} # The tedious process of getting CFLAGS right. CFLAGS=-g LOOSE_WARN = -W -Wall -Wwrite-strings -Wstrict-prototypes -Wmissing-prototypes -GCC_WARN_CFLAGS = $(LOOSE_WARN) $(NOCOMMON_FLAG) +GCC_WARN_CFLAGS = $(LOOSE_WARN) +WARN_CFLAGS = @warn_cflags@ ADA_CFLAGS=@ADA_CFLAGS@ # Variables for gnattools. ADAFLAGS= -gnatpg -gnata -ADA_INCLUDE_DIR = $(libsubdir)/adainclude -ADA_RTL_OBJ_DIR = $(libsubdir)/adalib # For finding the GCC build dir, which is used far too much GCC_DIR=../gcc -# Include fragment generated by GCC configure; shared with libada for now. -include $(GCC_DIR)/libada-mk -# Variables based on those gleaned from the GCC makefile. :-P -libsubdir=$(libdir)/gcc/$(target_noncanonical)/$(gcc_version) - -# Get possible host-specific override for libsubdir (ick). -xmake_file=$(subst /config,/../gcc/config,$(gcc_xmake_file)) -ifneq ($(xmake_file),) -include $(xmake_file) -endif # Absolute srcdir for gcc/ada (why do we want absolute? I dunno) fsrcdir := $(shell cd $(srcdir)/../gcc/ada/; ${PWD_COMMAND}) diff --git a/gnattools/configure b/gnattools/configure index 3cd9eef4c5c..7e5513b0118 100755 --- a/gnattools/configure +++ b/gnattools/configure @@ -272,7 +272,7 @@ PACKAGE_STRING= PACKAGE_BUGREPORT= ac_unique_file="Makefile.in" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical LN_S default_gnattools_target TOOLS_TARGET_PAIRS EXTRA_GNATTOOLS ADA_CFLAGS LIBOBJS LTLIBOBJS' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical LN_S default_gnattools_target TOOLS_TARGET_PAIRS EXTRA_GNATTOOLS ADA_CFLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT warn_cflags LIBOBJS LTLIBOBJS' ac_subst_files='' ac_pwd=`pwd` @@ -714,6 +714,22 @@ ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias +ac_env_CC_set=${CC+set} +ac_env_CC_value=$CC +ac_cv_env_CC_set=${CC+set} +ac_cv_env_CC_value=$CC +ac_env_CFLAGS_set=${CFLAGS+set} +ac_env_CFLAGS_value=$CFLAGS +ac_cv_env_CFLAGS_set=${CFLAGS+set} +ac_cv_env_CFLAGS_value=$CFLAGS +ac_env_LDFLAGS_set=${LDFLAGS+set} +ac_env_LDFLAGS_value=$LDFLAGS +ac_cv_env_LDFLAGS_set=${LDFLAGS+set} +ac_cv_env_LDFLAGS_value=$LDFLAGS +ac_env_CPPFLAGS_set=${CPPFLAGS+set} +ac_env_CPPFLAGS_value=$CPPFLAGS +ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} +ac_cv_env_CPPFLAGS_value=$CPPFLAGS # # Report the --help message. @@ -793,6 +809,17 @@ Optional Features: enable make rules and dependencies not useful (and sometimes confusing) to the casual installer +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a + nonstandard directory <lib dir> + CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have + headers in a nonstandard directory <include dir> + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + _ACEOF fi @@ -1589,6 +1616,952 @@ esac # From user or toplevel makefile. +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + CC=$ac_ct_CC +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + CC=$ac_ct_CC +else + CC="$ac_cv_prog_CC" +fi + +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + test -n "$ac_ct_CC" && break +done + + CC=$ac_ct_CC +fi + +fi + + +test -z "$CC" && { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH +See \`config.log' for more details." >&5 +echo "$as_me: error: no acceptable C compiler found in \$PATH +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } + +# Provide some information about the compiler. +echo "$as_me:$LINENO:" \ + "checking for C compiler version" >&5 +ac_compiler=`set X $ac_compile; echo $2` +{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5 + (eval $ac_compiler --version </dev/null >&5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5 + (eval $ac_compiler -v </dev/null >&5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5 + (eval $ac_compiler -V </dev/null >&5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 +echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 +ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` +if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 + (eval $ac_link_default) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # Find the output, starting from the most likely. This scheme is +# not robust to junk in `.', hence go to wildcards (a.*) only as a last +# resort. + +# Be careful to initialize this variable, since it used to be cached. +# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. +ac_cv_exeext= +# b.out is created by i960 compilers. +for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) + ;; + conftest.$ac_ext ) + # This is the source file. + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + # FIXME: I believe we export ac_cv_exeext for Libtool, + # but it would be cool to find out if it's true. Does anybody + # maintain Libtool? --akim. + export ac_cv_exeext + break;; + * ) + break;; + esac +done +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { echo "$as_me:$LINENO: error: C compiler cannot create executables +See \`config.log' for more details." >&5 +echo "$as_me: error: C compiler cannot create executables +See \`config.log' for more details." >&2;} + { (exit 77); exit 77; }; }; } +fi + +ac_exeext=$ac_cv_exeext +echo "$as_me:$LINENO: result: $ac_file" >&5 +echo "${ECHO_T}$ac_file" >&6 + +# Check the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +echo "$as_me:$LINENO: checking whether the C compiler works" >&5 +echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 +# FIXME: These cross compiler hacks should be removed for Autoconf 3.0 +# If not cross compiling, check that we can run a simple program. +if test "$cross_compiling" != yes; then + if { ac_try='./$ac_file' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { echo "$as_me:$LINENO: error: cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } + fi + fi +fi +echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + +rm -f a.out a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +# Check the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 +echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 +echo "$as_me:$LINENO: result: $cross_compiling" >&5 +echo "${ECHO_T}$cross_compiling" >&6 + +echo "$as_me:$LINENO: checking for suffix of executables" >&5 +echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + export ac_cv_exeext + break;; + * ) break;; + esac +done +else + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } +fi + +rm -f conftest$ac_cv_exeext +echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 +echo "${ECHO_T}$ac_cv_exeext" >&6 + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +echo "$as_me:$LINENO: checking for suffix of object files" >&5 +echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 +if test "${ac_cv_objext+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot compute suffix of object files: cannot compile +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } +fi + +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 +echo "${ECHO_T}$ac_cv_objext" >&6 +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 +echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 +if test "${ac_cv_c_compiler_gnu+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_compiler_gnu=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_compiler_gnu=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 +echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 +GCC=`test $ac_compiler_gnu = yes && echo yes` +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +CFLAGS="-g" +echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 +echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 +if test "${ac_cv_prog_cc_g+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_prog_cc_g=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_prog_cc_g=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 +echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 +echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 +if test "${ac_cv_prog_cc_stdc+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_prog_cc_stdc=no +ac_save_CC=$CC +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <stdarg.h> +#include <stdio.h> +#include <sys/types.h> +#include <sys/stat.h> +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std1 is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std1. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +# Don't try gcc -ansi; that turns off useful extensions and +# breaks some systems' header files. +# AIX -qlanglvl=ansi +# Ultrix and OSF/1 -std1 +# HP-UX 10.20 and later -Ae +# HP-UX older versions -Aa -D_HPUX_SOURCE +# SVR4 -Xc -D__EXTENSIONS__ +for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_prog_cc_stdc=$ac_arg +break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext +done +rm -f conftest.$ac_ext conftest.$ac_objext +CC=$ac_save_CC + +fi + +case "x$ac_cv_prog_cc_stdc" in + x|xno) + echo "$as_me:$LINENO: result: none needed" >&5 +echo "${ECHO_T}none needed" >&6 ;; + *) + echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 +echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 + CC="$CC $ac_cv_prog_cc_stdc" ;; +esac + +# Some people use a C++ compiler to compile C. Since we use `exit', +# in C++ we need to declare it. In case someone uses the same compiler +# for both compiling C and C++ we need to have the C++ compiler decide +# the declaration of exit, since it's the most demanding environment. +cat >conftest.$ac_ext <<_ACEOF +#ifndef __cplusplus + choke me +#endif +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + for ac_declaration in \ + '' \ + 'extern "C" void std::exit (int) throw (); using std::exit;' \ + 'extern "C" void std::exit (int); using std::exit;' \ + 'extern "C" void exit (int) throw ();' \ + 'extern "C" void exit (int);' \ + 'void exit (int);' +do + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_declaration +#include <stdlib.h> +int +main () +{ +exit (42); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + : +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +continue +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_declaration +int +main () +{ +exit (42); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +done +rm -f conftest* +if test -n "$ac_declaration"; then + echo '#ifdef __cplusplus' >>confdefs.h + echo $ac_declaration >>confdefs.h + echo '#endif' >>confdefs.h +fi + +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +warn_cflags= +if test "x$GCC" = "xyes"; then + warn_cflags='$(GCC_WARN_CFLAGS)' +fi + + # Output: create a Makefile. ac_config_files="$ac_config_files Makefile" @@ -2250,6 +3223,14 @@ s,@default_gnattools_target@,$default_gnattools_target,;t t s,@TOOLS_TARGET_PAIRS@,$TOOLS_TARGET_PAIRS,;t t s,@EXTRA_GNATTOOLS@,$EXTRA_GNATTOOLS,;t t s,@ADA_CFLAGS@,$ADA_CFLAGS,;t t +s,@CC@,$CC,;t t +s,@CFLAGS@,$CFLAGS,;t t +s,@LDFLAGS@,$LDFLAGS,;t t +s,@CPPFLAGS@,$CPPFLAGS,;t t +s,@ac_ct_CC@,$ac_ct_CC,;t t +s,@EXEEXT@,$EXEEXT,;t t +s,@OBJEXT@,$OBJEXT,;t t +s,@warn_cflags@,$warn_cflags,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF diff --git a/gnattools/configure.ac b/gnattools/configure.ac index 965dc8e18e5..ac0c6926633 100644 --- a/gnattools/configure.ac +++ b/gnattools/configure.ac @@ -156,6 +156,13 @@ esac # From user or toplevel makefile. AC_SUBST(ADA_CFLAGS) +AC_PROG_CC +warn_cflags= +if test "x$GCC" = "xyes"; then + warn_cflags='$(GCC_WARN_CFLAGS)' +fi +AC_SUBST(warn_cflags) + # Output: create a Makefile. AC_CONFIG_FILES([Makefile]) diff --git a/libada/ChangeLog b/libada/ChangeLog index bf20ed52d24..6c60719ec31 100644 --- a/libada/ChangeLog +++ b/libada/ChangeLog @@ -1,3 +1,16 @@ +2008-08-01 Paolo Bonzini <bonzini@gnu.org> + + * configure.ac (warn_cflags): Substitute. + * configure: Regenerate. + * Makefile.in (libdir, WARN_CFLAGS): Substitute. + (GCC_WARN_CFLAGS): Remove NOCOMMON_FLAG. + (ADA_CFLAGS, T_ADA_CFLAGS, X_ADA_CFLAGS, ALL_ADA_CFLAGS): Remove, + they were unused. + (libada-mk): Do not include. Include libgcc.mvars instead. + (tmake_file): Remove, do not include. + (FLAGS_TO_PASS): Pass dummy values for exeext and CC. + * configure: Regenerate. + 2008-06-17 Ralf Wildenhues <Ralf.Wildenhues@gmx.de> * configure.ac: move sinclude of acx.m4 before AC_INIT, diff --git a/libada/Makefile.in b/libada/Makefile.in index 23d6713a5b3..5e5792db559 100644 --- a/libada/Makefile.in +++ b/libada/Makefile.in @@ -21,6 +21,7 @@ all: gnatlib # Standard autoconf-set variables. SHELL = @SHELL@ srcdir = @srcdir@ +libdir = @libdir@ build = @build@ target = @target@ prefix = @prefix@ @@ -39,41 +40,30 @@ LDFLAGS= # The tedious process of getting CFLAGS right. CFLAGS=-g LOOSE_WARN = -W -Wall -Wwrite-strings -Wstrict-prototypes -Wmissing-prototypes -GCC_WARN_CFLAGS = $(LOOSE_WARN) $(NOCOMMON_FLAG) +GCC_WARN_CFLAGS = $(LOOSE_WARN) +WARN_CFLAGS = @warn_cflags@ -ADA_CFLAGS= -T_ADA_CFLAGS= -# HPPA is literally the only target which sets X_ADA_CFLAGS -X_ADA_CFLAGS=@x_ada_cflags@ -ALL_ADA_CFLAGS=$(X_ADA_CFLAGS) $(T_ADA_CFLAGS) $(ADA_CFLAGS) +TARGET_LIBGCC2_CFLAGS= +GNATLIBCFLAGS= -g -O2 -# For finding the GCC build dir, which is used far too much +# Get target-specific overrides for TARGET_LIBGCC2_CFLAGS. host_subdir = @host_subdir@ GCC_DIR=../../$(host_subdir)/gcc -# Include fragment generated by GCC configure. -include $(GCC_DIR)/libada-mk - -TARGET_LIBGCC2_CFLAGS= -GNATLIBCFLAGS= -g -O2 -# Get target-specific overrides for TARGET_LIBGCC2_CFLAGS -# and possibly GNATLIBCFLAGS. Currently this uses files -# in gcc/config. The 'subst' call is used to rerelativize them -# from their gcc locations. This is hackery, but there isn't -# yet a better way to do this. -tmake_file=$(subst /config,/../gcc/config,$(gcc_tmake_file)) -ifneq ($(tmake_file),) -include $(tmake_file) -endif +include $(GCC_DIR)/libgcc.mvars +# exeext should not be used because it's the *host* exeext. We're building +# a *target* library, aren't we?!? Likewise for CC. Still, provide bogus +# definitions just in case something slips through the safety net provided +# by recursive make invocations in gcc/ada/Makefile.in FLAGS_TO_PASS = \ "MAKEOVERRIDES=" \ "LDFLAGS=$(LDFLAGS)" \ "LN_S=$(LN_S)" \ "SHELL=$(SHELL)" \ - "exeext=$(exeext)" \ "objext=$(objext)" \ "prefix=$(prefix)" \ - "CC=$(host_cc_for_libada)" \ + "exeext=.exeext.should.not.be.used " \ + 'CC=the.host.compiler.should.not.be.needed' \ "GCC_FOR_TARGET=$(CC)" \ "CFLAGS=$(CFLAGS) $(WARN_CFLAGS)" diff --git a/libada/configure b/libada/configure index 1d821c407ea..cafd0f0bda3 100755 --- a/libada/configure +++ b/libada/configure @@ -272,7 +272,7 @@ PACKAGE_STRING= PACKAGE_BUGREPORT= ac_unique_file="Makefile.in" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical build_libsubdir build_subdir host_subdir target_subdir MAINT enable_shared LN_S x_ada_cflags default_gnatlib_target LIBOBJS LTLIBOBJS' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical build_libsubdir build_subdir host_subdir target_subdir MAINT enable_shared LN_S x_ada_cflags default_gnatlib_target CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT warn_cflags LIBOBJS LTLIBOBJS' ac_subst_files='' ac_pwd=`pwd` @@ -714,6 +714,22 @@ ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias +ac_env_CC_set=${CC+set} +ac_env_CC_value=$CC +ac_cv_env_CC_set=${CC+set} +ac_cv_env_CC_value=$CC +ac_env_CFLAGS_set=${CFLAGS+set} +ac_env_CFLAGS_value=$CFLAGS +ac_cv_env_CFLAGS_set=${CFLAGS+set} +ac_cv_env_CFLAGS_value=$CFLAGS +ac_env_LDFLAGS_set=${LDFLAGS+set} +ac_env_LDFLAGS_value=$LDFLAGS +ac_cv_env_LDFLAGS_set=${LDFLAGS+set} +ac_cv_env_LDFLAGS_value=$LDFLAGS +ac_env_CPPFLAGS_set=${CPPFLAGS+set} +ac_env_CPPFLAGS_value=$CPPFLAGS +ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} +ac_cv_env_CPPFLAGS_value=$CPPFLAGS # # Report the --help message. @@ -799,6 +815,17 @@ Optional Packages: --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-build-libsubdir=DIR Directory where to find libraries for build system +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a + nonstandard directory <lib dir> + CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have + headers in a nonstandard directory <include dir> + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + _ACEOF fi @@ -1483,6 +1510,952 @@ else fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + CC=$ac_ct_CC +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + CC=$ac_ct_CC +else + CC="$ac_cv_prog_CC" +fi + +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + echo "$as_me:$LINENO: result: $CC" >&5 +echo "${ECHO_T}$CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 +if test "${ac_cv_prog_ac_ct_CC+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 +echo "${ECHO_T}$ac_ct_CC" >&6 +else + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 +fi + + test -n "$ac_ct_CC" && break +done + + CC=$ac_ct_CC +fi + +fi + + +test -z "$CC" && { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH +See \`config.log' for more details." >&5 +echo "$as_me: error: no acceptable C compiler found in \$PATH +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } + +# Provide some information about the compiler. +echo "$as_me:$LINENO:" \ + "checking for C compiler version" >&5 +ac_compiler=`set X $ac_compile; echo $2` +{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5 + (eval $ac_compiler --version </dev/null >&5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5 + (eval $ac_compiler -v </dev/null >&5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5 + (eval $ac_compiler -V </dev/null >&5) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 +echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 +ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` +if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 + (eval $ac_link_default) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # Find the output, starting from the most likely. This scheme is +# not robust to junk in `.', hence go to wildcards (a.*) only as a last +# resort. + +# Be careful to initialize this variable, since it used to be cached. +# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. +ac_cv_exeext= +# b.out is created by i960 compilers. +for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) + ;; + conftest.$ac_ext ) + # This is the source file. + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + # FIXME: I believe we export ac_cv_exeext for Libtool, + # but it would be cool to find out if it's true. Does anybody + # maintain Libtool? --akim. + export ac_cv_exeext + break;; + * ) + break;; + esac +done +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { echo "$as_me:$LINENO: error: C compiler cannot create executables +See \`config.log' for more details." >&5 +echo "$as_me: error: C compiler cannot create executables +See \`config.log' for more details." >&2;} + { (exit 77); exit 77; }; }; } +fi + +ac_exeext=$ac_cv_exeext +echo "$as_me:$LINENO: result: $ac_file" >&5 +echo "${ECHO_T}$ac_file" >&6 + +# Check the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +echo "$as_me:$LINENO: checking whether the C compiler works" >&5 +echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 +# FIXME: These cross compiler hacks should be removed for Autoconf 3.0 +# If not cross compiling, check that we can run a simple program. +if test "$cross_compiling" != yes; then + if { ac_try='./$ac_file' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { echo "$as_me:$LINENO: error: cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } + fi + fi +fi +echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + +rm -f a.out a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +# Check the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 +echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 +echo "$as_me:$LINENO: result: $cross_compiling" >&5 +echo "${ECHO_T}$cross_compiling" >&6 + +echo "$as_me:$LINENO: checking for suffix of executables" >&5 +echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + export ac_cv_exeext + break;; + * ) break;; + esac +done +else + { { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } +fi + +rm -f conftest$ac_cv_exeext +echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 +echo "${ECHO_T}$ac_cv_exeext" >&6 + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +echo "$as_me:$LINENO: checking for suffix of object files" >&5 +echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 +if test "${ac_cv_objext+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5 +echo "$as_me: error: in \`$ac_pwd':" >&2;} +{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile +See \`config.log' for more details." >&5 +echo "$as_me: error: cannot compute suffix of object files: cannot compile +See \`config.log' for more details." >&2;} + { (exit 1); exit 1; }; }; } +fi + +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 +echo "${ECHO_T}$ac_cv_objext" >&6 +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 +echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 +if test "${ac_cv_c_compiler_gnu+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_compiler_gnu=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_compiler_gnu=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 +echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 +GCC=`test $ac_compiler_gnu = yes && echo yes` +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +CFLAGS="-g" +echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 +echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 +if test "${ac_cv_prog_cc_g+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_prog_cc_g=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_cv_prog_cc_g=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 +echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 +echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 +if test "${ac_cv_prog_cc_stdc+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_prog_cc_stdc=no +ac_save_CC=$CC +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <stdarg.h> +#include <stdio.h> +#include <sys/types.h> +#include <sys/stat.h> +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std1 is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std1. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +# Don't try gcc -ansi; that turns off useful extensions and +# breaks some systems' header files. +# AIX -qlanglvl=ansi +# Ultrix and OSF/1 -std1 +# HP-UX 10.20 and later -Ae +# HP-UX older versions -Aa -D_HPUX_SOURCE +# SVR4 -Xc -D__EXTENSIONS__ +for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_prog_cc_stdc=$ac_arg +break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext +done +rm -f conftest.$ac_ext conftest.$ac_objext +CC=$ac_save_CC + +fi + +case "x$ac_cv_prog_cc_stdc" in + x|xno) + echo "$as_me:$LINENO: result: none needed" >&5 +echo "${ECHO_T}none needed" >&6 ;; + *) + echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 +echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 + CC="$CC $ac_cv_prog_cc_stdc" ;; +esac + +# Some people use a C++ compiler to compile C. Since we use `exit', +# in C++ we need to declare it. In case someone uses the same compiler +# for both compiling C and C++ we need to have the C++ compiler decide +# the declaration of exit, since it's the most demanding environment. +cat >conftest.$ac_ext <<_ACEOF +#ifndef __cplusplus + choke me +#endif +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + for ac_declaration in \ + '' \ + 'extern "C" void std::exit (int) throw (); using std::exit;' \ + 'extern "C" void std::exit (int); using std::exit;' \ + 'extern "C" void exit (int) throw ();' \ + 'extern "C" void exit (int);' \ + 'void exit (int);' +do + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_declaration +#include <stdlib.h> +int +main () +{ +exit (42); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + : +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +continue +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_declaration +int +main () +{ +exit (42); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +done +rm -f conftest* +if test -n "$ac_declaration"; then + echo '#ifdef __cplusplus' >>confdefs.h + echo $ac_declaration >>confdefs.h + echo '#endif' >>confdefs.h +fi + +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +warn_cflags= +if test "x$GCC" = "xyes"; then + warn_cflags='$(GCC_WARN_CFLAGS)' +fi + + # Output: create a Makefile. ac_config_files="$ac_config_files Makefile" @@ -2143,6 +3116,14 @@ s,@enable_shared@,$enable_shared,;t t s,@LN_S@,$LN_S,;t t s,@x_ada_cflags@,$x_ada_cflags,;t t s,@default_gnatlib_target@,$default_gnatlib_target,;t t +s,@CC@,$CC,;t t +s,@CFLAGS@,$CFLAGS,;t t +s,@LDFLAGS@,$LDFLAGS,;t t +s,@CPPFLAGS@,$CPPFLAGS,;t t +s,@ac_ct_CC@,$ac_ct_CC,;t t +s,@EXEEXT@,$EXEEXT,;t t +s,@OBJEXT@,$OBJEXT,;t t +s,@warn_cflags@,$warn_cflags,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF diff --git a/libada/configure.ac b/libada/configure.ac index a2668125d8e..b0a46d00332 100644 --- a/libada/configure.ac +++ b/libada/configure.ac @@ -73,13 +73,6 @@ AC_SUBST([enable_shared]) # Need to pass this down for now :-P AC_PROG_LN_S -# Determine x_ada_cflags -case $host in - hppa*) x_ada_cflags=-mdisable-indexing ;; - *) x_ada_cflags= ;; -esac -AC_SUBST([x_ada_cflags]) - # Determine what to build for 'gnatlib' if test $build = $target \ && test ${enable_shared} = yes ; then @@ -90,6 +83,13 @@ else fi AC_SUBST([default_gnatlib_target]) +AC_PROG_CC +warn_cflags= +if test "x$GCC" = "xyes"; then + warn_cflags='$(GCC_WARN_CFLAGS)' +fi +AC_SUBST(warn_cflags) + # Output: create a Makefile. AC_CONFIG_FILES([Makefile]) diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index 3cc11cf302c..9e8a6e6700f 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,26 @@ +2008-08-04 Paolo Carlini <paolo.carlini@oracle.com> + + * include/bits/postypes.h: Reinstate inclusion of <stdint.h>; + also define the __STDC_* macros. + (streamoff): Adjust. + + * include/tr1_impl/cstdint: Check that the __STDC_* macros are + not defined before defining. + +2008-08-01 Paolo Bonzini <bonzini@gnu.org> + Chris Fairles <chris.fairles@gmail.com> + + * acinclude.m4 ([GLIBCXX_CHECK_CLOCK_GETTIME]): Reinstate clock_gettime + search, but only in libposix4, never link librt. + * src/Makefile.am: Reinstate previous change to add GLIBCXX_LIBS. + * configure: Regenerate. + * configure.in: Likewise. + * Makefile.in: Likewise. + * src/Makefile.in: Likewise. + * libsup++/Makefile.in: Likewise. + * po/Makefile.in: Likewise. + * doc/Makefile.in: Likewise. + 2008-07-31 Chris Fairles <chris.fairles@gmail.com> * include/std/chrono (duration): Use explicitly defaulted ctor, cctor, diff --git a/libstdc++-v3/Makefile.in b/libstdc++-v3/Makefile.in index 265d6900594..f576011cffa 100644 --- a/libstdc++-v3/Makefile.in +++ b/libstdc++-v3/Makefile.in @@ -180,6 +180,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@ GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@ GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@ GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@ +GLIBCXX_LIBS = @GLIBCXX_LIBS@ GREP = @GREP@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ diff --git a/libstdc++-v3/acinclude.m4 b/libstdc++-v3/acinclude.m4 index e998471c446..0a669c9a7fa 100644 --- a/libstdc++-v3/acinclude.m4 +++ b/libstdc++-v3/acinclude.m4 @@ -1018,7 +1018,15 @@ AC_DEFUN([GLIBCXX_CHECK_CLOCK_GETTIME], [ AC_LANG_CPLUSPLUS ac_save_CXXFLAGS="$CXXFLAGS" CXXFLAGS="$CXXFLAGS -fno-exceptions" - + ac_save_LIBS="$LIBS" + + AC_SEARCH_LIBS(clock_gettime, [posix4]) + + # Link to -lposix4. + case "$ac_cv_search_clock_gettime" in + -lposix4*) GLIBCXX_LIBS=$ac_cv_search_clock_gettime + esac + AC_CHECK_HEADERS(unistd.h, ac_has_unistd_h=yes, ac_has_unistd_h=no) ac_has_clock_monotonic=no; @@ -1055,13 +1063,16 @@ AC_DEFUN([GLIBCXX_CHECK_CLOCK_GETTIME], [ AC_DEFINE(_GLIBCXX_USE_CLOCK_MONOTONIC, 1, [ Defined if clock_gettime has monotonic clock support. ]) fi - + if test x"$ac_has_clock_realtime" = x"yes"; then AC_DEFINE(_GLIBCXX_USE_CLOCK_REALTIME, 1, [ Defined if clock_gettime has realtime clock support. ]) fi - + + AC_SUBST(GLIBCXX_LIBS) + CXXFLAGS="$ac_save_CXXFLAGS" + LIBS="$ac_save_LIBS" AC_LANG_RESTORE ]) diff --git a/libstdc++-v3/configure b/libstdc++-v3/configure index d5005496585..36fcb9cb570 100755 --- a/libstdc++-v3/configure +++ b/libstdc++-v3/configure @@ -762,6 +762,7 @@ ac_includes_default="\ # include <unistd.h> #endif" +<<<<<<< .working ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME @@ -953,6 +954,9 @@ WARN_FLAGS LIBSUPCXX_PICFLAGS LIBOBJS LTLIBOBJS' +======= +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS libtool_VERSION multi_basedir build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA CYGPATH_W PACKAGE VERSION ACLOCAL AUTOCONF AUTOMAKE AUTOHEADER MAKEINFO install_sh STRIP ac_ct_STRIP INSTALL_STRIP_PROGRAM mkdir_p AWK SET_MAKE am__leading_dot AMTAR am__tar am__untar glibcxx_builddir glibcxx_srcdir toplevel_srcdir CC ac_ct_CC EXEEXT OBJEXT CXX ac_ct_CXX CFLAGS CXXFLAGS LN_S AS ac_ct_AS AR ac_ct_AR RANLIB ac_ct_RANLIB MAINTAINER_MODE_TRUE MAINTAINER_MODE_FALSE MAINT CPP CPPFLAGS EGREP LIBTOOL SED FGREP GREP LD DUMPBIN ac_ct_DUMPBIN NM lt_ECHO LDFLAGS CXXCPP enable_shared enable_static GLIBCXX_HOSTED_TRUE GLIBCXX_HOSTED_FALSE GLIBCXX_BUILD_PCH_TRUE GLIBCXX_BUILD_PCH_FALSE glibcxx_PCHFLAGS glibcxx_thread_h WERROR SECTION_FLAGS CSTDIO_H BASIC_FILE_H BASIC_FILE_CC check_msgfmt glibcxx_MOFILES glibcxx_POFILES glibcxx_localedir USE_NLS CLOCALE_H CMESSAGES_H CCODECVT_CC CCOLLATE_CC CCTYPE_CC CMESSAGES_CC CMONEY_CC CNUMERIC_CC CTIME_H CTIME_CC CLOCALE_CC CLOCALE_INTERNAL_H ALLOCATOR_H ALLOCATOR_NAME C_INCLUDE_DIR GLIBCXX_C_HEADERS_C_TRUE GLIBCXX_C_HEADERS_C_FALSE GLIBCXX_C_HEADERS_C_STD_TRUE GLIBCXX_C_HEADERS_C_STD_FALSE GLIBCXX_C_HEADERS_C_GLOBAL_TRUE GLIBCXX_C_HEADERS_C_GLOBAL_FALSE GLIBCXX_C_HEADERS_COMPATIBILITY_TRUE GLIBCXX_C_HEADERS_COMPATIBILITY_FALSE GLIBCXX_C_HEADERS_EXTRA_TRUE GLIBCXX_C_HEADERS_EXTRA_FALSE DEBUG_FLAGS GLIBCXX_BUILD_DEBUG_TRUE GLIBCXX_BUILD_DEBUG_FALSE ENABLE_PARALLEL_TRUE ENABLE_PARALLEL_FALSE EXTRA_CXX_FLAGS SECTION_LDFLAGS OPT_LDFLAGS LIBMATHOBJS GLIBCXX_LIBS LIBICONV LTLIBICONV SYMVER_FILE port_specific_symbol_files ENABLE_SYMVERS_TRUE ENABLE_SYMVERS_FALSE ENABLE_SYMVERS_GNU_TRUE ENABLE_SYMVERS_GNU_FALSE ENABLE_SYMVERS_GNU_NAMESPACE_TRUE ENABLE_SYMVERS_GNU_NAMESPACE_FALSE ENABLE_SYMVERS_DARWIN_TRUE ENABLE_SYMVERS_DARWIN_FALSE ENABLE_VISIBILITY_TRUE ENABLE_VISIBILITY_FALSE GLIBCXX_LDBL_COMPAT_TRUE GLIBCXX_LDBL_COMPAT_FALSE baseline_dir ATOMICITY_SRCDIR ATOMIC_WORD_SRCDIR ATOMIC_FLAGS CPU_DEFINES_SRCDIR ABI_TWEAKS_SRCDIR OS_INC_SRCDIR ERROR_CONSTANTS_SRCDIR glibcxx_prefixdir gxx_include_dir glibcxx_toolexecdir glibcxx_toolexeclibdir GLIBCXX_INCLUDES TOPLEVEL_INCLUDES OPTIMIZE_CXXFLAGS WARN_FLAGS LIBSUPCXX_PICFLAGS LIBOBJS LTLIBOBJS' +>>>>>>> .merge-right.r138620 ac_subst_files='' # Check that the precious variables saved in the cache have kept the same # value. @@ -40141,6 +40145,149 @@ ac_compiler_gnu=$ac_cv_cxx_compiler_gnu ac_save_CXXFLAGS="$CXXFLAGS" CXXFLAGS="$CXXFLAGS -fno-exceptions" + ac_save_LIBS="$LIBS" + + echo "$as_me:$LINENO: checking for library containing clock_gettime" >&5 +echo $ECHO_N "checking for library containing clock_gettime... $ECHO_C" >&6 +if test "${ac_cv_search_clock_gettime+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_func_search_save_LIBS=$LIBS +ac_cv_search_clock_gettime=no +if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 +echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } +fi +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char clock_gettime (); +int +main () +{ +clock_gettime (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_cxx_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_search_clock_gettime="none required" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +if test "$ac_cv_search_clock_gettime" = no; then + for ac_lib in posix4; do + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 +echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } +fi +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char clock_gettime (); +int +main () +{ +clock_gettime (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_cxx_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_cv_search_clock_gettime="-l$ac_lib" +break +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done +fi +LIBS=$ac_func_search_save_LIBS +fi +echo "$as_me:$LINENO: result: $ac_cv_search_clock_gettime" >&5 +echo "${ECHO_T}$ac_cv_search_clock_gettime" >&6 +if test "$ac_cv_search_clock_gettime" != no; then + test "$ac_cv_search_clock_gettime" = "none required" || LIBS="$ac_cv_search_clock_gettime $LIBS" + +fi + + + # Link to -lposix4. + case "$ac_cv_search_clock_gettime" in + -lposix4*) GLIBCXX_LIBS=$ac_cv_search_clock_gettime + esac for ac_header in unistd.h @@ -40441,7 +40588,10 @@ _ACEOF fi + + CXXFLAGS="$ac_save_CXXFLAGS" + LIBS="$ac_save_LIBS" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' @@ -116752,7 +116902,204 @@ $debug || # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h +<<<<<<< .working if test -n "$CONFIG_FILES"; then +======= +if test -n "\$CONFIG_FILES"; then + # Protect against being on the right side of a sed subst in config.status. + sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; + s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF +s,@SHELL@,$SHELL,;t t +s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t +s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t +s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t +s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t +s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t +s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t +s,@exec_prefix@,$exec_prefix,;t t +s,@prefix@,$prefix,;t t +s,@program_transform_name@,$program_transform_name,;t t +s,@bindir@,$bindir,;t t +s,@sbindir@,$sbindir,;t t +s,@libexecdir@,$libexecdir,;t t +s,@datadir@,$datadir,;t t +s,@sysconfdir@,$sysconfdir,;t t +s,@sharedstatedir@,$sharedstatedir,;t t +s,@localstatedir@,$localstatedir,;t t +s,@libdir@,$libdir,;t t +s,@includedir@,$includedir,;t t +s,@oldincludedir@,$oldincludedir,;t t +s,@infodir@,$infodir,;t t +s,@mandir@,$mandir,;t t +s,@build_alias@,$build_alias,;t t +s,@host_alias@,$host_alias,;t t +s,@target_alias@,$target_alias,;t t +s,@DEFS@,$DEFS,;t t +s,@ECHO_C@,$ECHO_C,;t t +s,@ECHO_N@,$ECHO_N,;t t +s,@ECHO_T@,$ECHO_T,;t t +s,@LIBS@,$LIBS,;t t +s,@libtool_VERSION@,$libtool_VERSION,;t t +s,@multi_basedir@,$multi_basedir,;t t +s,@build@,$build,;t t +s,@build_cpu@,$build_cpu,;t t +s,@build_vendor@,$build_vendor,;t t +s,@build_os@,$build_os,;t t +s,@host@,$host,;t t +s,@host_cpu@,$host_cpu,;t t +s,@host_vendor@,$host_vendor,;t t +s,@host_os@,$host_os,;t t +s,@target@,$target,;t t +s,@target_cpu@,$target_cpu,;t t +s,@target_vendor@,$target_vendor,;t t +s,@target_os@,$target_os,;t t +s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t +s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t +s,@INSTALL_DATA@,$INSTALL_DATA,;t t +s,@CYGPATH_W@,$CYGPATH_W,;t t +s,@PACKAGE@,$PACKAGE,;t t +s,@VERSION@,$VERSION,;t t +s,@ACLOCAL@,$ACLOCAL,;t t +s,@AUTOCONF@,$AUTOCONF,;t t +s,@AUTOMAKE@,$AUTOMAKE,;t t +s,@AUTOHEADER@,$AUTOHEADER,;t t +s,@MAKEINFO@,$MAKEINFO,;t t +s,@install_sh@,$install_sh,;t t +s,@STRIP@,$STRIP,;t t +s,@ac_ct_STRIP@,$ac_ct_STRIP,;t t +s,@INSTALL_STRIP_PROGRAM@,$INSTALL_STRIP_PROGRAM,;t t +s,@mkdir_p@,$mkdir_p,;t t +s,@AWK@,$AWK,;t t +s,@SET_MAKE@,$SET_MAKE,;t t +s,@am__leading_dot@,$am__leading_dot,;t t +s,@AMTAR@,$AMTAR,;t t +s,@am__tar@,$am__tar,;t t +s,@am__untar@,$am__untar,;t t +s,@glibcxx_builddir@,$glibcxx_builddir,;t t +s,@glibcxx_srcdir@,$glibcxx_srcdir,;t t +s,@toplevel_srcdir@,$toplevel_srcdir,;t t +s,@CC@,$CC,;t t +s,@ac_ct_CC@,$ac_ct_CC,;t t +s,@EXEEXT@,$EXEEXT,;t t +s,@OBJEXT@,$OBJEXT,;t t +s,@CXX@,$CXX,;t t +s,@ac_ct_CXX@,$ac_ct_CXX,;t t +s,@CFLAGS@,$CFLAGS,;t t +s,@CXXFLAGS@,$CXXFLAGS,;t t +s,@LN_S@,$LN_S,;t t +s,@AS@,$AS,;t t +s,@ac_ct_AS@,$ac_ct_AS,;t t +s,@AR@,$AR,;t t +s,@ac_ct_AR@,$ac_ct_AR,;t t +s,@RANLIB@,$RANLIB,;t t +s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t +s,@MAINTAINER_MODE_TRUE@,$MAINTAINER_MODE_TRUE,;t t +s,@MAINTAINER_MODE_FALSE@,$MAINTAINER_MODE_FALSE,;t t +s,@MAINT@,$MAINT,;t t +s,@CPP@,$CPP,;t t +s,@CPPFLAGS@,$CPPFLAGS,;t t +s,@EGREP@,$EGREP,;t t +s,@LIBTOOL@,$LIBTOOL,;t t +s,@SED@,$SED,;t t +s,@FGREP@,$FGREP,;t t +s,@GREP@,$GREP,;t t +s,@LD@,$LD,;t t +s,@DUMPBIN@,$DUMPBIN,;t t +s,@ac_ct_DUMPBIN@,$ac_ct_DUMPBIN,;t t +s,@NM@,$NM,;t t +s,@lt_ECHO@,$lt_ECHO,;t t +s,@LDFLAGS@,$LDFLAGS,;t t +s,@CXXCPP@,$CXXCPP,;t t +s,@enable_shared@,$enable_shared,;t t +s,@enable_static@,$enable_static,;t t +s,@GLIBCXX_HOSTED_TRUE@,$GLIBCXX_HOSTED_TRUE,;t t +s,@GLIBCXX_HOSTED_FALSE@,$GLIBCXX_HOSTED_FALSE,;t t +s,@GLIBCXX_BUILD_PCH_TRUE@,$GLIBCXX_BUILD_PCH_TRUE,;t t +s,@GLIBCXX_BUILD_PCH_FALSE@,$GLIBCXX_BUILD_PCH_FALSE,;t t +s,@glibcxx_PCHFLAGS@,$glibcxx_PCHFLAGS,;t t +s,@glibcxx_thread_h@,$glibcxx_thread_h,;t t +s,@WERROR@,$WERROR,;t t +s,@SECTION_FLAGS@,$SECTION_FLAGS,;t t +s,@CSTDIO_H@,$CSTDIO_H,;t t +s,@BASIC_FILE_H@,$BASIC_FILE_H,;t t +s,@BASIC_FILE_CC@,$BASIC_FILE_CC,;t t +s,@check_msgfmt@,$check_msgfmt,;t t +s,@glibcxx_MOFILES@,$glibcxx_MOFILES,;t t +s,@glibcxx_POFILES@,$glibcxx_POFILES,;t t +s,@glibcxx_localedir@,$glibcxx_localedir,;t t +s,@USE_NLS@,$USE_NLS,;t t +s,@CLOCALE_H@,$CLOCALE_H,;t t +s,@CMESSAGES_H@,$CMESSAGES_H,;t t +s,@CCODECVT_CC@,$CCODECVT_CC,;t t +s,@CCOLLATE_CC@,$CCOLLATE_CC,;t t +s,@CCTYPE_CC@,$CCTYPE_CC,;t t +s,@CMESSAGES_CC@,$CMESSAGES_CC,;t t +s,@CMONEY_CC@,$CMONEY_CC,;t t +s,@CNUMERIC_CC@,$CNUMERIC_CC,;t t +s,@CTIME_H@,$CTIME_H,;t t +s,@CTIME_CC@,$CTIME_CC,;t t +s,@CLOCALE_CC@,$CLOCALE_CC,;t t +s,@CLOCALE_INTERNAL_H@,$CLOCALE_INTERNAL_H,;t t +s,@ALLOCATOR_H@,$ALLOCATOR_H,;t t +s,@ALLOCATOR_NAME@,$ALLOCATOR_NAME,;t t +s,@C_INCLUDE_DIR@,$C_INCLUDE_DIR,;t t +s,@GLIBCXX_C_HEADERS_C_TRUE@,$GLIBCXX_C_HEADERS_C_TRUE,;t t +s,@GLIBCXX_C_HEADERS_C_FALSE@,$GLIBCXX_C_HEADERS_C_FALSE,;t t +s,@GLIBCXX_C_HEADERS_C_STD_TRUE@,$GLIBCXX_C_HEADERS_C_STD_TRUE,;t t +s,@GLIBCXX_C_HEADERS_C_STD_FALSE@,$GLIBCXX_C_HEADERS_C_STD_FALSE,;t t +s,@GLIBCXX_C_HEADERS_C_GLOBAL_TRUE@,$GLIBCXX_C_HEADERS_C_GLOBAL_TRUE,;t t +s,@GLIBCXX_C_HEADERS_C_GLOBAL_FALSE@,$GLIBCXX_C_HEADERS_C_GLOBAL_FALSE,;t t +s,@GLIBCXX_C_HEADERS_COMPATIBILITY_TRUE@,$GLIBCXX_C_HEADERS_COMPATIBILITY_TRUE,;t t +s,@GLIBCXX_C_HEADERS_COMPATIBILITY_FALSE@,$GLIBCXX_C_HEADERS_COMPATIBILITY_FALSE,;t t +s,@GLIBCXX_C_HEADERS_EXTRA_TRUE@,$GLIBCXX_C_HEADERS_EXTRA_TRUE,;t t +s,@GLIBCXX_C_HEADERS_EXTRA_FALSE@,$GLIBCXX_C_HEADERS_EXTRA_FALSE,;t t +s,@DEBUG_FLAGS@,$DEBUG_FLAGS,;t t +s,@GLIBCXX_BUILD_DEBUG_TRUE@,$GLIBCXX_BUILD_DEBUG_TRUE,;t t +s,@GLIBCXX_BUILD_DEBUG_FALSE@,$GLIBCXX_BUILD_DEBUG_FALSE,;t t +s,@ENABLE_PARALLEL_TRUE@,$ENABLE_PARALLEL_TRUE,;t t +s,@ENABLE_PARALLEL_FALSE@,$ENABLE_PARALLEL_FALSE,;t t +s,@EXTRA_CXX_FLAGS@,$EXTRA_CXX_FLAGS,;t t +s,@SECTION_LDFLAGS@,$SECTION_LDFLAGS,;t t +s,@OPT_LDFLAGS@,$OPT_LDFLAGS,;t t +s,@LIBMATHOBJS@,$LIBMATHOBJS,;t t +s,@GLIBCXX_LIBS@,$GLIBCXX_LIBS,;t t +s,@LIBICONV@,$LIBICONV,;t t +s,@LTLIBICONV@,$LTLIBICONV,;t t +s,@SYMVER_FILE@,$SYMVER_FILE,;t t +s,@port_specific_symbol_files@,$port_specific_symbol_files,;t t +s,@ENABLE_SYMVERS_TRUE@,$ENABLE_SYMVERS_TRUE,;t t +s,@ENABLE_SYMVERS_FALSE@,$ENABLE_SYMVERS_FALSE,;t t +s,@ENABLE_SYMVERS_GNU_TRUE@,$ENABLE_SYMVERS_GNU_TRUE,;t t +s,@ENABLE_SYMVERS_GNU_FALSE@,$ENABLE_SYMVERS_GNU_FALSE,;t t +s,@ENABLE_SYMVERS_GNU_NAMESPACE_TRUE@,$ENABLE_SYMVERS_GNU_NAMESPACE_TRUE,;t t +s,@ENABLE_SYMVERS_GNU_NAMESPACE_FALSE@,$ENABLE_SYMVERS_GNU_NAMESPACE_FALSE,;t t +s,@ENABLE_SYMVERS_DARWIN_TRUE@,$ENABLE_SYMVERS_DARWIN_TRUE,;t t +s,@ENABLE_SYMVERS_DARWIN_FALSE@,$ENABLE_SYMVERS_DARWIN_FALSE,;t t +s,@ENABLE_VISIBILITY_TRUE@,$ENABLE_VISIBILITY_TRUE,;t t +s,@ENABLE_VISIBILITY_FALSE@,$ENABLE_VISIBILITY_FALSE,;t t +s,@GLIBCXX_LDBL_COMPAT_TRUE@,$GLIBCXX_LDBL_COMPAT_TRUE,;t t +s,@GLIBCXX_LDBL_COMPAT_FALSE@,$GLIBCXX_LDBL_COMPAT_FALSE,;t t +s,@baseline_dir@,$baseline_dir,;t t +s,@ATOMICITY_SRCDIR@,$ATOMICITY_SRCDIR,;t t +s,@ATOMIC_WORD_SRCDIR@,$ATOMIC_WORD_SRCDIR,;t t +s,@ATOMIC_FLAGS@,$ATOMIC_FLAGS,;t t +s,@CPU_DEFINES_SRCDIR@,$CPU_DEFINES_SRCDIR,;t t +s,@ABI_TWEAKS_SRCDIR@,$ABI_TWEAKS_SRCDIR,;t t +s,@OS_INC_SRCDIR@,$OS_INC_SRCDIR,;t t +s,@ERROR_CONSTANTS_SRCDIR@,$ERROR_CONSTANTS_SRCDIR,;t t +s,@glibcxx_prefixdir@,$glibcxx_prefixdir,;t t +s,@gxx_include_dir@,$gxx_include_dir,;t t +s,@glibcxx_toolexecdir@,$glibcxx_toolexecdir,;t t +s,@glibcxx_toolexeclibdir@,$glibcxx_toolexeclibdir,;t t +s,@GLIBCXX_INCLUDES@,$GLIBCXX_INCLUDES,;t t +s,@TOPLEVEL_INCLUDES@,$TOPLEVEL_INCLUDES,;t t +s,@OPTIMIZE_CXXFLAGS@,$OPTIMIZE_CXXFLAGS,;t t +s,@WARN_FLAGS@,$WARN_FLAGS,;t t +s,@LIBSUPCXX_PICFLAGS@,$LIBSUPCXX_PICFLAGS,;t t +s,@LIBOBJS@,$LIBOBJS,;t t +s,@LTLIBOBJS@,$LTLIBOBJS,;t t +CEOF +>>>>>>> .merge-right.r138620 _ACEOF diff --git a/libstdc++-v3/doc/Makefile.in b/libstdc++-v3/doc/Makefile.in index 5a514486777..3c1b6a9c117 100644 --- a/libstdc++-v3/doc/Makefile.in +++ b/libstdc++-v3/doc/Makefile.in @@ -148,6 +148,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@ GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@ GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@ GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@ +GLIBCXX_LIBS = @GLIBCXX_LIBS@ GREP = @GREP@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ diff --git a/libstdc++-v3/include/Makefile.in b/libstdc++-v3/include/Makefile.in index e9c8d89a6a7..b3f196d0d41 100644 --- a/libstdc++-v3/include/Makefile.in +++ b/libstdc++-v3/include/Makefile.in @@ -148,6 +148,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@ GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@ GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@ GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@ +GLIBCXX_LIBS = @GLIBCXX_LIBS@ GREP = @GREP@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ diff --git a/libstdc++-v3/include/bits/postypes.h b/libstdc++-v3/include/bits/postypes.h index 5ead488fa48..cdcafe2051f 100644 --- a/libstdc++-v3/include/bits/postypes.h +++ b/libstdc++-v3/include/bits/postypes.h @@ -46,6 +46,19 @@ #include <cwchar> // For mbstate_t +// XXX If <stdint.h> is really needed, make sure to define the macros, +// in order not to break <tr1/cstdint> (and <cstdint> in C++0x). +// Reconsider all this as soon as possible... +#ifdef _GLIBCXX_HAVE_INT64_T +#ifndef __STDC_LIMIT_MACROS +# define __STDC_LIMIT_MACROS +#endif +#ifndef __STDC_CONSTANT_MACROS +# define __STDC_CONSTANT_MACROS +#endif +#include <stdint.h> // For int64_t +#endif + _GLIBCXX_BEGIN_NAMESPACE(std) // The types streamoff, streampos and wstreampos and the class @@ -64,11 +77,7 @@ _GLIBCXX_BEGIN_NAMESPACE(std) * was typedef long. */ #ifdef _GLIBCXX_HAVE_INT64_T -# if (__CHAR_BIT__ * __SIZEOF_LONG__ == 64) - typedef long streamoff; -# else - typedef long long streamoff; -# endif + typedef int64_t streamoff; #else typedef long long streamoff; #endif diff --git a/libstdc++-v3/include/tr1_impl/cstdint b/libstdc++-v3/include/tr1_impl/cstdint index 6df74c761cb..93edf7c4fcd 100644 --- a/libstdc++-v3/include/tr1_impl/cstdint +++ b/libstdc++-v3/include/tr1_impl/cstdint @@ -1,6 +1,6 @@ // TR1 cstdint -*- C++ -*- -// Copyright (C) 2007 Free Software Foundation, Inc. +// Copyright (C) 2007, 2008 Free Software Foundation, Inc. // // This file is part of the GNU ISO C++ Library. This library is free // software; you can redistribute it and/or modify it under the @@ -36,9 +36,13 @@ #if _GLIBCXX_USE_C99_STDINT_TR1 -// For 8.22.1/1 (see C99, Notes 219, 220, 222) -#define __STDC_LIMIT_MACROS -#define __STDC_CONSTANT_MACROS +// For 8.22.1/1 (see C99, Notes 219, 220, 222) +#ifndef __STDC_LIMIT_MACROS +# define __STDC_LIMIT_MACROS +#endif +#ifndef __STDC_CONSTANT_MACROS +# define __STDC_CONSTANT_MACROS +#endif #include_next <stdint.h> namespace std diff --git a/libstdc++-v3/libmath/Makefile.in b/libstdc++-v3/libmath/Makefile.in index 2eb18b33326..4c2da1f3ecc 100644 --- a/libstdc++-v3/libmath/Makefile.in +++ b/libstdc++-v3/libmath/Makefile.in @@ -163,6 +163,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@ GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@ GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@ GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@ +GLIBCXX_LIBS = @GLIBCXX_LIBS@ GREP = @GREP@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ diff --git a/libstdc++-v3/libsupc++/Makefile.in b/libstdc++-v3/libsupc++/Makefile.in index a1cc257f807..20093c82afb 100644 --- a/libstdc++-v3/libsupc++/Makefile.in +++ b/libstdc++-v3/libsupc++/Makefile.in @@ -218,6 +218,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@ GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@ GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@ GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@ +GLIBCXX_LIBS = @GLIBCXX_LIBS@ GREP = @GREP@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ diff --git a/libstdc++-v3/po/Makefile.in b/libstdc++-v3/po/Makefile.in index 731c56f73cc..7b83a7d7272 100644 --- a/libstdc++-v3/po/Makefile.in +++ b/libstdc++-v3/po/Makefile.in @@ -148,6 +148,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@ GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@ GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@ GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@ +GLIBCXX_LIBS = @GLIBCXX_LIBS@ GREP = @GREP@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ diff --git a/libstdc++-v3/src/Makefile.am b/libstdc++-v3/src/Makefile.am index 6ea357f2ce9..cf4522fe28a 100644 --- a/libstdc++-v3/src/Makefile.am +++ b/libstdc++-v3/src/Makefile.am @@ -196,10 +196,14 @@ vpath % $(top_srcdir) libstdc___la_SOURCES = $(sources) libstdc___la_LIBADD = \ + $(GLIBCXX_LIBS) \ $(top_builddir)/libmath/libmath.la \ $(top_builddir)/libsupc++/libsupc++convenience.la -libstdc___la_DEPENDENCIES = ${version_dep} $(libstdc___la_LIBADD) +libstdc___la_DEPENDENCIES = \ + ${version_dep} \ + $(top_builddir)/libmath/libmath.la \ + $(top_builddir)/libsupc++/libsupc++convenience.la libstdc___la_LDFLAGS = \ -version-info $(libtool_VERSION) ${version_arg} -lm diff --git a/libstdc++-v3/src/Makefile.in b/libstdc++-v3/src/Makefile.in index 72c8bec693a..79811f45569 100644 --- a/libstdc++-v3/src/Makefile.in +++ b/libstdc++-v3/src/Makefile.in @@ -72,6 +72,7 @@ am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; am__installdirs = "$(DESTDIR)$(toolexeclibdir)" toolexeclibLTLIBRARIES_INSTALL = $(INSTALL) LTLIBRARIES = $(toolexeclib_LTLIBRARIES) +am__DEPENDENCIES_1 = am__libstdc___la_SOURCES_DIST = atomic.cc bitmap_allocator.cc \ pool_allocator.cc mt_allocator.cc codecvt.cc compatibility.cc \ complex_io.cc ctype.cc debug.cc functexcept.cc hash.cc \ @@ -205,6 +206,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@ GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@ GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@ GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@ +GLIBCXX_LIBS = @GLIBCXX_LIBS@ GREP = @GREP@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ @@ -431,10 +433,15 @@ sources = \ libstdc___la_SOURCES = $(sources) libstdc___la_LIBADD = \ + $(GLIBCXX_LIBS) \ + $(top_builddir)/libmath/libmath.la \ + $(top_builddir)/libsupc++/libsupc++convenience.la + +libstdc___la_DEPENDENCIES = \ + ${version_dep} \ $(top_builddir)/libmath/libmath.la \ $(top_builddir)/libsupc++/libsupc++convenience.la -libstdc___la_DEPENDENCIES = ${version_dep} $(libstdc___la_LIBADD) libstdc___la_LDFLAGS = \ -version-info $(libtool_VERSION) ${version_arg} -lm diff --git a/libstdc++-v3/testsuite/Makefile.in b/libstdc++-v3/testsuite/Makefile.in index 153e9092a0f..79703636c4b 100644 --- a/libstdc++-v3/testsuite/Makefile.in +++ b/libstdc++-v3/testsuite/Makefile.in @@ -152,6 +152,7 @@ GLIBCXX_HOSTED_TRUE = @GLIBCXX_HOSTED_TRUE@ GLIBCXX_INCLUDES = @GLIBCXX_INCLUDES@ GLIBCXX_LDBL_COMPAT_FALSE = @GLIBCXX_LDBL_COMPAT_FALSE@ GLIBCXX_LDBL_COMPAT_TRUE = @GLIBCXX_LDBL_COMPAT_TRUE@ +GLIBCXX_LIBS = @GLIBCXX_LIBS@ GREP = @GREP@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ |