diff options
| author | Jakub Jelinek <jakub@redhat.com> | 2008-06-03 11:31:30 +0000 |
|---|---|---|
| committer | Jakub Jelinek <jakub@redhat.com> | 2008-06-03 11:31:30 +0000 |
| commit | 773a92d2ea39e3331e42242d250f8546bdd447c4 (patch) | |
| tree | b4122aaed2225e893c275b3dd1a1b1508f5b87b9 | |
| parent | b525904898beb1c54f70cb512711513be2f53a92 (diff) | |
svn merge -r136014:136314 svn+ssh://gcc.gnu.org/svn/gcc/trunk/
git-svn-id: https://gcc.gnu.org/svn/gcc/branches/gomp-3_0-branch@136316 138bc75d-0d04-0410-961f-82ee72b054a4
337 files changed, 8302 insertions, 6808 deletions
diff --git a/ChangeLog b/ChangeLog index e52412498bd..0926f4e71c3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2008-05-30 Julian Brown <julian@codesourcery.com> + + * configure.ac (arm*-*-linux-gnueabi): Don't disable building + of libobjc for ARM EABI Linux. + * configure: Regenerate. 2008-05-18 Xinliang David Li <davidxl@google.com> diff --git a/configure b/configure index 92f62a34d7a..213befb5751 100755 --- a/configure +++ b/configure @@ -2309,7 +2309,6 @@ case "${target}" in ;; arm*-*-linux-gnueabi) noconfigdirs="$noconfigdirs target-qthreads" - noconfigdirs="$noconfigdirs target-libobjc" case ${with_newlib} in no) noconfigdirs="$noconfigdirs target-newlib target-libgloss" esac diff --git a/configure.ac b/configure.ac index 13a7cc1c092..3b443e5a509 100644 --- a/configure.ac +++ b/configure.ac @@ -563,7 +563,6 @@ case "${target}" in ;; arm*-*-linux-gnueabi) noconfigdirs="$noconfigdirs target-qthreads" - noconfigdirs="$noconfigdirs target-libobjc" case ${with_newlib} in no) noconfigdirs="$noconfigdirs target-newlib target-libgloss" esac diff --git a/gcc/ChangeLog b/gcc/ChangeLog index a6d1e210d1e..7f756464b05 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,524 @@ +2008-06-03 Kai Tietz <kai.tietz@onevision.com> + + * doc/tm.texi (OVERRIDE_ABI_FORMAT): New. + * doc/extend.texi (ms_abi,sysv_abi): New attribute description. + * function.c (allocate_struct_function): Use of + OVERRIDE_ABI_FORMAT. + * config/i386/cygming.h (TARGET_64BIT_MS_ABI): Make use + of cfun and DEFAULT_ABI to deceide abi mode. + (DEFAULT_ABI): New. + (REG_PARM_STACK_SPACE): Removed. + (OUTGOING_REG_PARM_STACK_SPACE): Removed. + (STACK_BOUNDARY): Use default target to deceide stack boundary. + * config/i386/i386-protos.h (ix86_cfun_abi): New. + (ix86_function_abi): Likewise. + (ix86_function_type_abi): Likewise. + (ix86_call_abi_override): Likewise. + * confid/i386/i386.md (SSE_REGPARM_MAX): Replaced by abi + specific define X86_64_SSE_REGPARM_MAX/X64_SSE_REGPARM_MAX. + * config/i386/i386.c (override_options): Replace TARGET_64BIT_MS_ABI. + (X86_64_VARARGS_SIZE): Replace REGPARM_MAX and SSE_REGPARM_MAX by abi + specific defines. + (X86_64_REGPARM_MAX): New. + (X86_64_SSE_REGPARM_MAX): New. + (X64_REGPARM_MAX): New. + (X64_SSE_REGPARM_MAX): New. + (X86_32_REGPARM_MAX): New. + (X86_32_SSE_REGPARM_MAX): New. + (ix86_handle_cconv_attribute): Replace TARGET_64BIT_MS_ABI. + (ix86_function_regparm): Handle user calling abi. + (ix86_function_arg_regno_p): Replace TARGET_64BIT_MS_ABI + by DEFAULT_ABI versus SYSV_ABI check. + (ix86_reg_parm_stack_space): New. + (ix86_function_type_abi): New. + (ix86_call_abi_override): New. + (ix86_function_abi): New. + (ix86_cfun_abi): New. + (init_cumulative_args): Call abi specific initialization. + (function_arg_advance): Remove TARGET_64BIT_MS_ABI. + (function_arg_64): Extend SSE_REGPARM_MAX check. + (function_arg (): Remove TARGET_64BIT_MS_ABI. + (ix86_pass_by_reference): Likewise. + (ix86_function_value_regno_p): Likewise. + (function_value_64): Replace REGPARM_MAX, and SSE_REGPARM_MAX. + (ix86_function_value_1): Replace TARGET_64BIT_MS_ABI. + (return_in_memory_ms_64): Replace TARGET_64BIT_MS_ABI. + (ix86_build_builtin_va_list): Replace TARGET_64BIT_MS_ABI. + (setup_incoming_varargs_64): Adjust regparm for call abi. + (ix86_setup_incoming_varargs): Replace TARGET_64BIT_MS_ABI. + (ix86_va_start): Likewise. + (ix86_gimplify_va_arg): Likewise. + (ix86_expand_prologue): Likewise. + (output_pic_addr_const): Likewise. + (ix86_init_machine_status): Initialize call_abi by DEFAULT_ABI. + (x86_this_parameter): Replace TARGET_64BIT_MS_ABI. + (x86_output_mi_thunk): Likewise. + (x86_function_profiler): Likewise. + * config/i386/i386.h (TARGET_64BIT_MS_ABI): Use ix64_cfun_abi. + (SYSV_ABI, MS_ABI): New constants. + (DEFAULT_ABI): New. + (init_regs): Add prototype of function in regclass.c file. + (OVERRIDE_ABI_FORMAT): New. + (CONDITIONAL_REGISTER_USAGE): Remove TARGET_64BIT_MS_ABI part. + (REG_PARM_STACK_SPACE): Use ix86_reg_parm_stack_space. + (OUTGOING_REG_PARM_STACK_SPACE): New. + (ix86_reg_parm_stack_space): New prototype. + (CUMULATIVE_ARGS): Add call_abi member. + (machine_function): Add call_abi member. + * config/i386/mingw32.h (EXTRA_OS_CPP_BUILTINS): Replace TARGET_64BIT_MS_ABI + by DEFAULT_ABI compare to MS_ABI. + +2008-06-02 Andy Hutchinson <hutchinsonandy@aim.com> + + PR target/34879 + * config/avr/avr.c (TARGET_BUILTIN_SETJMP_FRAME_VALUE): Redefine. + (avr_builtin_setjmp_frame_value): New function. + * config/avr/avr.md (nonlocal_goto_receiver): Define. + (nonlocal_goto): Define. + +2008-06-02 Richard Sandiford <rdsandiford@googlemail.com> + + * config/mips/mips.c (mips_emit_loadgp): Return early if + there is nothing do to, otherwise emit a blockage if + !TARGET_EXPLICIT_RELOCS || crtl->profile. + * config/mips/mips.md (loadgp_blockage): Use SI rather than DI. + +2008-06-02 Ralf Wildenhues <Ralf.Wildenhues@gmx.de> + + * configure.ac: Drop unneeded backslash ending up in config.in. + * acinclude.m4: Likewise. + * config.in: Regenerate. + +2008-05-26 Jan Hubicka <jh@suse.cz> + + * predict.c (maybe_hot_frequency_p): Break out of... + (maybe_hot_bb_p): ... here. + (maybe_hot_edge_p): New. + * tree-ssa-coalesce.c (coalesce_cost_edge): Compute cost based on edge. + * basic-block.h (maybe_hot_edge_p): Declare. + +2008-05-31 Uros Bizjak <ubizjak@gmail.com> + + * config/i386/i386.md (*cmpfp_<mode>): Enable for optimize_size. + (*cmpfp_<mode>_cc): Ditto. + (*fp_jcc_8<mode>_387): Ditto. + (*fop_<MODEF:mode>_2_i387): Ditto. + (*fop_<MODEF:mode>_3_i387): Ditto. + (*fop_xf_2_i387): Ditto. + (*fop_xf_3_i387): Ditto. + +2008-06-02 Tomas Bily <tbily@suse.cz> + + * tree-ssa-ifcombine.c (get_name_for_bit_test): Use CONVERT_EXPR_P. + +2008-06-01 Richard Sandiford <rdsandiford@googlemail.com> + + * config/mips/mips.c (mips_valid_offset_p): New function. + (mips_valid_lo_sum_p): Likewise. + (mips_classify_address): Use them. + (mips_force_address): New function. + (mips_legitimize_address): Use it. + * config/mips/mips.md (MOVE128): New mode iterator. + (movtf): Require TARGET_64BIT. Remove empty strings. + (*movtf_internal): Rename to... + (*movtf): ...this and require !TARGET_MIPS16. Use "m" instead + of "R" and use {,fp}{load,store} attributes instead of "multi". + Use a separate define_split. + (*movtf_mips16): New pattern. + +2008-06-01 Richard Sandiford <rdsandiford@googlemail.com> + + * config/mips/mips-protos.h (mips_expand_before_return): Declare. + * config/mips/mips.c (mips_expand_before_return): New function. + (mips_expand_epilogue): Call it. + * config/mips/mips.md (return): Turn into a define_expand. + (*return): New insn. + +2008-06-01 Richard Sandiford <rdsandiford@googlemail.com> + + * rtl.h (emit_clobber, gen_clobber, emit_use, gen_use): Declare. + * emit-rtl.c (emit_clobber, gen_clobber, emit_use, gen_use): New + functions. Do not emit uses and clobbers of CONCATs; individually + use and clobber their operands. + * builtins.c (expand_builtin_setjmp_receiver): Use emit_clobber, + gen_clobber, emit_use and gen_use. + (expand_builtin_longjmp, expand_builtin_nonlocal_goto): Likewise. + (expand_builtin_return): Likewise. + * cfgbuild.c (count_basic_blocks): Likewise. + * cfgrtl.c (rtl_flow_call_edges_add): Likewise. + * explow.c (emit_stack_restore): Likewise. + * expmed.c (extract_bit_field_1): Likewise. + * expr.c (convert_move, emit_move_complex_parts): Likewise. + (emit_move_multi_word, store_constructor): Likewise. + * function.c (do_clobber_return_reg, do_use_return_reg): Likewise. + (thread_prologue_and_epilogue_insns): Likewise. + * lower-subreg.c (resolve_simple_move): Likewise. + * optabs.c (widen_operand, expand_binop): Likewise. + (expand_doubleword_bswap, emit_no_conflict_block): Likewise. + * reload.c (find_reloads): Likewise. + * reload1.c (eliminate_regs_in_insn): Likewise. + * stmt.c (expand_nl_goto_receiver): Likewise. + * config/alpha/alpha.md (builtin_longjmp): Likewise. + * config/arc/arc.md (*movdi_insn, *movdf_insn): Likewise. + * config/arm/arm.c (arm_load_pic_register): Likewise. + (thumb1_expand_epilogue, thumb_set_return_address): Likewise. + * config/arm/arm.md (untyped_return): Likewise. + * config/arm/linux-elf.h (PROFILE_HOOK): Likewise. + * config/avr/avr.c (expand_prologue): Likewise. + * config/bfin/bfin.c (do_unlink): Likewise. + * config/bfin/bfin.md (<optab>di3, adddi3, subdi3): Likewise. + * config/cris/cris.c (cris_expand_prologue): Likewise. + * config/darwin.c (machopic_indirect_data_reference): Likewise. + (machopic_legitimize_pic_address): Likewise. + * config/frv/frv.c (frv_frame_access, frv_expand_epilogue): Likewise. + (frv_ifcvt_modify_insn, frv_expand_mdpackh_builtin): Likewise. + * config/i386/i386.c (ix86_expand_vector_move_misalign): Likewise. + (ix86_expand_convert_uns_didf_sse): Likewise. + (ix86_expand_vector_init_general): Likewise. + * config/ia64/ia64.md (eh_epilogue): Likewise. + * config/iq2000/iq2000.c (iq2000_expand_epilogue): Likewise. + * config/m32c/m32c.c (m32c_emit_eh_epilogue): Likewise. + * config/m32r/m32r.c (m32r_reload_lr): Likewise. + (config/iq2000/iq2000.c): Likewise. + * config/mips/mips.md (fixuns_truncdfsi2): Likewise. + (fixuns_truncdfdi2, fixuns_truncsfsi2, fixuns_truncsfdi2): Likewise. + (builtin_longjmp): Likewise. + * config/mn10300/mn10300.md (call, call_value): Likewise. + * config/pa/pa.md (nonlocal_goto, nonlocal_longjmp): Likewise. + * config/pdp11/pdp11.md (abshi2): Likewise. + * config/rs6000/rs6000.c (rs6000_emit_move): Likewise. + * config/s390/s390.c (s390_emit_prologue): Likewise. + * config/s390/s390.md (movmem_long, setmem_long): Likewise. + (cmpmem_long, extendsidi2, zero_extendsidi2, udivmoddi4): Likewise. + (builtin_setjmp_receiver, restore_stack_nonlocal): Likewise. + * config/sh/sh.c (prepare_move_operands): Likewise. + (output_stack_adjust, sh_expand_epilogue): Likewise. + (sh_set_return_address, sh_expand_t_scc): Likewise. + * config/sparc/sparc.c (load_pic_register): Likewise. + * config/sparc/sparc.md (untyped_return, nonlocal_goto): Likewise. + * config/spu/spu.c (spu_expand_epilogue): Likewise. + * config/v850/v850.c (expand_epilogue): Likewise. + +2008-05-31 Anatoly Sokolov <aesok@post.ru> + + * config/avr/avr.md (UNSPECV_WRITE_SP_IRQ_ON): New constants. + (UNSPECV_WRITE_SP_IRQ_OFF): (Ditto.). + (movhi_sp_r_irq_off, movhi_sp_r_irq_on): New insn. + * config/avr/avr.c (expand_prologue, expand_epilogue): Use + movhi_sp_r_irq_off and movhi_sp_r_irq_on insns for writing to the + stack pointer register. + (output_movhi): Remove code for interrupt specific writing to the + stack pointer register. + +2008-05-31 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/34244 + * fold-const.c (tree_expr_nonnegative_warnv_p): Do not ask VRP. + (tree_expr_nonzero_warnv_p): Likewise. + * tree-vrp.c (vrp_expr_computes_nonnegative): Call + ssa_name_nonnegative_p. + (vrp_expr_computes_nonzero): Call ssa_name_nonzero_p. + (extract_range_from_unary_expr): Use vrp_expr_computes_nonzero, + not tree_expr_nonzero_warnv_p. + + PR tree-optimization/36262 + Revert + 2007-11-29 Zdenek Dvorak <ook@ucw.cz> + + PR tree-optimization/34244 + * tree-vrp.c (adjust_range_with_scev): Clear scev cache. + (record_numbers_of_iterations): New function. + (execute_vrp): Cache the numbers of iterations of loops. + * tree-scalar-evolution.c (scev_reset_except_niters): + New function. + (scev_reset): Use scev_reset_except_niters. + * tree-scalar-evolution.h (scev_reset_except_niters): Declare. + +2008-05-31 Bernd Schmidt <bernd.schmidt@analog.com> + + * config/bfin/bfin.h (TARGET_CPU_CPP_BUILTINS): Define + __WORKAROUND_RETS when appropriate. + +2008-05-31 Uros Bizjak <ubizjak@gmail.com> + + * config/i386/i386.md (*fop_<mode>_comm_mixed): Macroize from + *fop_sf_comm_mixed and *fop_df_comm_mixed insn patterns using MODEF + mode iterator. + (*fop_<mode>_comm_sse): Macroize from *fop_sf_comm_sse and + *fop_df_comm_sse insn patterns using MODEF mode iterator. + (*fop_<mode>_comm_i387): Macroize from *fop_sf_comm_i387 and + *fop_df_comm_i387 insn patterns using MODEF mode iterator. + (*fop_<mode>_1_mixed): Macroize from *fop_sf_1_mixed and + *fop_df_1_mixed insn patterns using MODEF mode iterator. + (*fop_<mode>_1_sse): Macroize from *fop_sf_1_sse and + *fop_df_1_sse insn patterns using MODEF mode iterator. + (*fop_<mode>_1_i387): Macroize from *fop_sf_1_i387 and + *fop_df_1_i387 insn patterns using MODEF mode iterator. + (*fop_<MODEF:mode>_2_i387): Macroize from *fop_sf_2<mode>_i387 and + *fop_df_2<mode>_i387 insn patterns using MODEF mode iterator. + (*fop_<MODEF:mode>_3_i387): Macroize from *fop_sf_3<mode>_i387 and + *fop_df_3<mode>_i387 insn patterns using MODEF mode iterator. + (*fop_xf_2_i387): Rename from *fop_xf_2<mode>_i387. + (*fop_xf_3_i387): Rename from *fop_xf_3<mode>_i387. + (*fop_xf_4_i387): Use <MODE> for mode attribute. + (*fop_xf_5_i387): Ditto. + (*fop_xf_6_i387): Ditto. + +2008-05-30 Richard Guenther <rguenther@suse.de> + + * builtins.c (build_string_literal): Avoid generating + a non-gimple_val result. + +2008-05-30 DJ Delorie <dj@redhat.com> + + * exec-tool.in: Use an environment variable (private) instead of a + file (shared) as a semaphore, so as to not break parallel builds. + +2008-05-30 Steven Bosscher <stevenb.gcc@gmail.com> + + * optabs.c (maybe_encapsulate_block): Remove. + (emit_libcall_block): Adjust accordingly. + * optabs.h (maybe_encapsulate_block): Remove prototype. + + * config/rs6000/rs6000.c (rs6000_legitimize_tls_address): + Don't use maybe_encapsulate_block. + +2008-05-30 Steven Bosscher <stevenb.gcc@gmail.com> + + * config/rs6000/rs6000.c (rs6000_legitimize_address, + rs6000_legitimize_reload_address, rs6000_emit_move): Make sure an + rtx is a SYMBOL_REF before calling get_pool_constant. + +2008-05-30 Eric Botcazou <ebotcazou@adacore.com> + + * fold-const.c (fold_unary) <CASE_CONVERT>: Add ??? comment. + +2008-05-30 Danny Smith <dannysmith@users.sourceforge.net> + + * incpath.c: Use HOST_LACKS_INODE_NUMBERS conditional + rather than OS names to choose INO_T_EQ definition. + (DIRS_EQ) [!INO_T_EQ]: Don't worry about case in comparison. + (add_path) [!INO_T_EQ]: Use lrealpath to fill canonical_name field. + +2008-05-29 Daniel Franke <franke.daniel@gmail.com> + + PR target/36348 + * config/darwin-f.c: New. + * config/t-darwin: Added rule to build darwin-f.o. + * config.gcc: Defined new variable, fortran_target_objs. + (*-*-darwin*): Set fortran_target_objs. + * Makefile.in: Defined new variable FORTRAN_TARGET_OBJS. + * configure.ac: Substitute fortran_target_objs, set FORTRAN_TARGET_OBJS. + * configure: Regenerated. + +2008-05-29 H.J. Lu <hongjiu.lu@intel.com> + + PR target/35771 + * config/i386/i386.c (ix86_function_arg_boundary): Convert to + canonical type if needed. + +2008-05-29 Eric Botcazou <ebotcazou@adacore.com> + + * tree-nested.c (check_for_nested_with_variably_modified): Fix typo. + +2008-05-29 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/36343 + PR tree-optimization/36346 + PR tree-optimization/36347 + * tree-flow.h (clobber_what_p_points_to): Declare. + * tree-ssa-structalias.c (set_uids_in_ptset): Whether the + pointed-to variable is dereferenced is irrelevant to whether + the pointer can access the pointed-to variable. + (clobber_what_p_points_to): New function. + * tree-ssa-alias.c (set_initial_properties): Use it. + * tree-ssa.c (verify_flow_sensitive_alias_info): Adjust + call clobber check for NMTs. + +2008-05-28 Seongbae Park <seongbae.park@gmail.com> + + * value-prof.c (tree_ic_transform): Use HOST_WIDEST_INT_PRINT_DEC + for printing gcov_type. + +2008-05-28 Seongbae Park <seongbae.park@gmail.com> + + * tree-ssa-propagate.c (set_rhs): Preserve the histogram + and the eh region information. + * value-prof.c (gimple_move_stmt_histograms): New function. + * value-prof.h (gimple_move_stmt_histograms): New function declaration. + +2008-05-28 Andreas Tobler <a.tobler@schweiz.org> + + * config/pa/pa.md: Remove extern frame_pointer_needed declaration. + +2008-05-28 Seongbae Park <seongbae.park@gmail.com> + + * value-prof.c (tree_ic_transform): Print counts. + * tree-profile.c (tree_gen_ic_func_profiler): + Clear __gcov_indreict_call_callee variable to avoid misattribution + of the profile. + +2008-05-28 Rafael Espindola <espindola@google.com> + + * see.c (see_def_extension_not_merged): Use copy_rtx_if_shared to avoid + invalid sharing. + +2008-05-28 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/36339 + * tree-ssa-alias.c (set_initial_properties): Move pt_anything + and clobbering code out of the loop. + +2008-05-28 Andreas Krebbel <krebbel1@de.ibm.com> + + * config/s390/constraints.md ('b', 'C', 'D', 'e'): New constraint + letters defined. + + * config/s390/s390.c (s390_compare_and_branch_condition_mask, + s390_contiguous_bitmask_p, s390_symref_operand_p, + s390_check_symref_alignment, s390_reload_larl_operand, + s390_reload_symref_address): New functions. + (s390_branch_condition_mnemonic): Support compare and branch + instructions. + (s390_mem_constraint): Avoid symrefs to accepted by the 'T' + and 'W' constraints. + (s390_secondary_reload): Add secondary reloads for unaligned + symbol refs or symbol refs to floating point or QI/TI mode + integer values. + (legitimate_address_p): Accept symbol references as addresses. + (s390_expand_insv): Use rotate and insert selected bits + instruction for insv when building for z10. + (print_operand_address): Handle symbol ref addresses. + (print_operand): Output modifier 'c' added for signed byte values. + (s390_encode_section_info): Mark symbol refs with + SYMBOL_FLAG_NOT_NATURALLY_ALIGNED if appropriate. + + * config/s390/s390.md (SIL,RRS,RIS): New instruction formats added. + (length attribute): RRF, RRR have 4 byte length. + (FPALL, INTALL): New mode iterators added. + (*tstdi_sign, *cmpdi_ccs_sign, *cmpsi_ccs_sign, + *cmp<mode>_ccs, *cmpdi_ccu_zero, *cmpdi_ccu, *cmpsi_ccu, *cmphi_ccu, + *movdi_64, *movsi_zarch, *movhi, movmem<mode>, *movmem_short, + *extendsidi2, *extendhidi2_extimm, *extendhisi2_extimm, + *zero_extendsidi2, adddi3, *adddi3_31z, *adddi3_31, addsi3, + *add<mode>3, *add<mode>3_carry1_cc, *add<mode>3_carry2_cc, + *add<mode>3_cc, *add<mode>3_imm_cc, *muldi3_sign, muldi3, + *mulsi3_sign, mulsi3, mulsidi3): Patterns enhanced with z10 + instructions. + (*cmphi_ccs_z10, *cmpdi_ccs_signhi_rl, *cmpsi_ccu_zerohi_rlsi, + *cmp<GPR:mode>_ccu_zerohi_rldi, *cmp_and_br_signed_<mode>, + *cmp_and_br_unsigned_<mode>, reload<INTALL:mode><P:mode>_tomem_z10, + reload<INTALL:mode><P:mode>_toreg_z10, + reload<FPALL:mode><P:mode>_tomem_z10, + reload<FPALL:mode><P:mode>_toreg_z10, + reload<P:mode>_larl_odd_addend_z10, *execute_rl, *insv<mode>_z10, + *insv<mode>_z10_noshift, *insv<mode>_or_z10_noshift, + *zero_extendhi<mode>2_z10, *cmp_and_trap_signed_int<mode>, + *cmp_and_trap_unsigned_int<mode>, prefetch): New pattern or expander + definition. + (movmem, clrmem, cmpmem): New splitters added. + + * config/s390/predicates.md (larl_operand): Use + SYMBOL_REF_FLAGS (op) & SYMBOL_FLAG_ALIGN1 replaced with + SYMBOL_REF_ALIGN1_P. + (s390_signed_integer_comparison, + s390_unsigned_integer_comparison): New predicates. + + * config/s390/s390-protos.h (s390_check_symref_alignment, + s390_contiguous_bitmask_p, s390_reload_larl_operand, + s390_reload_symref_address, + s390_compare_and_branch_condition_mask): Prototypes added. + + * config/s390/s390.h (TARGET_MEM_CONSTRAINT, + SYMBOL_REF_ALIGN1_P, SYMBOL_FLAG_NOT_NATURALLY_ALIGNED, + SYMBOL_REF_NOT_NATURALLY_ALIGNED_P): Macro definition added. + +2008-05-28 Andreas Krebbel <krebbel1@de.ibm.com> + + * config/s390/s390.c (z10_cost): New cost function for z10. + (s390_handle_arch_option, override_options): Support -march=z10 switch. + (s390_issue_rate): Adjust issue rate for z10. + * config/s390/s390.h (processor_type): Add PROCESSOR_2097_Z10. + (processor_flags): Add PF_Z10. + (TARGET_CPU_Z10, TARGET_Z10): New macro definitions. + * config/s390/s390.md (cpu, cpu_facility attributes): Add z10. + * gcc/config.gcc: Add z10. + +2008-05-28 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/36291 + * tree-flow. h (struct gimple_df): Remove var_anns member. + * tree-flow-inline.h (gimple_var_anns): Remove. + (var_ann): Simplify. + * tree-dfa.c (create_var_ann): Simplify. + (remove_referenced_var): Clear alias info from var_anns of globals. + * tree-ssa.c (init_tree_ssa): Do not allocate var_anns. + (delete_tree_ssa): Clear alias info from var_anns of globals. + Do not free var_anns. + (var_ann_eq): Remove. + (var_ann_hash): Likewise. + +2008-05-28 Mark Shinwell <shinwell@codesourcery.com> + + * config/mips/mips.c (mips_cpu_info_table): Add loongson2e + and loongson2f entries. + (mips_rtx_cost_data): Add entries for Loongson-2E/2F. + * config/mips/mips.h (processor_type): Add Loongson-2E + and Loongson-2F entries. + (TARGET_LOONGSON_2E, TARGET_LOONGSON_2F, TARGET_LOONGSON_2EF): New. + (MIPS_ISA_LEVEL_SPEC): Handle Loongson-2E/2F. + * config/mips/mips.md (define_attr cpu): Add loongson2e and loongson2f. + * doc/invoke.texi (MIPS Options): Document loongson2e + and loongson2f processor names. + +2008-05-27 H.J. Lu <hongjiu.lu@intel.com> + + PR target/35767 + PR target/35771 + * config/i386/i386.c (ix86_function_arg_boundary): Use + alignment of canonical type. + (ix86_expand_vector_move): Check unaligned memory access for + all SSE modes. + +2008-05-27 H.J. Lu <hongjiu.lu@intel.com> + + * dwarf2out.c (current_fde): Change return type to dw_fde_ref. + Moved to the front of file. + +2008-05-27 Xuepeng Guo <xuepeng.guo@intel.com> + H.J. Lu <hongjiu.lu@intel.com> + + * dwarf2out.c (current_fde): New. + (add_cfi): Use it. + (lookup_cfa:): Likewise. + (dwarf2out_end_epilogue): Likewise. + (dwarf2out_note_section_used): Likewise. + +2008-05-27 Michael Matz <matz@suse.de> + + PR c++/27975 + * c.opt (Wenum-compare): New warning option. + * doc/invoke.texi (Warning Options): Document -Wenum-compare. + +2008-05-27 Michael Matz <matz@suse.de> + + PR middle-end/36326 + * tree-gimple.c (is_gimple_mem_rhs): Remove work-around for + non-BLKmode types. + * tree-tailcall.c (find_tail_calls): Don't mark calls storing + into memory as tail calls. + +2008-05-27 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/36339 + * tree-ssa-alias.c (set_initial_properties): Escaped pt_anything + pointers cause all addressable variables to be call clobbered. + +2008-05-27 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/36245 + * tree-ssa-address.c (add_to_parts): Deal with non-pointer bases. + 2008-05-27 Andreas Krebbel <krebbel1@de.ibm.com> * config/s390/s390.md: Replace all occurences of the 'm' @@ -24,8 +545,7 @@ alternatives according to the "enabled" attribute * recog.h (struct recog_data): New field alternative_enabled_p. (skip_alternative): New inline function. - * regclass.c: (record_operand_costs): Check the "enabled" - attribute. + * regclass.c: (record_operand_costs): Check the "enabled" attribute. (record_reg_classes): Skip alternative according to the "enabled" attribute. @@ -39,15 +559,12 @@ * recog.c (asm_operand_ok, preprocess_constraints, constrain_operands): Likewise. * regclass.c (record_reg_classes): Likewise. - * reload.c (find_reloads, alternative_allows_const_pool_ref): - Likewise. + * reload.c (find_reloads, alternative_allows_const_pool_ref): Likewise. * reload1.c (maybe_fix_stack_asms): Likewise. - * stmt.c (parse_output_constraint, parse_input_constraint): - Likewise. + * stmt.c (parse_output_constraint, parse_input_constraint): Likewise. * recog.h: Adjust comment. * genpreds.c (generic_constraint_letters): Remove 'm' constraint. - * genoutput.c (note_constraint): Don't emit error for 'm' - constraint. + * genoutput.c (note_constraint): Don't emit error for 'm' constraint. * doc/md.texi: Add a note to description of 'm' constraint. * doc/tm.texi: Document the new TARGET_MEM_CONSTRAINT macro. @@ -94,7 +611,7 @@ (cgraph_decide_inlining_incrementally): Likewise. 2008-05-26 Tristan Gingold <gingold@adacore.com> - Anatoly Sokolov <aesok@post.ru> + Anatoly Sokolov <aesok@post.ru> * config/avr/avr.md ("call_prologue_saves"): Use hi8(gs())/lo8(gs()) instead of pm_lo8/pm_hi8 to makes this call working on avr6. @@ -109,29 +626,22 @@ 2008-05-26 Richard Guenther <rguenther@suse.de> * tree-ssa-sccvn.c (expr_has_constants): Declare. - (visit_reference_op_load): Initialize VN_INFO->has_constants - properly. + (visit_reference_op_load): Initialize VN_INFO->has_constants properly. 2008-05-26 H.J. Lu <hongjiu.lu@intel.com> PR middle-end/36253 - * caller-save.c (insert_restore): Verify alignment of spill - space. + * caller-save.c (insert_restore): Verify alignment of spill space. (insert_save): Likewise. - * cfgexpand.c (LOCAL_ALIGNMENT): Removed. - * defaults.h (LOCAL_ALIGNMENT): New. Provide default. (STACK_SLOT_ALIGNMENT): Likewise. - * function.c (LOCAL_ALIGNMENT): Removed. (get_stack_local_alignment): New. (assign_stack_local): Use it. Set alignment on stack slot. (assign_stack_temp_for_type): Use get_stack_local_alignment. - * config/i386/i386.h (LOCAL_ALIGNMENT): Updated. (STACK_SLOT_ALIGNMENT): New. - * config/i386/i386.c (ix86_local_alignment): Handle caller-save stack slot in XFmode. @@ -161,7 +671,7 @@ 2008-05-25 Eric Botcazou <ebotcazou@adacore.com> - * tree-nested.c (convert_tramp_reference) <ADDR_EXPR>: Do not + * tree-nested.c (convert_tramp_reference) <ADDR_EXPR>: Do not build a trampoline if we don't want one. * varasm.c (initializer_constant_valid_p) <ADDR_EXPR>: Do not return zero for nested functions if we don't want a trampoline. @@ -250,9 +760,8 @@ 2008-05-24 Richard Guenther <rguenther@suse.de> - * tree-dfa.c (refs_may_alias_p): Re-instantiate case that - a scalar variable can be only accessed through a pointer - or a union. + * tree-dfa.c (refs_may_alias_p): Re-instantiate case that a scalar + variable can be only accessed through a pointer or a union. 2008-05-24 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> @@ -282,10 +791,8 @@ * target.h (gcc_target): Add allocate_stack_slots_for_args. * function.c (use_register_for_decl): Use targetm.calls.allocate_stack_slots_for_args. - * target-def.h (TARGET_CALLS): Add - TARGET_ALLOCATE_STACK_SLOTS_FOR_ARGS. - * config/arm/arm.c (arm_allocate_stack_slots_for_args): - New function. + * target-def.h (TARGET_CALLS): Add TARGET_ALLOCATE_STACK_SLOTS_FOR_ARGS. + * config/arm/arm.c (arm_allocate_stack_slots_for_args): New function. (TARGET_ALLOCATE_STACK_SLOTS_FOR_ARGS): Define. 2008-05-23 Eric Botcazou <ebotcazou@adacore.com> @@ -300,8 +807,7 @@ 2008-05-23 Richard Guenther <rguenther@suse.de> - * tree-ssa-operands.c (mark_difference_for_renaming): Use - bitmap_xor. + * tree-ssa-operands.c (mark_difference_for_renaming): Use bitmap_xor. 2008-05-23 Uros Bizjak <ubizjak@gmail.com> Jakub Jelinek <jakub@redhat.com> @@ -324,8 +830,8 @@ * doc/install.texi (Options specification): Document --enable-cld. * doc/invoke.texi (Machine Dependent Options) - [i386 and x86-64 Options]: Add -mcld option. - (Intel 386 and AMD x86-64 Options): Document -mcld option. + [i386 and x86-64 Options]: Add -mcld option. + (Intel 386 and AMD x86-64 Options): Document -mcld option. 2008-05-23 Kai Tietz <kai.tietz@onevison.com> * config/i386/i386.c (return_in_memory_32): Add ATTRIBUTE_UNUSED. @@ -564,16 +1070,15 @@ parameter. * config/mips/mips.h (MIPS_COMPARE_AND_SWAP_12): Add OPS parameter. (MIPS_COMPARE_AND_SWAP_12_0): Delete macro. - (MIPS_COMPARE_AND_SWAP_12_ZERO_OP, - MIPS_COMPARE_AND_SWAP_12_NONZERO_OP, + (MIPS_COMPARE_AND_SWAP_12_ZERO_OP, MIPS_COMPARE_AND_SWAP_12_NONZERO_OP, MIPS_SYNC_OP_12, MIPS_SYNC_OP_12_NOT_NOP, MIPS_SYNC_OP_12_NOT_NOT, MIPS_SYNC_OLD_OP_12, MIPS_SYNC_OLD_OP_12_NOT_NOP, MIPS_SYNC_OLD_OP_12_NOT_NOP_REG, MIPS_SYNC_OLD_OP_12_NOT_NOT, MIPS_SYNC_OLD_OP_12_NOT_NOT_REG, MIPS_SYNC_NEW_OP_12, MIPS_SYNC_NEW_OP_12_NOT_NOP, MIPS_SYNC_NEW_OP_12_NOT_NOT, MIPS_SYNC_EXCHANGE_12, - MIPS_SYNC_EXCHANGE_12_ZERO_OP, - MIPS_SYNC_EXCHANGE_12_NONZERO_OP): New macros. + MIPS_SYNC_EXCHANGE_12_ZERO_OP, MIPS_SYNC_EXCHANGE_12_NONZERO_OP): + New macros. 2008-05-20 H.J. Lu <hongjiu.lu@intel.com> @@ -735,8 +1240,8 @@ * config/i386/i386.c (ix86_expand_vector_init_concat): New. (ix86_expand_vector_init_interleave): Likewise. - (ix86_expand_vector_init_general): Use them. Assert word_mode - == SImode when n_words == 4. + (ix86_expand_vector_init_general): Use them. Assert + word_mode == SImode when n_words == 4. 2008-05-19 Uros Bizjak <ubizjak@gmail.com> diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 088da966f17..e58334c1e1f 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20080527 +20080603 diff --git a/gcc/Makefile.in b/gcc/Makefile.in index 64ea8cd834a..3e032df293f 100644 --- a/gcc/Makefile.in +++ b/gcc/Makefile.in @@ -970,6 +970,9 @@ C_TARGET_OBJS=@c_target_objs@ # Target specific, C++ specific object file CXX_TARGET_OBJS=@cxx_target_objs@ +# Target specific, Fortran specific object file +FORTRAN_TARGET_OBJS=@fortran_target_objs@ + # Object files for gcc driver. GCC_OBJS = gcc.o opts-common.o gcc-options.o diff --git a/gcc/acinclude.m4 b/gcc/acinclude.m4 index 70322c75e6b..9f865ee28d4 100644 --- a/gcc/acinclude.m4 +++ b/gcc/acinclude.m4 @@ -347,7 +347,7 @@ if test $gcc_cv_c_nbby = failed; then AC_MSG_ERROR(cannot determine number of bits in a byte) else AC_DEFINE_UNQUOTED(CHAR_BIT, $gcc_cv_c_nbby, - [Define as the number of bits in a byte, if \`limits.h' doesn't.]) + [Define as the number of bits in a byte, if `limits.h' doesn't.]) fi fi]) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7f702ff4bde..48aee98d33b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,244 @@ +2008-05-29 Thomas Quinot <quinot@adacore.com> + + * sem_eval.adb: Minor reformatting + +2008-05-29 Ed Schonberg <schonberg@adacore.com> + + * sem_ch6.adb (Analyze_Subprogram_Specification): if the return type + is abstract, do not apply abstractness check on subprogram if this is + a renaming declaration. + +2008-05-29 Arnaud Charlet <charlet@adacore.com> + + PR ada/864 + * osint.ads, osint.adb (Program_Name): New parameter "Prog" to + allow recognition of program suffix in addition to prefix. + + * gnatchop.adb (Locate_Executable): Add support for prefix. + + * make.adb, gnatcmd.adb, gnatlink.adb, prj-makr.adb, + mlib-utl.adb: Adjust calls to Program_Name. + +2008-05-29 Robert Dewar <dewar@adacore.com> + + * sem_ch3.adb: Minor reformatting + * sem_prag.adb: Minor reformatting + * sem_res.adb: Minor reformatting + * sinput-p.ads: Minor reformatting + +2008-05-29 Javier Miranda <miranda@adacore.com> + + * sem_util.adb: + (Abstract_Interface_List): Add missing support for full type-declaration + associated with synchronized types. + +2008-05-29 Robert Dewar <dewar@adacore.com> + + * sem_eval.adb (Is_Same_Value): Take care of several more cases + +2008-05-28 Ed Schonberg <schonberg@adacore.com> + + * sem_ch5.adb (Analyze_Assignment): If the name is of a local anonymous + access type, wrap the expression in a conversion to force an + accessibility check. + + * sem_aggr.adb (Aggegate_Constraint_Checks): Apply conversion to force + accessibility checks even when expansion is disabled in order to + generate messages in the presence of previous errors or in + semantics-only mode. + +2008-05-28 Eric Botcazou <ebotcazou@adacore.com> + + * system-lynxos-ppc.ads (Always_Compatible_Rep): Set to False. + * system-lynxos-x86.ads (Always_Compatible_Rep): Set to False. + +2008-05-28 Vincent Celier <celier@adacore.com> + + PR ada/34446 + * gnat_ugn.texi: Document restriction introduced on 2007-04-20 in + preprocessing expressions + +2008-05-28 Vincent Celier <celier@adacore.com> + + * sinput-p.adb (Source_File_Is_Subunit): Allow special character used + for preprocessing + + * sinput-p.ads: Minor comment update and reformatting + +2008-05-28 Ed Schonberg <schonberg@adacore.com> + + * sem_res.adb (Valid_Conversion): An anonymous access_to_subprogram + type has a deeper level than any master only when it is the type of an + access parameter. + +2008-05-28 Javier Miranda <miranda@adacore.com> + + * sem_ch3.adb (Derive_Progenitor_Subprograms): Add documentation. + +2008-05-28 Javier Miranda <miranda@adacore.com> + + * sem_util.ads (Find_Overridden_Synchronized_Primitive): Removed. + * sem_util.adb (Find_Overridden_Synchronized_Primitive): Removed. + * sem_ch6.adb (Check_Synchronized_Overriding): Remove one formal. + Add code that was previously located in + Find_Overridden_Synchronized_Primitive because it is only used here. + +2008-05-28 Sergey Rybin <rybin@adacore.com> + + * sem_prag.adb (Process_Extended_Import_Export_Subprogram_Pragma): Set + Entity field for formal_parameter_NAME in MECHANISM_ASSOCIATION. + +2008-05-28 Robert Dewar <dewar@adacore.com> + + * restrict.ads: + Add missing restrictions, and properly label all GNAT defined ones + + * rtsfind.ads: + Add entry for Ada_Real_Time.Timing_Events.Timing_Event + Add entry for Ada.Task_Termination.Set_Specific_Handler + Add entry for Ada.Task_Termination.Specific_Handler + + * s-rident.ads: + Add missing restrictions and properly mark all gnat defined ones + + * sem_ch3.adb: + (Analyze_Object_Declaration): Check No_Local_Timing_Events restriction + + * sem_res.adb: + (Resolve_Call): Check violation of No_Specific_Termination_Handlers + + * gnat_rm.texi: Add missing restrictions, and properly label all + GNAT defined ones + +2008-05-28 Robert Dewar <dewar@adacore.com> + + * restrict.adb: + (Check_Restriction): violation of restriction No_Finalization is + treated as a serious error to stop expansion + +2008-05-28 Robert Dewar <dewar@adacore.com> + + * exp_util.adb: Minor reformatting + * exp_util.ads: Minor reformatting. + +2008-05-28 Arnaud Charlet <charlet@adacore.com> + + * Make-lang.in: Remove gprmake. + + * gprmake.adb, makegpr.ads, makegpr.adb: Removed. + +2008-05-28 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Diagnose_Interface): Cleanup error messages involving + improper progenitor names, and avoid cascaded errors. + +2008-05-28 Robert Dewar <dewar@adacore.com> + + * gnat_rm.texi: Add note on Old giving warning when applied to constant + + * sem_attr.adb (Analyze_Attribute, case Old): Give warning if prefix is + a constant + +2008-05-28 Robert Dewar <dewar@adacore.com> + + * exp_fixd.adb (Build_Multiply): Correct one-off error in computing + size + +2008-05-28 Robert Dewar <dewar@adacore.com> + + * exp_ch5.adb: + (Expand_Simple_Function_Return): Copy unaligned result into temporary + +2008-05-28 Javier Miranda <miranda@adacore.com> + + * sem_ch3.adb (Derive_Progenitor_Primitives): Add missing support + for user-defined predefined primitives. + + * sem_util.adb (Matches_Prefixed_View_Profile): Ditto. + (Find_Overridden_Synchronized_Primitive): Ditto. + + * sem_ch6.adb (Check_Synchronized_Overriding): Ditto. + +2008-05-27 Arnaud Charlet <charlet@adacore.com> + + * a-ststio.adb, s-direio.adb: + Further code clean up of previous change. + Update comments. + +2008-05-27 Vincent Celier <celier@adacore.com> + + * prj-nmsc.adb: Minor reformatting + +2008-05-27 Bob Duff <duff@adacore.com> + + * sem_ch3.adb (Build_Incomplete_Type_Declaration): In the case of an + untagged private type with a tagged full type, where the full type has + a self reference, create the corresponding class-wide type early, in + case the self reference is "access T'Class". + +2008-05-27 Ed Schonberg <schonberg@adacore.com> + + * exp_aggr.adb (Build_Array_Aggr_Code): If component type includes + tasks and context is an object declaration. create master entity before + expansion. + +2008-05-27 Robert Dewar <dewar@adacore.com> + + * mlib-prj.adb: Minor reformatting + + * prj-part.adb: Minor reformatting + + * prj.ads: Minor reformatting + + * exp_ch3.adb: Minor reformatting. + + * sem_ch3.ads: Minor reformatting + + * sem_eval.adb: Minor reformatting + +2008-05-27 Vincent Celier <celier@adacore.com> + + * gnatcmd.adb: + <prefix>-gnat stack spawns gnatstack, not <prefix>-gnatstack + +2008-05-27 Ed Schonberg <schonberg@adacore.com> + + * exp_aggr.adb (Expand_Array_Aggregate): If the aggregate contains + tasks, create an activation chain now, before the expansion into + assignments and build-in-place calls that require the presence of an + activation chain. + (Backend_Processing_Possible): If the component type is inherently + limited, the aggregate must be expanded into individual built-in-place + assignments. + + * sem_ch6.adb (Build_Extra_Formals): Use underlying type of result to + determine whether an allocation extra parameter must be built, to + handle case of a private type whose full type is a discriminated type + with defaults. + +2008-05-27 Bob Duff <duff@adacore.com> + + * gnat_rm.texi: + Document the new behavior regarding trampolines. + +2008-05-27 Arnaud Charlet <charlet@adacore.com> + + * a-direio.adb, a-sequio.adb: Replace address clause by + unrestricted_access, simpler and compatible with .NET. + +2008-05-27 Vincent Celier <celier@adacore.com> + + * prj-part.adb: + (Project_Path_Name_Of.Try_Path): Do not use Locate_Regular_File to find + a project file, so that symbolic links are not resolved. + +2008-05-27 Arnaud Charlet <charlet@adacore.com> + + * a-ztexio.adb, a-textio.adb, a-witeio.adb, s-direio.adb: + Replace heavy address clause by 'Unrestricted_Access, cleaner and more + portable across GNAT targets, since this kind of address clause is not + supported by VM back-ends (.NET/JGNAT). + 2008-05-27 Arnaud Charlet <charlet@adacore.com> * bindgen.adb: Update comments. diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in index df7682c20b2..a7617ae3968 100644 --- a/gcc/ada/Make-lang.in +++ b/gcc/ada/Make-lang.in @@ -378,10 +378,6 @@ ada.all.cross: then \ $(MV) gnatsym$(exeext) gnatsym-cross$(exeext); \ fi - -if [ -f gprmake$(exeext) ] ; \ - then \ - $(MV) gprmake$(exeext) gprmake-cross$(exeext); \ - fi ada.start.encap: ada.rest.encap: @@ -497,7 +493,7 @@ doc/gnat-style.pdf: ada/gnat-style.texi $(gcc_docdir)/include/fdl.texi # and also as either gnatbind (if native) or $(tooldir)/bin/gnatbind # likewise for gnatf, gnatchop, and gnatlink, gnatkr, gnatmake, gnat, # gnatprep, gnatls, gnatxref, gnatfind, gnatname, gnatclean, -# gnatsym, gprmake +# gnatsym ada.install-common: $(MKDIR) $(DESTDIR)$(bindir) -if [ -f gnat1$(exeext) ] ; \ @@ -664,17 +660,6 @@ ada.install-common: $(INSTALL_PROGRAM) gnatclean$(exeext) $(DESTDIR)$(bindir)/gnatclean$(exeext); \ fi ; \ fi - -if [ -f gnat1$(exeext) ] ; \ - then \ - if [ -f gprmake-cross$(exeext) ] ; \ - then \ - $(RM) $(DESTDIR)$(bindir)/$(target_noncanonical)-gprmake$(exeext); \ - $(INSTALL_PROGRAM) gprmake-cross$(exeext) $(DESTDIR)$(bindir)/$(target_noncanonical)-gprmake$(exeext); \ - else \ - $(RM) $(bindir)/gprmake$(exeext); \ - $(INSTALL_PROGRAM) gprmake$(exeext) $(DESTDIR)$(bindir)/gprmake$(exeext); \ - fi ; \ - fi # # Gnatsym is only built on some platforms, including VMS # @@ -808,7 +793,6 @@ ada.distclean: -$(RM) gnatxref$(exeext) -$(RM) gnatclean$(exeext) -$(RM) gnatsym$(exeext) - -$(RM) gprmake$(exeext) # Gnatlbr is only used on VMS -$(RM) gnatlbr$(exeext) -$(RM) ada/rts/* diff --git a/gcc/ada/a-direio.adb b/gcc/ada/a-direio.adb index 69476696a6c..9d315c88c5b 100644 --- a/gcc/ada/a-direio.adb +++ b/gcc/ada/a-direio.adb @@ -73,11 +73,8 @@ package body Ada.Direct_IO is ----------- procedure Close (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Close (AFCB'Access); + FIO.Close (AP (File)'Unrestricted_Access); end Close; ------------ @@ -100,11 +97,8 @@ package body Ada.Direct_IO is ------------ procedure Delete (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Delete (AFCB'Access); + FIO.Delete (AP (File)'Unrestricted_Access); end Delete; ----------------- diff --git a/gcc/ada/a-sequio.adb b/gcc/ada/a-sequio.adb index 8624ee76c05..0c80b4062a7 100644 --- a/gcc/ada/a-sequio.adb +++ b/gcc/ada/a-sequio.adb @@ -66,11 +66,8 @@ package body Ada.Sequential_IO is ----------- procedure Close (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Close (AFCB'Access); + FIO.Close (AP (File)'Unrestricted_Access); end Close; ------------ @@ -92,11 +89,8 @@ package body Ada.Sequential_IO is ------------ procedure Delete (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Delete (AFCB'Access); + FIO.Delete (AP (File)'Unrestricted_Access); end Delete; ----------------- @@ -245,19 +239,13 @@ package body Ada.Sequential_IO is ----------- procedure Reset (File : in out File_Type; Mode : File_Mode) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Reset (AFCB'Access, To_FCB (Mode)); + FIO.Reset (AP (File)'Unrestricted_Access, To_FCB (Mode)); end Reset; procedure Reset (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Reset (AFCB'Access); + FIO.Reset (AP (File)'Unrestricted_Access); end Reset; ----------- diff --git a/gcc/ada/a-ststio.adb b/gcc/ada/a-ststio.adb index fd5e39a7a32..9c3bd31af58 100644 --- a/gcc/ada/a-ststio.adb +++ b/gcc/ada/a-ststio.adb @@ -101,11 +101,8 @@ package body Ada.Streams.Stream_IO is ----------- procedure Close (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Close (AFCB'Access); + FIO.Close (AP (File)'Unrestricted_Access); end Close; ------------ @@ -140,11 +137,8 @@ package body Ada.Streams.Stream_IO is ------------ procedure Delete (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Delete (AFCB'Access); + FIO.Delete (AP (File)'Unrestricted_Access); end Delete; ----------------- @@ -357,9 +351,6 @@ package body Ada.Streams.Stream_IO is -------------- procedure Set_Mode (File : in out File_Type; Mode : File_Mode) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin FIO.Check_File_Open (AP (File)); @@ -371,7 +362,7 @@ package body Ada.Streams.Stream_IO is if ((File.Mode = FCB.In_File) /= (Mode = In_File)) and then not File.Update_Mode then - FIO.Reset (AFCB'Access, FCB.Inout_File); + FIO.Reset (AP (File)'Unrestricted_Access, FCB.Inout_File); File.Update_Mode := True; end if; diff --git a/gcc/ada/a-textio.adb b/gcc/ada/a-textio.adb index c2f0f8b470e..cc5a93bb076 100644 --- a/gcc/ada/a-textio.adb +++ b/gcc/ada/a-textio.adb @@ -147,11 +147,8 @@ package body Ada.Text_IO is ----------- procedure Close (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Close (AFCB'Access); + FIO.Close (AP (File)'Unrestricted_Access); end Close; --------- @@ -249,11 +246,8 @@ package body Ada.Text_IO is ------------ procedure Delete (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Delete (AFCB'Access); + FIO.Delete (AP (File)'Unrestricted_Access); end Delete; ----------------- @@ -1579,9 +1573,6 @@ package body Ada.Text_IO is (File : in out File_Type; Mode : File_Mode) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin -- Don't allow change of mode for current file (RM A.10.2(5)) @@ -1594,7 +1585,7 @@ package body Ada.Text_IO is end if; Terminate_Line (File); - FIO.Reset (AFCB'Access, To_FCB (Mode)); + FIO.Reset (AP (File)'Unrestricted_Access, To_FCB (Mode)); File.Page := 1; File.Line := 1; File.Col := 1; @@ -1605,12 +1596,9 @@ package body Ada.Text_IO is end Reset; procedure Reset (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin Terminate_Line (File); - FIO.Reset (AFCB'Access); + FIO.Reset (AP (File)'Unrestricted_Access); File.Page := 1; File.Line := 1; File.Col := 1; diff --git a/gcc/ada/a-witeio.adb b/gcc/ada/a-witeio.adb index b30c6f52753..1a4b0f5e0e7 100644 --- a/gcc/ada/a-witeio.adb +++ b/gcc/ada/a-witeio.adb @@ -133,11 +133,8 @@ package body Ada.Wide_Text_IO is ----------- procedure Close (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Close (AFCB'Access); + FIO.Close (AP (File)'Unrestricted_Access); end Close; --------- @@ -235,11 +232,8 @@ package body Ada.Wide_Text_IO is ------------ procedure Delete (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Delete (AFCB'Access); + FIO.Delete (AP (File)'Unrestricted_Access); end Delete; ----------------- @@ -1314,9 +1308,6 @@ package body Ada.Wide_Text_IO is (File : in out File_Type; Mode : File_Mode) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin -- Don't allow change of mode for current file (RM A.10.2(5)) @@ -1329,7 +1320,7 @@ package body Ada.Wide_Text_IO is end if; Terminate_Line (File); - FIO.Reset (AFCB'Access, To_FCB (Mode)); + FIO.Reset (AP (File)'Unrestricted_Access, To_FCB (Mode)); File.Page := 1; File.Line := 1; File.Col := 1; @@ -1340,12 +1331,9 @@ package body Ada.Wide_Text_IO is end Reset; procedure Reset (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin Terminate_Line (File); - FIO.Reset (AFCB'Access); + FIO.Reset (AP (File)'Unrestricted_Access); File.Page := 1; File.Line := 1; File.Col := 1; diff --git a/gcc/ada/a-ztexio.adb b/gcc/ada/a-ztexio.adb index 8db57b94689..4bf70405c67 100644 --- a/gcc/ada/a-ztexio.adb +++ b/gcc/ada/a-ztexio.adb @@ -133,11 +133,8 @@ package body Ada.Wide_Wide_Text_IO is ----------- procedure Close (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Close (AFCB'Access); + FIO.Close (AP (File)'Unrestricted_Access); end Close; --------- @@ -235,11 +232,8 @@ package body Ada.Wide_Wide_Text_IO is ------------ procedure Delete (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin - FIO.Delete (AFCB'Access); + FIO.Delete (AP (File)'Unrestricted_Access); end Delete; ----------------- @@ -1314,9 +1308,6 @@ package body Ada.Wide_Wide_Text_IO is (File : in out File_Type; Mode : File_Mode) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin -- Don't allow change of mode for current file (RM A.10.2(5)) @@ -1329,7 +1320,7 @@ package body Ada.Wide_Wide_Text_IO is end if; Terminate_Line (File); - FIO.Reset (AFCB'Access, To_FCB (Mode)); + FIO.Reset (AP (File)'Unrestricted_Access, To_FCB (Mode)); File.Page := 1; File.Line := 1; File.Col := 1; @@ -1340,12 +1331,9 @@ package body Ada.Wide_Wide_Text_IO is end Reset; procedure Reset (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); begin Terminate_Line (File); - FIO.Reset (AFCB'Access); + FIO.Reset (AP (File)'Unrestricted_Access); File.Page := 1; File.Line := 1; File.Col := 1; diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 0fca31e3d2a..40ff3796671 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -544,6 +544,13 @@ package body Exp_Aggr is return False; end if; + -- If component is limited, aggregate must be expanded because each + -- component assignment must be built in place. + + if Is_Inherently_Limited_Type (Component_Type (Typ)) then + return False; + end if; + -- Checks 4 (array must not be multi-dimensional Fortran case) if Convention (Typ) = Convention_Fortran @@ -1514,6 +1521,16 @@ package body Exp_Aggr is Make_Integer_Literal (Loc, Uint_0)))); end if; + -- If the component type contains tasks, we need to build a Master + -- entity in the current scope, because it will be needed if build- + -- in-place functions are called in the expanded code. + + if Nkind (Parent (N)) = N_Object_Declaration + and then Has_Task (Typ) + then + Build_Master_Entity (Defining_Identifier (Parent (N))); + end if; + -- STEP 1: Process component associations -- For those associations that may generate a loop, initialize @@ -4955,6 +4972,13 @@ package body Exp_Aggr is and then In_Place_Assign_OK); end if; + -- If this is an array of tasks, it will be expanded into build-in- + -- -place assignments. Build an activation chain for the tasks now + + if Has_Task (Etype (N)) then + Build_Activation_Chain_Entity (N); + end if; + if not Has_Default_Init_Comps (N) and then Comes_From_Source (Parent (N)) and then Nkind (Parent (N)) = N_Object_Declaration diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 71f09e4f3f1..b110121bc5e 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -7360,7 +7360,7 @@ package body Exp_Ch3 is -- return False; -- end if; - -- or a null statement if the list L is empty. + -- or a null statement if the list L is empty function Make_Eq_If (E : Entity_Id; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 8d8a281c7da..18ea8fe44db 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -4032,6 +4032,28 @@ package body Exp_Ch5 is end; end if; + -- If we are returning an object that may not be bit-aligned, then + -- copy the value into a temporary first. This copy may need to expand + -- to a loop of component operations.. + + if Is_Possibly_Unaligned_Slice (Exp) + or else Is_Possibly_Unaligned_Object (Exp) + then + declare + Tnn : constant Entity_Id := + Make_Defining_Identifier (Loc, New_Internal_Name ('T')); + begin + Insert_Action (Exp, + Make_Object_Declaration (Loc, + Defining_Identifier => Tnn, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (R_Type, Loc), + Expression => Relocate_Node (Exp)), + Suppress => All_Checks); + Rewrite (Exp, New_Occurrence_Of (Tnn, Loc)); + end; + end if; + -- Generate call to postcondition checks if they are present if Ekind (Scope_Id) = E_Function @@ -4061,8 +4083,7 @@ package body Exp_Ch5 is else declare Tnn : constant Entity_Id := - Make_Defining_Identifier (Loc, - New_Internal_Name ('T')); + Make_Defining_Identifier (Loc, New_Internal_Name ('T')); begin -- For a complex expression of an elementary type, capture diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb index 162e5d2ee40..b2e05c3c43d 100644 --- a/gcc/ada/exp_fixd.adb +++ b/gcc/ada/exp_fixd.adb @@ -103,7 +103,7 @@ package body Exp_Fixd is function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id; -- Builds an N_Op_Multiply node from the given left and right operand -- expressions, using the source location from Sloc (N). The operands are - -- either both Universal_Real, in which case Build_Divide differs from + -- either both Universal_Real, in which case Build_Multiply differs from -- Make_Op_Multiply only in that the Etype of the resulting node is set (to -- Universal_Real), or they can be integer types. In this case the integer -- types need not be the same, and Build_Multiply chooses a type long @@ -623,25 +623,17 @@ package body Exp_Fixd is -- the effective size of an operand is the RM_Size of the operand. -- But a special case arises with operands whose size is known at -- compile time. In this case, we can use the actual value of the - -- operand to get its size if it would fit in 8 or 16 bits. - - -- Note: if both operands are known at compile time (can that - -- happen?) and both were equal to the power of 2, then we would - -- be one bit off in this test, so for the left operand, we only - -- go up to the power of 2 - 1. This ensures that we do not get - -- this anomalous case, and in practice the right operand is by - -- far the more likely one to be the constant. + -- operand to get its size if it would fit signed in 8 or 16 bits. Left_Size := UI_To_Int (RM_Size (Left_Type)); if Compile_Time_Known_Value (L) then declare Val : constant Uint := Expr_Value (L); - begin - if Val < Int'(2 ** 8) then + if Val < Int'(2 ** 7) then Left_Size := 8; - elsif Val < Int'(2 ** 16) then + elsif Val < Int'(2 ** 15) then Left_Size := 16; end if; end; @@ -652,11 +644,10 @@ package body Exp_Fixd is if Compile_Time_Known_Value (R) then declare Val : constant Uint := Expr_Value (R); - begin - if Val <= Int'(2 ** 8) then + if Val <= Int'(2 ** 7) then Right_Size := 8; - elsif Val <= Int'(2 ** 16) then + elsif Val <= Int'(2 ** 15) then Right_Size := 16; end if; end; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 058c549525e..d41a6bc383c 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -908,9 +908,9 @@ package body Exp_Util is function Component_May_Be_Bit_Aligned (Comp : Entity_Id) return Boolean is begin - -- If no component clause, then everything is fine, since the - -- back end never bit-misaligns by default, even if there is - -- a pragma Packed for the record. + -- If no component clause, then everything is fine, since the back end + -- never bit-misaligns by default, even if there is a pragma Packed for + -- the record. if No (Component_Clause (Comp)) then return False; @@ -933,8 +933,8 @@ package body Exp_Util is then return False; - -- Otherwise if the component is not byte aligned, we - -- know we have the nasty unaligned case. + -- Otherwise if the component is not byte aligned, we know we have the + -- nasty unaligned case. elsif Normalized_First_Bit (Comp) /= Uint_0 or else Esize (Comp) mod System_Storage_Unit /= Uint_0 @@ -4039,8 +4039,8 @@ package body Exp_Util is begin -- If we know the component size and it is less than 64, then - -- we are definitely OK. The back end always does assignment - -- of misaligned small objects correctly. + -- we are definitely OK. The back end always does assignment of + -- misaligned small objects correctly. if Known_Static_Component_Size (Ptyp) and then Component_Size (Ptyp) <= 64 diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 5f35d4eff1d..5e57147b720 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -205,6 +205,7 @@ package Exp_Util is -- index values. For composite types, the result includes two declarations: -- one for a generated function that computes the image without using -- concatenation, and one for the variable that holds the result. + -- -- If In_Init_Proc is true, the call is part of the initialization of -- a component of a composite type, and the enclosing initialization -- procedure must be flagged as using the secondary stack. If In_Init_Proc @@ -382,7 +383,7 @@ package Exp_Util is Name_Req : Boolean := False); -- Force the evaluation of the expression right away. Similar behavior -- to Remove_Side_Effects when Variable_Ref is set to TRUE. That is to - -- say, it removes the side-effects and capture the values of the + -- say, it removes the side-effects and captures the values of the -- variables. Remove_Side_Effects guarantees that multiple evaluations -- of the same expression won't generate multiple side effects, whereas -- Force_Evaluation further guarantees that all evaluations will yield @@ -476,7 +477,7 @@ package Exp_Util is -- Node N is an object reference. This function returns True if it is -- possible that the object may not be aligned according to the normal -- default alignment requirement for its type (e.g. if it appears in a - -- packed record, or as part of a component that has a component clause. + -- packed record, or as part of a component that has a component clause.) function Is_Renamed_Object (N : Node_Id) return Boolean; -- Returns True if the node N is a renamed object. An expression is @@ -564,12 +565,12 @@ package Exp_Util is -- returned only if the replacement is safe. function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean; - -- This function is used in processing the assignment of a record or - -- indexed component. The argument N is either the left hand or right - -- hand side of an assignment, and this function determines if there - -- is a record component reference where the record may be bit aligned - -- in a manner that causes trouble for the back end (see description - -- of Exp_Util.Component_May_Be_Bit_Aligned for further details). + -- This function is used during processing the assignment of a record or + -- indexed component. The argument N is either the left hand or right hand + -- side of an assignment, and this function determines if there is a record + -- component reference where the record may be bit aligned in a manner that + -- causes trouble for the back end (see Component_May_Be_Bit_Aligned for + -- further details). procedure Remove_Side_Effects (Exp : Node_Id; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index c048581d662..5046cc56c73 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -3897,7 +3897,7 @@ the Profile (Ravenscar), the value of Max_Task_Entries is always no calls to Task_Identification.Abort_Task. @item No_Asynchronous_Control -[RM D.7] There are no semantic dependences on the package +There are no semantic dependences on the package Asynchronous_Task_Control. @item No_Calendar @@ -3918,6 +3918,10 @@ Detach_Handler, and Reference). Protected objects and access types that designate such objects shall be declared only at library level. +@item No_Local_Timing_Events +[RM D.7] All objects of type Ada.Timing_Events.Timing_Event are +declared at the library level. + @item No_Protected_Type_Allocators There are no allocators for protected types or types containing protected subcomponents. @@ -3931,6 +3935,10 @@ Requeue statements are not allowed. @item No_Select_Statements There are no select_statements. +@item No_Specific_Termination_Handlers +[RM D.7] There are no calls to Ada.Task_Termination.Set_Specific_Handler +or to Ada.Task_Termination.Specific_Handler. + @item No_Task_Allocators [RM D.7] There are no allocators for task types or types containing task subcomponents. @@ -3945,6 +3953,12 @@ directly on the environment task of the partition. @item No_Task_Termination Tasks which terminate are erroneous. +@item No_Unchecked_Conversion +There are no semantic dependencies on the Ada.Unchecked_Conversion package. + +@item No_Unchecked_Deallocation +There are no semantic dependencies on the Ada.Unchecked_Deallocation package. + @item Simple_Barriers Entry barrier condition expressions shall be either static boolean expressions or boolean objects which are declared in @@ -5803,6 +5817,10 @@ package body Old_Pkg is end Old_Pkg; @end smallexample +@noindent +Note that it is allowed to apply 'Old to a constant entity, but this will +result in a warning, since the old and new values will always be the same. + @node Passed_By_Reference @unnumberedsec Passed_By_Reference @cindex Parameters, when passed by reference @@ -8370,6 +8388,7 @@ of composite objects and the Max/Min attributes. @item No_Implicit_Dynamic_Code @findex No_Implicit_Dynamic_Code +@cindex trampoline This restriction prevents the compiler from building ``trampolines''. This is a structure that is built on the stack and contains dynamic code to be executed at run time. On some targets, a trampoline is @@ -8379,6 +8398,17 @@ nested task bodies; primitive operations of nested tagged types. Trampolines do not work on machines that prevent execution of stack data. For example, on windows systems, enabling DEP (data execution protection) will cause trampolines to raise an exception. +Trampolines are also quite slow at run time. + +On many targets, trampolines have been largely eliminated. Look at the +version of system.ads for your target --- if it has +Always_Compatible_Rep equal to False, then trampolines are largely +eliminated. In particular, a trampoline is built for the following +features: @code{Address} of a nested subprogram; +@code{Access} or @code{Unrestricted_Access} of a nested subprogram, +but only if pragma Favor_Top_Level applies, or the access type has a +foreign-language convention; primitive operations of nested tagged +types. @item No_Implicit_Loops @findex No_Implicit_Loops diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 4f96a2d8ec4..d40d0e86199 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -17837,6 +17837,21 @@ In this example, @i{expression} is defined by the following grammar: @i{expression} ::= ( @i{expression} ) @end smallexample +The following restriction exists: it is not allowed to have "and" or "or" +following "not" in the same expression without parentheses. For example, this +is not allowed: + +@smallexample + not X or Y +@end smallexample + +This should be one of the following: + +@smallexample + (not X) or Y + not (X or Y) +@end smallexample + @noindent For the first test (@i{expression} ::= <symbol>) the symbol must have either the value true or false, that is to say the right-hand of the diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index e7cacadcdd4..766a474afbf 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -524,13 +524,16 @@ procedure Gnatchop is (Program_Name : String; Look_For_Prefix : Boolean := True) return String_Access is + Gnatchop_Str : constant String := "gnatchop"; Current_Command : constant String := Normalize_Pathname (Command_Name); End_Of_Prefix : Natural; Start_Of_Prefix : Positive; + Start_Of_Suffix : Positive; Result : String_Access; begin Start_Of_Prefix := Current_Command'First; + Start_Of_Suffix := Current_Command'Last + 1; End_Of_Prefix := Start_Of_Prefix - 1; if Look_For_Prefix then @@ -549,18 +552,28 @@ procedure Gnatchop is -- Find End_Of_Prefix - for J in reverse Start_Of_Prefix .. Current_Command'Last loop - if Current_Command (J) = '-' then - End_Of_Prefix := J; + for J in Start_Of_Prefix .. + Current_Command'Last - Gnatchop_Str'Length + 1 + loop + if Current_Command (J .. J + Gnatchop_Str'Length - 1) = + Gnatchop_Str + then + End_Of_Prefix := J - 1; exit; end if; end loop; end if; + if End_Of_Prefix > Current_Command'First then + Start_Of_Suffix := End_Of_Prefix + Gnatchop_Str'Length + 1; + end if; + declare Command : constant String := - Current_Command (Start_Of_Prefix .. End_Of_Prefix) & - Program_Name; + Current_Command (Start_Of_Prefix .. End_Of_Prefix) + & Program_Name + & Current_Command (Start_Of_Suffix .. + Current_Command'Last); begin Result := Locate_Exec_On_Path (Command); diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 1082fb15b10..c75931a42d5 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -787,7 +787,7 @@ procedure GNATCmd is Name : Path_Name_Type; -- Path of the file FD - GN_Name : constant String := Program_Name ("gnatmake").all; + GN_Name : constant String := Program_Name ("gnatmake", "gnat").all; -- Name for gnatmake GN_Path : constant String_Access := Locate_Exec_On_Path (GN_Name); @@ -1340,12 +1340,12 @@ procedure GNATCmd is Put (To_Lower (Command_List (C).Cname.all)); Set_Col (25); - -- No prefix for gnatstack + -- Never call gnatstack with a prefix if C = Stack then Put (Command_List (C).Unixcmd.all); else - Put (Program_Name (Command_List (C).Unixcmd.all).all); + Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all); end if; declare @@ -1575,11 +1575,13 @@ begin begin if The_Command = Stack then + -- Never call gnatstack with a prefix + Program := new String'(Command_List (The_Command).Unixcmd.all); else Program := - Program_Name (Command_List (The_Command).Unixcmd.all); + Program_Name (Command_List (The_Command).Unixcmd.all, "gnat"); end if; -- Locate the executable for the command diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 256504bf6eb..99898223cf2 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -137,7 +137,7 @@ procedure Gnatlink is -- This table collects the arguments to be passed to compile the binder -- generated file. - Gcc : String_Access := Program_Name ("gcc"); + Gcc : String_Access := Program_Name ("gcc", "gnatlink"); Read_Mode : constant String := "r" & ASCII.NUL; diff --git a/gcc/ada/gprmake.adb b/gcc/ada/gprmake.adb deleted file mode 100644 index 61bef3c9098..00000000000 --- a/gcc/ada/gprmake.adb +++ /dev/null @@ -1,35 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G P R M A K E -- --- -- --- B o d y -- --- -- --- Copyright (C) 2004-2007, 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 3, 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 COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- The driver for the gprmake tool - -with Makegpr; - -procedure Gprmake is -begin - -- The code is in Makegpr - - Makegpr.Gprmake; -end Gprmake; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index c1737b7ed47..3ae13fc84ae 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -659,9 +659,9 @@ package body Make is -- Compiler, Binder & Linker Data and Subprograms -- ---------------------------------------------------- - Gcc : String_Access := Program_Name ("gcc"); - Gnatbind : String_Access := Program_Name ("gnatbind"); - Gnatlink : String_Access := Program_Name ("gnatlink"); + Gcc : String_Access := Program_Name ("gcc", "gnatmake"); + Gnatbind : String_Access := Program_Name ("gnatbind", "gnatmake"); + Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake"); -- Default compiler, binder, linker programs Saved_Gcc : String_Access := null; diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb deleted file mode 100644 index 04996bb4e13..00000000000 --- a/gcc/ada/makegpr.adb +++ /dev/null @@ -1,4471 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- M A K E G P R -- --- -- --- B o d y -- --- -- --- Copyright (C) 2004-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 3, 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 COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Csets; -with Gnatvsn; -with Hostparm; use Hostparm; -with Makeutl; use Makeutl; -with MLib.Tgt; use MLib.Tgt; -with Namet; use Namet; -with Output; use Output; -with Opt; use Opt; -with Osint; use Osint; -with Prj; use Prj; -with Prj.Ext; use Prj.Ext; -with Prj.Pars; -with Prj.Util; use Prj.Util; -with Snames; use Snames; -with Table; -with Types; use Types; - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Fixed; use Ada.Strings.Fixed; -with Ada.Text_IO; use Ada.Text_IO; -with Ada.Unchecked_Deallocation; - -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.Dynamic_Tables; -with GNAT.Expect; use GNAT.Expect; -with GNAT.HTable; -with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Regpat; use GNAT.Regpat; - -with System; -with System.Case_Util; use System.Case_Util; - -package body Makegpr is - - On_Windows : constant Boolean := Directory_Separator = '\'; - -- True when on Windows. Used in Check_Compilation_Needed when processing - -- C/C++ dependency files for backslash handling. - - Max_In_Archives : constant := 50; - -- The maximum number of arguments for a single invocation of the - -- Archive Indexer (ar). - - No_Argument : aliased Argument_List := (1 .. 0 => null); - -- Null argument list representing case of no arguments - - FD : Process_Descriptor; - -- The process descriptor used when invoking a non GNU compiler with -M - -- and getting the output with GNAT.Expect. - - Line_Matcher : constant Pattern_Matcher := Compile ("^.*?\n", Single_Line); - -- Pattern for GNAT.Expect for the invocation of a non GNU compiler with -M - - Name_Ide : Name_Id; - Name_Compiler_Command : Name_Id; - -- Names of package IDE and its attribute Compiler_Command. - -- Set up by Initialize. - - Unique_Compile : Boolean := False; - -- True when switch -u is used on the command line - - type Source_Index_Rec is record - Project : Project_Id; - Id : Other_Source_Id; - Found : Boolean := False; - end record; - -- Used as Source_Indexes component to check if archive needs to be rebuilt - - type Source_Index_Array is array (Positive range <>) of Source_Index_Rec; - type Source_Indexes_Ref is access Source_Index_Array; - - procedure Free is new Ada.Unchecked_Deallocation - (Source_Index_Array, Source_Indexes_Ref); - - Initial_Source_Index_Count : constant Positive := 20; - Source_Indexes : Source_Indexes_Ref := - new Source_Index_Array (1 .. Initial_Source_Index_Count); - -- A list of the Other_Source_Ids of a project file, with an indication - -- that they have been found in the archive dependency file. - - Last_Source : Natural := 0; - -- The index of the last valid component of Source_Indexes - - Compiler_Names : array (First_Language_Indexes) of String_Access; - -- The names of the compilers to be used. Set up by Get_Compiler. - -- Used to display the commands spawned. - - Gnatmake_String : constant String_Access := new String'("gnatmake"); - GCC_String : constant String_Access := new String'("gcc"); - G_Plus_Plus_String : constant String_Access := new String'("g++"); - - Default_Compiler_Names : constant array - (First_Language_Indexes range - Ada_Language_Index .. C_Plus_Plus_Language_Index) - of String_Access := - (Ada_Language_Index => Gnatmake_String, - C_Language_Index => GCC_String, - C_Plus_Plus_Language_Index => G_Plus_Plus_String); - - Compiler_Paths : array (First_Language_Indexes) of String_Access; - -- The path names of the compiler to be used. Set up by Get_Compiler. - -- Used to spawn compiling/linking processes. - - Compiler_Is_Gcc : array (First_Language_Indexes) of Boolean; - -- An indication that a compiler is a GCC compiler, to be able to use - -- specific GCC switches. - - Archive_Builder_Path : String_Access := null; - -- The path name of the archive builder (ar). To be used when spawning - -- ar commands. - - Archive_Indexer_Path : String_Access := null; - -- The path name of the archive indexer (ranlib), if it exists - - Copyright_Output : Boolean := False; - Usage_Output : Boolean := False; - -- Flags to avoid multiple displays of Copyright notice and of Usage - - Output_File_Name : String_Access := null; - -- The name given after a switch -o - - Output_File_Name_Expected : Boolean := False; - -- True when last switch was -o - - Project_File_Name : String_Access := null; - -- The name of the project file specified with switch -P - - Project_File_Name_Expected : Boolean := False; - -- True when last switch was -P - - Naming_String : aliased String := "naming"; - Builder_String : aliased String := "builder"; - Compiler_String : aliased String := "compiler"; - Binder_String : aliased String := "binder"; - Linker_String : aliased String := "linker"; - -- Name of packages to be checked when parsing/processing project files - - List_Of_Packages : aliased String_List := - (Naming_String 'Access, - Builder_String 'Access, - Compiler_String 'Access, - Binder_String 'Access, - Linker_String 'Access); - Packages_To_Check : constant String_List_Access := List_Of_Packages'Access; - -- List of the packages to be checked when parsing/processing project files - - Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data; - - Main_Project : Project_Id; - -- The project id of the main project - - type Processor is (None, Linker, Compiler); - Current_Processor : Processor := None; - -- This variable changes when switches -*args are used - - Current_Language : Language_Index := Ada_Language_Index; - -- The compiler language to consider when Processor is Compiler - - package Comp_Opts is new GNAT.Dynamic_Tables - (Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100); - Options : array (First_Language_Indexes) of Comp_Opts.Instance; - -- Tables to store compiling options for the different compilers - - package Linker_Options is new Table.Table - (Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Makegpr.Linker_Options"); - -- Table to store the linking options - - package Library_Opts is new Table.Table - (Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Makegpr.Library_Opts"); - -- Table to store the linking options - - package Ada_Mains is new Table.Table - (Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Makegpr.Ada_Mains"); - -- Table to store the Ada mains, either specified on the command line - -- or found in attribute Main of the main project file. - - package Other_Mains is new Table.Table - (Table_Component_Type => Other_Source, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Makegpr.Other_Mains"); - -- Table to store the mains of languages other than Ada, either specified - -- on the command line or found in attribute Main of the main project file. - - package Sources_Compiled is new GNAT.HTable.Simple_HTable - (Header_Num => Header_Num, - Element => Boolean, - No_Element => False, - Key => File_Name_Type, - Hash => Hash, - Equal => "="); - - package Saved_Switches is new Table.Table - (Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 10, - Table_Increment => 100, - Table_Name => "Makegpr.Saved_Switches"); - -- Table to store the switches to be passed to gnatmake - - Initial_Argument_Count : constant Positive := 20; - type Boolean_Array is array (Positive range <>) of Boolean; - type Booleans is access Boolean_Array; - - procedure Free is new Ada.Unchecked_Deallocation (Boolean_Array, Booleans); - - Arguments : Argument_List_Access := - new Argument_List (1 .. Initial_Argument_Count); - -- Used to store lists of arguments to be used when spawning a process - - Arguments_Displayed : Booleans := - new Boolean_Array (1 .. Initial_Argument_Count); - -- For each argument in Arguments, indicate if the argument should be - -- displayed when procedure Display_Command is called. - - Last_Argument : Natural := 0; - -- Index of the last valid argument in Arguments - - package Cache_Args is new Table.Table - (Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Makegpr.Cache_Args"); - -- A table to cache arguments, to avoid multiple allocation of the same - -- strings. It is not possible to use a hash table, because String is - -- an unconstrained type. - - -- Various switches used when spawning processes: - - Dash_B_String : aliased String := "-B"; - Dash_B : constant String_Access := Dash_B_String'Access; - Dash_c_String : aliased String := "-c"; - Dash_c : constant String_Access := Dash_c_String'Access; - Dash_cargs_String : aliased String := "-cargs"; - Dash_cargs : constant String_Access := Dash_cargs_String'Access; - Dash_d_String : aliased String := "-d"; - Dash_d : constant String_Access := Dash_d_String'Access; - Dash_eL_String : aliased String := "-eL"; - Dash_eL : constant String_Access := Dash_eL_String'Access; - Dash_f_String : aliased String := "-f"; - Dash_f : constant String_Access := Dash_f_String'Access; - Dash_k_String : aliased String := "-k"; - Dash_k : constant String_Access := Dash_k_String'Access; - Dash_largs_String : aliased String := "-largs"; - Dash_largs : constant String_Access := Dash_largs_String'Access; - Dash_M_String : aliased String := "-M"; - Dash_M : constant String_Access := Dash_M_String'Access; - Dash_margs_String : aliased String := "-margs"; - Dash_margs : constant String_Access := Dash_margs_String'Access; - Dash_o_String : aliased String := "-o"; - Dash_o : constant String_Access := Dash_o_String'Access; - Dash_P_String : aliased String := "-P"; - Dash_P : constant String_Access := Dash_P_String'Access; - Dash_q_String : aliased String := "-q"; - Dash_q : constant String_Access := Dash_q_String'Access; - Dash_u_String : aliased String := "-u"; - Dash_u : constant String_Access := Dash_u_String'Access; - Dash_v_String : aliased String := "-v"; - Dash_v : constant String_Access := Dash_v_String'Access; - Dash_vP1_String : aliased String := "-vP1"; - Dash_vP1 : constant String_Access := Dash_vP1_String'Access; - Dash_vP2_String : aliased String := "-vP2"; - Dash_vP2 : constant String_Access := Dash_vP2_String'Access; - Dash_x_String : aliased String := "-x"; - Dash_x : constant String_Access := Dash_x_String'Access; - r_String : aliased String := "r"; - r : constant String_Access := r_String'Access; - - CPATH : constant String := "CPATH"; - -- The environment variable to set when compiler is a GCC compiler - -- to indicate the include directory path. - - Current_Include_Paths : array (First_Language_Indexes) of String_Access; - -- A cache for the paths of included directories, to avoid setting - -- env var CPATH unnecessarily. - - C_Plus_Plus_Is_Used : Boolean := False; - -- True when there are sources in C++ - - Link_Options_Switches : Argument_List_Access := null; - -- The link options coming from the attributes Linker'Linker_Options in - -- project files imported, directly or indirectly, by the main project. - - Total_Number_Of_Errors : Natural := 0; - -- Used when Keep_Going is True (switch -k) to keep the total number - -- of compilation/linking errors, to report at the end of execution. - - Need_To_Rebuild_Global_Archive : Boolean := False; - - Error_Header : constant String := "*** ERROR: "; - -- The beginning of error message, when Keep_Going is True - - Need_To_Relink : Boolean := False; - -- True when an executable of a language other than Ada need to be linked - - Global_Archive_Exists : Boolean := False; - -- True if there is a non empty global archive, to prevent creation - -- of such archives. - - Path_Option : String_Access; - -- The path option switch, when supported - - Project_Of_Current_Object_Directory : Project_Id := No_Project; - -- The object directory of the project for the last compilation. Avoid - -- calling Change_Dir if the current working directory is already this - -- directory. - - package Lib_Path is new Table.Table - (Table_Component_Type => Character, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 200, - Table_Increment => 100, - Table_Name => "Makegpr.Lib_Path"); - -- A table to compute the path to put in the path option switch, when it - -- is supported. - - procedure Add_Archives (For_Gnatmake : Boolean); - -- Add to Arguments the list of archives for linking an executable - - procedure Add_Argument (Arg : String_Access; Display : Boolean); - procedure Add_Argument (Arg : String; Display : Boolean); - -- Add an argument to Arguments. Reallocate if necessary - - procedure Add_Arguments (Args : Argument_List; Display : Boolean); - -- Add a list of arguments to Arguments. Reallocate if necessary - - procedure Add_Option (Arg : String); - -- Add a switch for the Ada, C or C++ compiler, or for the linker. - -- The table where this option is stored depends on the values of - -- Current_Processor and Current_Language. - - procedure Add_Search_Directories - (Data : Project_Data; - Language : First_Language_Indexes); - -- Either add to the Arguments the necessary -I switches needed to - -- compile, or, when compiler is gcc/g++, set up the C*INCLUDE_PATH - -- environment variable, if necessary. - - procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id); - -- Add a source id to Source_Indexes, with Found set to False - - procedure Add_Switches - (Data : Project_Data; - Proc : Processor; - Language : Language_Index; - File_Name : File_Name_Type); - -- Add to Arguments the switches, if any, for a source (attribute Switches) - -- or language (attribute Default_Switches), coming from package Compiler - -- or Linker (depending on Proc) of a specified project file. - - procedure Build_Global_Archive; - -- Build the archive for the main project - - procedure Build_Library (Project : Project_Id; Unconditionally : Boolean); - -- Build the library for a library project. If Unconditionally is - -- False, first check if the library is up to date, and build it only - -- if it is not. - - procedure Check (Option : String); - -- Check that a switch coming from a project file is not the concatenation - -- of several valid switch, for example "-g -v". If it is, issue a warning. - - procedure Check_Archive_Builder; - -- Check if the archive builder (ar) is there - - procedure Check_Compilation_Needed - (Source : Other_Source; - Need_To_Compile : out Boolean); - -- Check if a source of a language other than Ada needs to be compiled or - -- recompiled. - - procedure Check_For_C_Plus_Plus; - -- Check if C++ is used in at least one project - - procedure Compile - (Source_Id : Other_Source_Id; - Data : Project_Data; - Local_Errors : in out Boolean); - -- Compile one non-Ada source - - procedure Compile_Individual_Sources; - -- Compile the sources specified on the command line, when in - -- Unique_Compile mode. - - procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean); - -- Compile/Link with gnatmake when there are Ada sources in the main - -- project. Arguments may already contain options to be used by - -- gnatmake. Used for both Ada mains and mains of other languages. - -- When Compile_Only is True, do not use the linking options - - procedure Compile_Sources; - -- Compile the sources of languages other than Ada, if necessary - - procedure Copyright; - -- Output the Copyright notice - - procedure Create_Archive_Dependency_File - (Name : String; - First_Source : Other_Source_Id); - -- Create the archive dependency file for a library project - - procedure Create_Global_Archive_Dependency_File (Name : String); - -- Create the archive dependency file for the main project - - procedure Display_Command - (Name : String; - Path : String_Access; - CPATH : String_Access := null; - Ellipse : Boolean := False); - -- Display the command for a spawned process, if in Verbose_Mode or not in - -- Quiet_Output. In non verbose mode, when Ellipse is True, display "..." - -- in place of the first argument that has Display set to False. - - procedure Get_Compiler (For_Language : First_Language_Indexes); - -- Find the compiler name and path name for a specified programming - -- language, if not already done. Results are in the corresponding elements - -- of arrays Compiler_Names and Compiler_Paths. Name of compiler is found - -- in package IDE of the main project, or defaulted. Fail if compiler - -- cannot be found on the path. For the Ada language, gnatmake, rather than - -- the Ada compiler is returned. - - procedure Get_Imported_Directories - (Project : Project_Id; - Data : in out Project_Data); - -- Find the necessary switches -I to be used when compiling sources of - -- languages other than Ada, in a specified project file. Cache the result - -- in component Imported_Directories_Switches of the project data. For - -- gcc/g++ compilers, get the value of the C*_INCLUDE_PATH, instead. - - procedure Initialize; - -- Do the necessary package initialization and process the command line - -- arguments. - - function Is_Included_In_Global_Archive - (Object_Name : File_Name_Type; - Project : Project_Id) return Boolean; - -- Return True if the object Object_Name is not overridden by a source - -- in a project extending project Project. - - procedure Link_Executables; - -- Link executables - - procedure Report_Error (S1 : String; S2 : String := ""; S3 : String := ""); - -- Report an error. If Keep_Going is False, just call Osint.Fail. If - -- Keep_Going is True, display the error and increase the total number of - -- errors. - - procedure Report_Total_Errors (Kind : String); - -- If Total_Number_Of_Errors is not zero, report it, and fail - - procedure Scan_Arg (Arg : String); - -- Process one command line argument - - function Strip_CR_LF (Text : String) return String; - -- Remove characters ASCII.CR and ASCII.LF from a String - - procedure Usage; - -- Display the usage - - ------------------ - -- Add_Archives -- - ------------------ - - procedure Add_Archives (For_Gnatmake : Boolean) is - Last_Arg : constant Natural := Last_Argument; - -- The position of the last argument before adding the archives. Used to - -- reverse the order of the arguments added when processing the - -- archives. - - procedure Recursive_Add_Archives (Project : Project_Id); - -- Recursive procedure to add the archive of a project file, if any, - -- then call itself for the project imported. - - ---------------------------- - -- Recursive_Add_Archives -- - ---------------------------- - - procedure Recursive_Add_Archives (Project : Project_Id) is - Data : Project_Data; - Imported : Project_List; - Prj : Project_Id; - - procedure Add_Archive_Path; - -- For a library project or the main project, add the archive - -- path to the arguments. - - ---------------------- - -- Add_Archive_Path -- - ---------------------- - - procedure Add_Archive_Path is - Increment : Positive; - Prev_Last : Positive; - - begin - if Data.Library then - - -- If it is a library project file, nothing to do if gnatmake - -- will be invoked, because gnatmake will take care of it, even - -- if the library is not an Ada library. - - if not For_Gnatmake then - if Data.Library_Kind = Static then - Add_Argument - (Get_Name_String (Data.Library_Dir.Display_Name) & - Directory_Separator & - "lib" & Get_Name_String (Data.Library_Name) & - '.' & Archive_Ext, - Verbose_Mode); - - else - -- As we first insert in the reverse order, - -- -L<dir> is put after -l<lib> - - Add_Argument - ("-l" & Get_Name_String (Data.Library_Name), - Verbose_Mode); - - Get_Name_String (Data.Library_Dir.Display_Name); - - Add_Argument - ("-L" & Name_Buffer (1 .. Name_Len), - Verbose_Mode); - - -- If there is a run path option, prepend this directory - -- to the library path. It is probable that the order of - -- the directories in the path option is not important, - -- but just in case put the directories in the same order - -- as the libraries. - - if Path_Option /= null then - - -- If it is not the first directory, make room at the - -- beginning of the table, including for a path - -- separator. - - if Lib_Path.Last > 0 then - Increment := Name_Len + 1; - Prev_Last := Lib_Path.Last; - Lib_Path.Set_Last (Prev_Last + Increment); - - for Index in reverse 1 .. Prev_Last loop - Lib_Path.Table (Index + Increment) := - Lib_Path.Table (Index); - end loop; - - Lib_Path.Table (Increment) := Path_Separator; - - else - -- If it is the first directory, just set - -- Last to the length of the directory. - - Lib_Path.Set_Last (Name_Len); - end if; - - -- Put the directory at the beginning of the - -- table. - - for Index in 1 .. Name_Len loop - Lib_Path.Table (Index) := Name_Buffer (Index); - end loop; - end if; - end if; - end if; - - -- For a non-library project, the only archive needed is the one - -- for the main project, if there is one. - - elsif Project = Main_Project and then Global_Archive_Exists then - Add_Argument - (Get_Name_String (Data.Object_Directory.Display_Name) & - Directory_Separator & - "lib" & Get_Name_String (Data.Display_Name) - & '.' & Archive_Ext, - Verbose_Mode); - end if; - end Add_Archive_Path; - - begin - -- Nothing to do when there is no project specified - - if Project /= No_Project then - Data := Project_Tree.Projects.Table (Project); - - -- Nothing to do if the project has already been processed - - if not Data.Seen then - - -- Mark the project as processed, to avoid processing it again - - Project_Tree.Projects.Table (Project).Seen := True; - - Recursive_Add_Archives (Data.Extends); - - Imported := Data.Imported_Projects; - - -- Call itself recursively for all imported projects - - while Imported /= Empty_Project_List loop - Prj := Project_Tree.Project_Lists.Table - (Imported).Project; - - if Prj /= No_Project then - while Project_Tree.Projects.Table - (Prj).Extended_By /= No_Project - loop - Prj := Project_Tree.Projects.Table - (Prj).Extended_By; - end loop; - - Recursive_Add_Archives (Prj); - end if; - - Imported := Project_Tree.Project_Lists.Table - (Imported).Next; - end loop; - - -- If there is sources of language other than Ada in this - -- project, add the path of the archive to Arguments. - - if Project = Main_Project - or else Data.Other_Sources_Present - then - Add_Archive_Path; - end if; - end if; - end if; - end Recursive_Add_Archives; - - -- Start of processing for Add_Archives - - begin - -- First, mark all projects as not processed - - for Project in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Project_Tree.Projects.Table (Project).Seen := False; - end loop; - - -- Take care of the run path option - - if Path_Option = null then - Path_Option := MLib.Linker_Library_Path_Option; - end if; - - Lib_Path.Set_Last (0); - - -- Add archives in the reverse order - - Recursive_Add_Archives (Main_Project); - - -- And reverse the order - - declare - First : Positive; - Last : Natural; - Temp : String_Access; - - begin - First := Last_Arg + 1; - Last := Last_Argument; - while First < Last loop - Temp := Arguments (First); - Arguments (First) := Arguments (Last); - Arguments (Last) := Temp; - First := First + 1; - Last := Last - 1; - end loop; - end; - end Add_Archives; - - ------------------ - -- Add_Argument -- - ------------------ - - procedure Add_Argument (Arg : String_Access; Display : Boolean) is - begin - -- Nothing to do if no argument is specified or if argument is empty - - if Arg /= null or else Arg'Length = 0 then - - -- Reallocate arrays if necessary - - if Last_Argument = Arguments'Last then - declare - New_Arguments : constant Argument_List_Access := - new Argument_List - (1 .. Last_Argument + - Initial_Argument_Count); - - New_Arguments_Displayed : constant Booleans := - new Boolean_Array - (1 .. Last_Argument + - Initial_Argument_Count); - - begin - New_Arguments (Arguments'Range) := Arguments.all; - - -- To avoid deallocating the strings, nullify all components - -- of Arguments before calling Free. - - Arguments.all := (others => null); - - Free (Arguments); - Arguments := New_Arguments; - - New_Arguments_Displayed (Arguments_Displayed'Range) := - Arguments_Displayed.all; - Free (Arguments_Displayed); - Arguments_Displayed := New_Arguments_Displayed; - end; - end if; - - -- Add the argument and its display indication - - Last_Argument := Last_Argument + 1; - Arguments (Last_Argument) := Arg; - Arguments_Displayed (Last_Argument) := Display; - end if; - end Add_Argument; - - procedure Add_Argument (Arg : String; Display : Boolean) is - Argument : String_Access := null; - - begin - -- Nothing to do if argument is empty - - if Arg'Length > 0 then - - -- Check if the argument is already in the Cache_Args table. - -- If it is already there, reuse the allocated value. - - for Index in 1 .. Cache_Args.Last loop - if Cache_Args.Table (Index).all = Arg then - Argument := Cache_Args.Table (Index); - exit; - end if; - end loop; - - -- If the argument is not in the cache, create a new entry in the - -- cache. - - if Argument = null then - Argument := new String'(Arg); - Cache_Args.Increment_Last; - Cache_Args.Table (Cache_Args.Last) := Argument; - end if; - - -- And add the argument - - Add_Argument (Argument, Display); - end if; - end Add_Argument; - - ------------------- - -- Add_Arguments -- - ------------------- - - procedure Add_Arguments (Args : Argument_List; Display : Boolean) is - begin - -- Reallocate the arrays, if necessary - - if Last_Argument + Args'Length > Arguments'Last then - declare - New_Arguments : constant Argument_List_Access := - new Argument_List - (1 .. Last_Argument + Args'Length + - Initial_Argument_Count); - - New_Arguments_Displayed : constant Booleans := - new Boolean_Array - (1 .. Last_Argument + - Args'Length + - Initial_Argument_Count); - - begin - New_Arguments (1 .. Last_Argument) := - Arguments (1 .. Last_Argument); - - -- To avoid deallocating the strings, nullify all components - -- of Arguments before calling Free. - - Arguments.all := (others => null); - Free (Arguments); - - Arguments := New_Arguments; - New_Arguments_Displayed (1 .. Last_Argument) := - Arguments_Displayed (1 .. Last_Argument); - Free (Arguments_Displayed); - Arguments_Displayed := New_Arguments_Displayed; - end; - end if; - - -- Add the new arguments and the display indications - - Arguments (Last_Argument + 1 .. Last_Argument + Args'Length) := Args; - Arguments_Displayed (Last_Argument + 1 .. Last_Argument + Args'Length) := - (others => Display); - Last_Argument := Last_Argument + Args'Length; - end Add_Arguments; - - ---------------- - -- Add_Option -- - ---------------- - - procedure Add_Option (Arg : String) is - Option : constant String_Access := new String'(Arg); - - begin - case Current_Processor is - when None => - null; - - when Linker => - - -- Add option to the linker table - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := Option; - - when Compiler => - - -- Add option to the compiler option table, depending on the - -- value of Current_Language. - - Comp_Opts.Increment_Last (Options (Current_Language)); - Options (Current_Language).Table - (Comp_Opts.Last (Options (Current_Language))) := Option; - - end case; - end Add_Option; - - ------------------- - -- Add_Source_Id -- - ------------------- - - procedure Add_Source_Id (Project : Project_Id; Id : Other_Source_Id) is - begin - -- Reallocate the array, if necessary - - if Last_Source = Source_Indexes'Last then - declare - New_Indexes : constant Source_Indexes_Ref := - new Source_Index_Array - (1 .. Source_Indexes'Last + - Initial_Source_Index_Count); - begin - New_Indexes (Source_Indexes'Range) := Source_Indexes.all; - Free (Source_Indexes); - Source_Indexes := New_Indexes; - end; - end if; - - Last_Source := Last_Source + 1; - Source_Indexes (Last_Source) := (Project, Id, False); - end Add_Source_Id; - - ---------------------------- - -- Add_Search_Directories -- - ---------------------------- - - procedure Add_Search_Directories - (Data : Project_Data; - Language : First_Language_Indexes) - is - begin - -- If a GNU compiler is used, set the CPATH environment variable, - -- if it does not already has the correct value. - - if Compiler_Is_Gcc (Language) then - if Current_Include_Paths (Language) /= Data.Include_Path then - Current_Include_Paths (Language) := Data.Include_Path; - Setenv (CPATH, Data.Include_Path.all); - end if; - - else - Add_Arguments (Data.Imported_Directories_Switches.all, Verbose_Mode); - end if; - end Add_Search_Directories; - - ------------------ - -- Add_Switches -- - ------------------ - - procedure Add_Switches - (Data : Project_Data; - Proc : Processor; - Language : Language_Index; - File_Name : File_Name_Type) - is - Switches : Variable_Value; - -- The switches, if any, for the file/language - - Pkg : Package_Id; - -- The id of the package where to look for the switches - - Defaults : Array_Element_Id; - -- The Default_Switches associative array - - Switches_Array : Array_Element_Id; - -- The Switches associative array - - Element_Id : String_List_Id; - Element : String_Element; - - begin - -- First, choose the proper package - - case Proc is - when None => - raise Program_Error; - - when Linker => - Pkg := Value_Of (Name_Linker, Data.Decl.Packages, Project_Tree); - - when Compiler => - Pkg := Value_Of (Name_Compiler, Data.Decl.Packages, Project_Tree); - end case; - - if Pkg /= No_Package then - - -- Get the Switches ("file name"), if they exist - - Switches_Array := Prj.Util.Value_Of - (Name => Name_Switches, - In_Arrays => Project_Tree.Packages.Table - (Pkg).Decl.Arrays, - In_Tree => Project_Tree); - - Switches := - Prj.Util.Value_Of - (Index => Name_Id (File_Name), - Src_Index => 0, - In_Array => Switches_Array, - In_Tree => Project_Tree); - - -- Otherwise, get the Default_Switches ("language"), if they exist - - if Switches = Nil_Variable_Value then - Defaults := Prj.Util.Value_Of - (Name => Name_Default_Switches, - In_Arrays => Project_Tree.Packages.Table - (Pkg).Decl.Arrays, - In_Tree => Project_Tree); - Switches := Prj.Util.Value_Of - (Index => Language_Names.Table (Language), - Src_Index => 0, - In_Array => Defaults, - In_Tree => Project_Tree); - end if; - - -- If there are switches, add them to Arguments - - if Switches /= Nil_Variable_Value then - Element_Id := Switches.Values; - while Element_Id /= Nil_String loop - Element := Project_Tree.String_Elements.Table - (Element_Id); - - if Element.Value /= No_Name then - Get_Name_String (Element.Value); - - if not Quiet_Output then - - -- When not in quiet output (no -q), check that the - -- switch is not the concatenation of several valid - -- switches, such as "-g -v". If it is, issue a warning. - - Check (Option => Name_Buffer (1 .. Name_Len)); - end if; - - Add_Argument (Name_Buffer (1 .. Name_Len), True); - end if; - - Element_Id := Element.Next; - end loop; - end if; - end if; - end Add_Switches; - - -------------------------- - -- Build_Global_Archive -- - -------------------------- - - procedure Build_Global_Archive is - Data : Project_Data := Project_Tree.Projects.Table (Main_Project); - Source_Id : Other_Source_Id; - S_Id : Other_Source_Id; - Source : Other_Source; - Success : Boolean; - - Archive_Name : constant String := - "lib" - & Get_Name_String (Data.Display_Name) - & '.' - & Archive_Ext; - -- The name of the archive file for this project - - Archive_Dep_Name : constant String := - "lib" - & Get_Name_String (Data.Display_Name) - & ".deps"; - -- The name of the archive dependency file for this project - - Need_To_Rebuild : Boolean := Need_To_Rebuild_Global_Archive; - -- When True, archive will be rebuilt - - File : Prj.Util.Text_File; - Object_Path : Path_Name_Type; - Time_Stamp : Time_Stamp_Type; - Saved_Last_Argument : Natural; - First_Object : Natural; - - Discard : Boolean; - pragma Warnings (Off, Discard); - - begin - Check_Archive_Builder; - - if Project_Of_Current_Object_Directory /= Main_Project then - Project_Of_Current_Object_Directory := Main_Project; - Change_Dir (Get_Name_String (Data.Object_Directory.Name)); - - if Verbose_Mode then - Write_Str ("Changing to object directory of """); - Write_Name (Data.Display_Name); - Write_Str (""": """); - Write_Name (Data.Object_Directory.Display_Name); - Write_Line (""""); - end if; - end if; - - if not Need_To_Rebuild then - if Verbose_Mode then - Write_Str (" Checking "); - Write_Line (Archive_Name); - end if; - - -- If the archive does not exist, of course it needs to be built - - if not Is_Regular_File (Archive_Name) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Line (" -> archive does not exist"); - end if; - - -- Archive does exist - - else - -- Check the archive dependency file - - Open (File, Archive_Dep_Name); - - -- If the archive dependency file does not exist, we need to - -- rebuild the archive and to create its dependency file. - - if not Is_Valid (File) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Str (Archive_Dep_Name); - Write_Line (" does not exist"); - end if; - - else - -- Put all sources of language other than Ada in Source_Indexes - - declare - Local_Data : Project_Data; - - begin - Last_Source := 0; - - for Proj in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Local_Data := Project_Tree.Projects.Table (Proj); - - if not Local_Data.Library then - Source_Id := Local_Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Add_Source_Id (Proj, Source_Id); - Source_Id := Project_Tree.Other_Sources.Table - (Source_Id).Next; - end loop; - end if; - end loop; - end; - - -- Read the dependency file, line by line - - while not End_Of_File (File) loop - Get_Line (File, Name_Buffer, Name_Len); - - -- First line is the path of the object file - - Object_Path := Name_Find; - Source_Id := No_Other_Source; - - -- Check if this object file is for a source of this project - - for S in 1 .. Last_Source loop - S_Id := Source_Indexes (S).Id; - Source := Project_Tree.Other_Sources.Table (S_Id); - - if (not Source_Indexes (S).Found) - and then Source.Object_Path = Object_Path - then - -- We have found the object file: get the source data, - -- and mark it as found. - - Source_Id := S_Id; - Source_Indexes (S).Found := True; - exit; - end if; - end loop; - - -- If it is not for a source of this project, then the - -- archive needs to be rebuilt. - - if Source_Id = No_Other_Source then - Need_To_Rebuild := True; - if Verbose_Mode then - Write_Str (" -> "); - Write_Str (Get_Name_String (Object_Path)); - Write_Line (" is not an object of any project"); - end if; - - exit; - end if; - - -- The second line is the time stamp of the object file. If - -- there is no next line, then the dependency file is - -- truncated, and the archive need to be rebuilt. - - if End_Of_File (File) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Line (" is truncated"); - end if; - - exit; - end if; - - Get_Line (File, Name_Buffer, Name_Len); - - -- If the line has the wrong number of characters, then - -- the dependency file is incorrectly formatted, and the - -- archive needs to be rebuilt. - - if Name_Len /= Time_Stamp_Length then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Line (" is incorrectly formatted (time stamp)"); - end if; - - exit; - end if; - - Time_Stamp := Time_Stamp_Type (Name_Buffer (1 .. Name_Len)); - - -- If the time stamp in the dependency file is different - -- from the time stamp of the object file, then the archive - -- needs to be rebuilt. - - if Time_Stamp /= Source.Object_TS then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> time stamp of "); - Write_Str (Get_Name_String (Object_Path)); - Write_Str (" is incorrect in the archive"); - Write_Line (" dependency file"); - end if; - - exit; - end if; - end loop; - - Close (File); - end if; - end if; - end if; - - if not Need_To_Rebuild then - if Verbose_Mode then - Write_Line (" -> up to date"); - end if; - - -- No need to create a global archive, if there is no object - -- file to put into. - - Global_Archive_Exists := Last_Source /= 0; - - -- Archive needs to be rebuilt - - else - -- If archive already exists, first delete it - - -- Comment needed on why we discard result??? - - if Is_Regular_File (Archive_Name) then - Delete_File (Archive_Name, Discard); - end if; - - Last_Argument := 0; - - -- Start with the options found in MLib.Tgt (usually just "rc") - - Add_Arguments (Archive_Builder_Options.all, True); - - -- Followed by the archive name - - Add_Argument (Archive_Name, True); - - First_Object := Last_Argument; - - -- Followed by all the object files of the non library projects - - for Proj in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Data := Project_Tree.Projects.Table (Proj); - - if not Data.Library then - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := - Project_Tree.Other_Sources.Table (Source_Id); - - -- Only include object file name that have not been - -- overridden in extending projects. - - if Is_Included_In_Global_Archive - (Source.Object_Name, Proj) - then - Add_Argument - (Get_Name_String (Source.Object_Path), - Verbose_Mode or (First_Object = Last_Argument)); - end if; - - Source_Id := Source.Next; - end loop; - end if; - end loop; - - -- No need to create a global archive, if there is no object - -- file to put into. - - Global_Archive_Exists := Last_Argument > First_Object; - - if Global_Archive_Exists then - - -- If the archive is built, then linking will need to occur - -- unconditionally. - - Need_To_Relink := True; - - -- Spawn the archive builder (ar) - - Saved_Last_Argument := Last_Argument; - Last_Argument := First_Object + Max_In_Archives; - loop - if Last_Argument > Saved_Last_Argument then - Last_Argument := Saved_Last_Argument; - end if; - - Display_Command - (Archive_Builder, - Archive_Builder_Path, - Ellipse => True); - - Spawn - (Archive_Builder_Path.all, - Arguments (1 .. Last_Argument), - Success); - - exit when not Success - or else Last_Argument = Saved_Last_Argument; - - Arguments (1) := r; - Arguments (3 .. Saved_Last_Argument - Last_Argument + 2) := - Arguments (Last_Argument + 1 .. Saved_Last_Argument); - Saved_Last_Argument := Saved_Last_Argument - Last_Argument + 2; - end loop; - - -- If the archive was built, run the archive indexer (ranlib) - -- if there is one. - - if Success then - - if Archive_Indexer_Path /= null then - Last_Argument := 0; - Add_Argument (Archive_Name, True); - - Display_Command (Archive_Indexer, Archive_Indexer_Path); - - Spawn - (Archive_Indexer_Path.all, Arguments (1 .. 1), Success); - - if not Success then - - -- Running ranlib failed, delete the dependency file, - -- if it exists. - - if Is_Regular_File (Archive_Dep_Name) then - Delete_File (Archive_Dep_Name, Success); - end if; - - -- And report the error - - Report_Error - ("running" & Archive_Indexer & " for project """, - Get_Name_String (Data.Display_Name), - """ failed"); - return; - end if; - end if; - - -- The archive was correctly built, create its dependency file - - Create_Global_Archive_Dependency_File (Archive_Dep_Name); - - -- Building the archive failed, delete dependency file if one - -- exists. - - else - if Is_Regular_File (Archive_Dep_Name) then - Delete_File (Archive_Dep_Name, Success); - end if; - - -- And report the error - - Report_Error - ("building archive for project """, - Get_Name_String (Data.Display_Name), - """ failed"); - end if; - end if; - end if; - end Build_Global_Archive; - - ------------------- - -- Build_Library -- - ------------------- - - procedure Build_Library (Project : Project_Id; Unconditionally : Boolean) is - Data : constant Project_Data := - Project_Tree.Projects.Table (Project); - Source_Id : Other_Source_Id; - Source : Other_Source; - - Archive_Name : constant String := - "lib" & Get_Name_String (Data.Library_Name) - & '.' & Archive_Ext; - -- The name of the archive file for this project - - Archive_Dep_Name : constant String := - "lib" & Get_Name_String (Data.Library_Name) - & ".deps"; - -- The name of the archive dependency file for this project - - Need_To_Rebuild : Boolean := Unconditionally; - -- When True, archive will be rebuilt - - File : Prj.Util.Text_File; - - Object_Name : File_Name_Type; - Time_Stamp : Time_Stamp_Type; - Driver_Name : Name_Id := No_Name; - - Lib_Opts : Argument_List_Access := No_Argument'Access; - - begin - -- Nothing to do if the project is externally built - - if Data.Externally_Built then - return; - end if; - - Check_Archive_Builder; - - -- If Unconditionally is False, check if the archive need to be built - - if not Need_To_Rebuild then - if Verbose_Mode then - Write_Str (" Checking "); - Write_Line (Archive_Name); - end if; - - -- If the archive does not exist, of course it needs to be built - - if not Is_Regular_File (Archive_Name) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Line (" -> archive does not exist"); - end if; - - -- Archive does exist - - else - -- Check the archive dependency file - - Open (File, Archive_Dep_Name); - - -- If the archive dependency file does not exist, we need to - -- rebuild the archive and to create its dependency file. - - if not Is_Valid (File) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Str (Archive_Dep_Name); - Write_Line (" does not exist"); - end if; - - else - -- Put all sources of language other than Ada in Source_Indexes - - Last_Source := 0; - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Add_Source_Id (Project, Source_Id); - Source_Id := - Project_Tree.Other_Sources.Table (Source_Id).Next; - end loop; - - -- Read the dependency file, line by line - - while not End_Of_File (File) loop - Get_Line (File, Name_Buffer, Name_Len); - - -- First line is the name of an object file - - Object_Name := Name_Find; - Source_Id := No_Other_Source; - - -- Check if this object file is for a source of this project - - for S in 1 .. Last_Source loop - if (not Source_Indexes (S).Found) - and then - Project_Tree.Other_Sources.Table - (Source_Indexes (S).Id).Object_Name = Object_Name - then - -- We have found the object file: get the source - -- data, and mark it as found. - - Source_Id := Source_Indexes (S).Id; - Source := Project_Tree.Other_Sources.Table - (Source_Id); - Source_Indexes (S).Found := True; - exit; - end if; - end loop; - - -- If it is not for a source of this project, then the - -- archive needs to be rebuilt. - - if Source_Id = No_Other_Source then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> "); - Write_Str (Get_Name_String (Object_Name)); - Write_Line (" is not an object of the project"); - end if; - - exit; - end if; - - -- The second line is the time stamp of the object file. - -- If there is no next line, then the dependency file is - -- truncated, and the archive need to be rebuilt. - - if End_Of_File (File) then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Line (" is truncated"); - end if; - - exit; - end if; - - Get_Line (File, Name_Buffer, Name_Len); - - -- If the line has the wrong number of character, then - -- the dependency file is incorrectly formatted, and the - -- archive needs to be rebuilt. - - if Name_Len /= Time_Stamp_Length then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> archive dependency file "); - Write_Line (" is incorrectly formatted (time stamp)"); - end if; - - exit; - end if; - - Time_Stamp := Time_Stamp_Type (Name_Buffer (1 .. Name_Len)); - - -- If the time stamp in the dependency file is different - -- from the time stamp of the object file, then the archive - -- needs to be rebuilt. - - if Time_Stamp /= Source.Object_TS then - Need_To_Rebuild := True; - - if Verbose_Mode then - Write_Str (" -> time stamp of "); - Write_Str (Get_Name_String (Object_Name)); - Write_Str (" is incorrect in the archive"); - Write_Line (" dependency file"); - end if; - - exit; - end if; - end loop; - - Close (File); - - if not Need_To_Rebuild then - - -- Now, check if all object files of the project have been - -- accounted for. If any of them is not in the dependency - -- file, the archive needs to be rebuilt. - - for Index in 1 .. Last_Source loop - if not Source_Indexes (Index).Found then - Need_To_Rebuild := True; - - if Verbose_Mode then - Source_Id := Source_Indexes (Index).Id; - Source := Project_Tree.Other_Sources.Table - (Source_Id); - Write_Str (" -> "); - Write_Str (Get_Name_String (Source.Object_Name)); - Write_Str (" is not in the archive "); - Write_Line ("dependency file"); - end if; - - exit; - end if; - end loop; - end if; - - if (not Need_To_Rebuild) and Verbose_Mode then - Write_Line (" -> up to date"); - end if; - end if; - end if; - end if; - - -- Build the library if necessary - - if Need_To_Rebuild then - - -- If a library is built, then linking will need to occur - -- unconditionally. - - Need_To_Relink := True; - - Last_Argument := 0; - - -- If there are sources in Ada, then gnatmake will build the library, - -- so nothing to do. - - if not Data.Langs (Ada_Language_Index) then - - -- Get all the object files of the project - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - Add_Argument - (Get_Name_String (Source.Object_Name), Verbose_Mode); - Source_Id := Source.Next; - end loop; - - -- If it is a library, it need to be built it the same way Ada - -- libraries are built. - - if Data.Library_Kind = Static then - MLib.Build_Library - (Ofiles => Arguments (1 .. Last_Argument), - Output_File => Get_Name_String (Data.Library_Name), - Output_Dir => Get_Name_String - (Data.Library_Dir.Display_Name)); - - else - -- Link with g++ if C++ is one of the languages, otherwise - -- building the library may fail with unresolved symbols. - - if C_Plus_Plus_Is_Used then - if Compiler_Names (C_Plus_Plus_Language_Index) = null then - Get_Compiler (C_Plus_Plus_Language_Index); - end if; - - if Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then - Name_Len := 0; - Add_Str_To_Name_Buffer - (Compiler_Names (C_Plus_Plus_Language_Index).all); - Driver_Name := Name_Find; - end if; - end if; - - -- If Library_Options is specified, add these options - - declare - Library_Options : constant Variable_Value := - Value_Of - (Name_Library_Options, - Data.Decl.Attributes, - Project_Tree); - - begin - if not Library_Options.Default then - declare - Current : String_List_Id; - Element : String_Element; - - begin - Current := Library_Options.Values; - while Current /= Nil_String loop - Element := - Project_Tree.String_Elements.Table (Current); - Get_Name_String (Element.Value); - - if Name_Len /= 0 then - Library_Opts.Increment_Last; - Library_Opts.Table (Library_Opts.Last) := - new String'(Name_Buffer (1 .. Name_Len)); - end if; - - Current := Element.Next; - end loop; - end; - end if; - - Lib_Opts := - new Argument_List'(Argument_List - (Library_Opts.Table (1 .. Library_Opts.Last))); - end; - - MLib.Tgt.Build_Dynamic_Library - (Ofiles => Arguments (1 .. Last_Argument), - Options => Lib_Opts.all, - Interfaces => No_Argument, - Lib_Filename => Get_Name_String (Data.Library_Name), - Lib_Dir => Get_Name_String (Data.Library_Dir.Name), - Symbol_Data => No_Symbols, - Driver_Name => Driver_Name, - Lib_Version => "", - Auto_Init => False); - end if; - end if; - - -- Create fake empty archive, so we can check its time stamp later - - declare - Archive : Ada.Text_IO.File_Type; - begin - Create (Archive, Out_File, Archive_Name); - Close (Archive); - end; - - Create_Archive_Dependency_File - (Archive_Dep_Name, Data.First_Other_Source); - end if; - end Build_Library; - - ----------- - -- Check -- - ----------- - - procedure Check (Option : String) is - First : Positive := Option'First; - Last : Natural; - - begin - for Index in Option'First + 1 .. Option'Last - 1 loop - if Option (Index) = ' ' and then Option (Index + 1) = '-' then - Write_Str ("warning: switch """); - Write_Str (Option); - Write_Str (""" is suspicious; consider using "); - - Last := First; - while Last <= Option'Last loop - if Option (Last) = ' ' then - if First /= Option'First then - Write_Str (", "); - end if; - - Write_Char ('"'); - Write_Str (Option (First .. Last - 1)); - Write_Char ('"'); - - while Last <= Option'Last and then Option (Last) = ' ' loop - Last := Last + 1; - end loop; - - First := Last; - - else - if Last = Option'Last then - if First /= Option'First then - Write_Str (", "); - end if; - - Write_Char ('"'); - Write_Str (Option (First .. Last)); - Write_Char ('"'); - end if; - - Last := Last + 1; - end if; - end loop; - - Write_Line (" instead"); - exit; - end if; - end loop; - end Check; - - --------------------------- - -- Check_Archive_Builder -- - --------------------------- - - procedure Check_Archive_Builder is - begin - -- First, make sure that the archive builder (ar) is on the path - - if Archive_Builder_Path = null then - Archive_Builder_Path := Locate_Exec_On_Path (Archive_Builder); - - if Archive_Builder_Path = null then - Osint.Fail - ("unable to locate archive builder """, - Archive_Builder, - """"); - end if; - - -- If there is an archive indexer (ranlib), try to locate it on the - -- path. Don't fail if it is not found. - - if Archive_Indexer /= "" then - Archive_Indexer_Path := Locate_Exec_On_Path (Archive_Indexer); - end if; - end if; - end Check_Archive_Builder; - - ------------------------------ - -- Check_Compilation_Needed -- - ------------------------------ - - procedure Check_Compilation_Needed - (Source : Other_Source; - Need_To_Compile : out Boolean) - is - Source_Name : constant String := Get_Name_String (Source.File_Name); - Source_Path : constant String := Get_Name_String (Source.Path_Name); - Object_Name : constant String := Get_Name_String (Source.Object_Name); - C_Object_Name : String := Object_Name; - Dep_Name : constant String := Get_Name_String (Source.Dep_Name); - C_Source_Path : constant String := - Normalize_Pathname - (Name => Source_Path, - Resolve_Links => False, - Case_Sensitive => False); - - Source_In_Dependencies : Boolean := False; - -- Set True if source was found in dependency file of its object file - - Dep_File : Prj.Util.Text_File; - Start : Natural; - Finish : Natural; - - Looping : Boolean := False; - -- Set to True at the end of the first Big_Loop - - begin - Canonical_Case_File_Name (C_Object_Name); - - -- Assume the worst, so that statement "return;" may be used if there - -- is any problem. - - Need_To_Compile := True; - - if Verbose_Mode then - Write_Str (" Checking "); - Write_Str (Source_Name); - Write_Line (" ... "); - end if; - - -- If object file does not exist, of course source need to be compiled - - if Source.Object_TS = Empty_Time_Stamp then - if Verbose_Mode then - Write_Str (" -> object file "); - Write_Str (Object_Name); - Write_Line (" does not exist"); - end if; - - return; - end if; - - -- If the object file has been created before the last modification - -- of the source, the source need to be recompiled. - - if Source.Object_TS < Source.Source_TS then - if Verbose_Mode then - Write_Str (" -> object file "); - Write_Str (Object_Name); - Write_Line (" has time stamp earlier than source"); - end if; - - return; - end if; - - -- If there is no dependency file, then the source needs to be - -- recompiled and the dependency file need to be created. - - if Source.Dep_TS = Empty_Time_Stamp then - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" does not exist"); - end if; - - return; - end if; - - -- The source needs to be recompiled if the source has been modified - -- after the dependency file has been created. - - if Source.Dep_TS < Source.Source_TS then - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" has time stamp earlier than source"); - end if; - - return; - end if; - - -- Look for all dependencies - - Open (Dep_File, Dep_Name); - - -- If dependency file cannot be open, we need to recompile the source - - if not Is_Valid (Dep_File) then - if Verbose_Mode then - Write_Str (" -> could not open dependency file "); - Write_Line (Dep_Name); - end if; - - return; - end if; - - -- Loop Big_Loop is executed several times only when the dependency file - -- contains several times - -- <object file>: <source1> ... - -- When there is only one of such occurrence, Big_Loop is exited - -- successfully at the beginning of the second loop. - - Big_Loop : - loop - declare - End_Of_File_Reached : Boolean := False; - - begin - loop - if End_Of_File (Dep_File) then - End_Of_File_Reached := True; - exit; - end if; - - Get_Line (Dep_File, Name_Buffer, Name_Len); - - exit when Name_Len > 0 and then Name_Buffer (1) /= '#'; - end loop; - - -- If dependency file contains only empty lines or comments, then - -- dependencies are unknown, and the source needs to be - -- recompiled. - - if End_Of_File_Reached then - -- If we have reached the end of file after the first loop, - -- there is nothing else to do. - - exit Big_Loop when Looping; - - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" is empty"); - end if; - - Close (Dep_File); - return; - end if; - end; - - Start := 1; - Finish := Index (Name_Buffer (1 .. Name_Len), ": "); - - if Finish /= 0 then - Canonical_Case_File_Name (Name_Buffer (1 .. Finish - 1)); - end if; - - -- First line must start with name of object file, followed by colon - - if Finish = 0 or else - Name_Buffer (1 .. Finish - 1) /= C_Object_Name - then - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" has wrong format"); - end if; - - Close (Dep_File); - return; - - else - Start := Finish + 2; - - -- Process each line - - Line_Loop : loop - declare - Line : String := Name_Buffer (1 .. Name_Len); - Last : Natural := Name_Len; - - begin - Name_Loop : loop - - -- Find the beginning of the next source path name - - while Start < Last and then Line (Start) = ' ' loop - Start := Start + 1; - end loop; - - -- Go to next line when there is a continuation character - -- \ at the end of the line. - - exit Name_Loop when Start = Last - and then Line (Start) = '\'; - - -- We should not be at the end of the line, without - -- a continuation character \. - - if Start = Last then - if Verbose_Mode then - Write_Str (" -> dependency file "); - Write_Str (Dep_Name); - Write_Line (" has wrong format"); - end if; - - Close (Dep_File); - return; - end if; - - -- Look for the end of the source path name - - Finish := Start; - while Finish < Last loop - if Line (Finish) = '\' then - - -- On Windows, a '\' is part of the path name, - -- except when it is followed by another '\' or by - -- a space. On other platforms, when we are getting - -- a '\' that is not the last character of the - -- line, the next character is part of the path - -- name, even if it is a space. - - if On_Windows - and then Line (Finish + 1) /= '\' - and then Line (Finish + 1) /= ' ' - then - Finish := Finish + 1; - - else - Line (Finish .. Last - 1) := - Line (Finish + 1 .. Last); - Last := Last - 1; - end if; - - else - -- A space that is not preceded by '\' indicates - -- the end of the path name. - - exit when Line (Finish + 1) = ' '; - - Finish := Finish + 1; - end if; - end loop; - - -- Check this source - - declare - Src_Name : constant String := - Normalize_Pathname - (Name => - Line (Start .. Finish), - Resolve_Links => False, - Case_Sensitive => False); - Src_TS : Time_Stamp_Type; - - begin - -- If it is original source, set - -- Source_In_Dependencies. - - if Src_Name = C_Source_Path then - Source_In_Dependencies := True; - end if; - - Name_Len := 0; - Add_Str_To_Name_Buffer (Src_Name); - Src_TS := File_Stamp (File_Name_Type'(Name_Find)); - - -- If the source does not exist, we need to recompile - - if Src_TS = Empty_Time_Stamp then - if Verbose_Mode then - Write_Str (" -> source "); - Write_Str (Src_Name); - Write_Line (" does not exist"); - end if; - - Close (Dep_File); - return; - - -- If the source has been modified after the object - -- file, we need to recompile. - - elsif Src_TS > Source.Object_TS then - if Verbose_Mode then - Write_Str (" -> source "); - Write_Str (Src_Name); - Write_Line - (" has time stamp later than object file"); - end if; - - Close (Dep_File); - return; - end if; - end; - - -- If the source path name ends the line, we are done - - exit Line_Loop when Finish = Last; - - -- Go get the next source on the line - - Start := Finish + 1; - end loop Name_Loop; - end; - - -- If we are here, we had a continuation character \ at the end - -- of the line, so we continue with the next line. - - Get_Line (Dep_File, Name_Buffer, Name_Len); - Start := 1; - end loop Line_Loop; - end if; - - -- Set Looping at the end of the first loop - Looping := True; - end loop Big_Loop; - - Close (Dep_File); - - -- If the original sources were not in the dependency file, then we - -- need to recompile. It may mean that we are using a different source - -- (different variant) for this object file. - - if not Source_In_Dependencies then - if Verbose_Mode then - Write_Str (" -> source "); - Write_Str (Source_Path); - Write_Line (" is not in the dependencies"); - end if; - - return; - end if; - - -- If we are here, then everything is OK, no need to recompile - - if Verbose_Mode then - Write_Line (" -> up to date"); - end if; - - Need_To_Compile := False; - end Check_Compilation_Needed; - - --------------------------- - -- Check_For_C_Plus_Plus -- - --------------------------- - - procedure Check_For_C_Plus_Plus is - begin - C_Plus_Plus_Is_Used := False; - - for Project in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - if - Project_Tree.Projects.Table (Project).Langs - (C_Plus_Plus_Language_Index) - then - C_Plus_Plus_Is_Used := True; - exit; - end if; - end loop; - end Check_For_C_Plus_Plus; - - ------------- - -- Compile -- - ------------- - - procedure Compile - (Source_Id : Other_Source_Id; - Data : Project_Data; - Local_Errors : in out Boolean) - is - Source : Other_Source := - Project_Tree.Other_Sources.Table (Source_Id); - Success : Boolean; - CPATH : String_Access := null; - - begin - -- If the compiler is not known yet, get its path name - - if Compiler_Names (Source.Language) = null then - Get_Compiler (Source.Language); - end if; - - -- For non GCC compilers, get the dependency file, first calling the - -- compiler with the switch -M. - - if not Compiler_Is_Gcc (Source.Language) then - Last_Argument := 0; - - -- Add the source name, preceded by -M - - Add_Argument (Dash_M, True); - Add_Argument (Get_Name_String (Source.Path_Name), True); - - -- Add the compiling switches for this source found in - -- package Compiler of the project file, if they exist. - - Add_Switches - (Data, Compiler, Source.Language, Source.File_Name); - - -- Add the compiling switches for the language specified - -- on the command line, if any. - - for - J in 1 .. Comp_Opts.Last (Options (Source.Language)) - loop - Add_Argument (Options (Source.Language).Table (J), True); - end loop; - - -- Finally, add imported directory switches for this project file - - Add_Search_Directories (Data, Source.Language); - - -- And invoke the compiler using GNAT.Expect - - Display_Command - (Compiler_Names (Source.Language).all, - Compiler_Paths (Source.Language)); - - begin - Non_Blocking_Spawn - (FD, - Compiler_Paths (Source.Language).all, - Arguments (1 .. Last_Argument), - Buffer_Size => 0, - Err_To_Out => True); - - declare - Dep_File : Ada.Text_IO.File_Type; - Result : Expect_Match; - - Status : Integer; - pragma Warnings (Off, Status); - - begin - -- Create the dependency file - - Create (Dep_File, Out_File, Get_Name_String (Source.Dep_Name)); - - loop - Expect (FD, Result, Line_Matcher); - - exit when Result = Expect_Timeout; - - declare - S : constant String := Strip_CR_LF (Expect_Out (FD)); - - begin - -- Each line of the output is put in the dependency - -- file, including errors. If there are errors, the - -- syntax of the dependency file will be incorrect and - -- recompilation will occur automatically the next time - -- the dependencies are checked. - - Put_Line (Dep_File, S); - end; - end loop; - - -- If we are here, it means we had a timeout, so the - -- dependency file may be incomplete. It is safer to - -- delete it, otherwise the dependencies may be wrong. - - Close (FD, Status); - Close (Dep_File); - Delete_File (Get_Name_String (Source.Dep_Name), Success); - - exception - when Process_Died => - - -- This is the normal outcome. Just close the file - - Close (FD, Status); - Close (Dep_File); - - when others => - - -- Something wrong happened. It is safer to delete the - -- dependency file, otherwise the dependencies may be wrong. - - Close (FD, Status); - - if Is_Open (Dep_File) then - Close (Dep_File); - end if; - - Delete_File (Get_Name_String (Source.Dep_Name), Success); - end; - - exception - -- If we cannot spawn the compiler, then the dependencies are - -- not updated. It is safer then to delete the dependency file, - -- otherwise the dependencies may be wrong. - - when Invalid_Process => - Delete_File (Get_Name_String (Source.Dep_Name), Success); - end; - end if; - - Last_Argument := 0; - - -- For GCC compilers, make sure the language is always specified to - -- to the GCC driver, in case the extension is not recognized by the - -- GCC driver as a source of the language. - - if Compiler_Is_Gcc (Source.Language) then - Add_Argument (Dash_x, Verbose_Mode); - Add_Argument - (Get_Name_String (Language_Names.Table (Source.Language)), - Verbose_Mode); - end if; - - Add_Argument (Dash_c, True); - - -- Add the compiling switches for this source found in package Compiler - -- of the project file, if they exist. - - Add_Switches - (Data, Compiler, Source.Language, Source.File_Name); - - -- Specify the source to be compiled - - Add_Argument (Get_Name_String (Source.Path_Name), True); - - -- If non static library project, compile with the PIC option if there - -- is one (when there is no PIC option, MLib.Tgt.PIC_Option returns an - -- empty string, and Add_Argument with an empty string has no effect). - - if Data.Library and then Data.Library_Kind /= Static then - Add_Argument (PIC_Option, True); - end if; - - -- Indicate the name of the object - - Add_Argument (Dash_o, True); - Add_Argument (Get_Name_String (Source.Object_Name), True); - - -- When compiler is GCC, use the magic switch that creates the - -- dependency file in the correct format. - - if Compiler_Is_Gcc (Source.Language) then - Add_Argument - ("-Wp,-MD," & Get_Name_String (Source.Dep_Name), - Verbose_Mode); - end if; - - -- Add the compiling switches for the language specified on the command - -- line, if any. - - for J in 1 .. Comp_Opts.Last (Options (Source.Language)) loop - Add_Argument (Options (Source.Language).Table (J), True); - end loop; - - -- Finally, add the imported directory switches for this project file - -- (or, for gcc compilers, set up the CPATH env var if needed). - - Add_Search_Directories (Data, Source.Language); - - -- Set CPATH, if compiler is GCC - - if Compiler_Is_Gcc (Source.Language) then - CPATH := Current_Include_Paths (Source.Language); - end if; - - -- And invoke the compiler - - Display_Command - (Name => Compiler_Names (Source.Language).all, - Path => Compiler_Paths (Source.Language), - CPATH => CPATH); - - Spawn - (Compiler_Paths (Source.Language).all, - Arguments (1 .. Last_Argument), - Success); - - -- Case of successful compilation - - if Success then - - -- Update the time stamp of the object file - - Source.Object_TS := File_Stamp (Source.Object_Name); - - -- Do some sanity checks - - if Source.Object_TS = Empty_Time_Stamp then - Local_Errors := True; - Report_Error - ("object file ", - Get_Name_String (Source.Object_Name), - " has not been created"); - - elsif Source.Object_TS < Source.Source_TS then - Local_Errors := True; - Report_Error - ("object file ", - Get_Name_String (Source.Object_Name), - " has not been modified"); - - else - -- Everything looks fine, update the Other_Sources table - - Project_Tree.Other_Sources.Table (Source_Id) := Source; - end if; - - -- Compilation failed - - else - Local_Errors := True; - Report_Error - ("compilation of ", - Get_Name_String (Source.Path_Name), - " failed"); - end if; - end Compile; - - -------------------------------- - -- Compile_Individual_Sources -- - -------------------------------- - - procedure Compile_Individual_Sources is - Data : Project_Data := - Project_Tree.Projects.Table (Main_Project); - Source_Id : Other_Source_Id; - Source : Other_Source; - Source_Name : File_Name_Type; - Project_Name : String := Get_Name_String (Data.Name); - Dummy : Boolean := False; - - Ada_Is_A_Language : constant Boolean := - Data.Langs (Ada_Language_Index); - - begin - Ada_Mains.Init; - To_Mixed (Project_Name); - Compile_Only := True; - - Get_Imported_Directories (Main_Project, Data); - Project_Tree.Projects.Table (Main_Project) := Data; - - -- Compilation will occur in the object directory - - if Project_Of_Current_Object_Directory /= Main_Project then - Project_Of_Current_Object_Directory := Main_Project; - Change_Dir (Get_Name_String (Data.Object_Directory.Name)); - - if Verbose_Mode then - Write_Str ("Changing to object directory of """); - Write_Name (Data.Name); - Write_Str (""": """); - Write_Name (Data.Object_Directory.Display_Name); - Write_Line (""""); - end if; - end if; - - if not Data.Other_Sources_Present then - if Ada_Is_A_Language then - Mains.Reset; - - loop - declare - Main : constant String := Mains.Next_Main; - begin - exit when Main'Length = 0; - Ada_Mains.Increment_Last; - Ada_Mains.Table (Ada_Mains.Last) := new String'(Main); - end; - end loop; - - else - Osint.Fail ("project ", Project_Name, " contains no source"); - end if; - - else - Mains.Reset; - - loop - declare - Main : constant String := Mains.Next_Main; - begin - Name_Len := Main'Length; - exit when Name_Len = 0; - Name_Buffer (1 .. Name_Len) := Main; - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Source_Name := Name_Find; - - if not Sources_Compiled.Get (Source_Name) then - Sources_Compiled.Set (Source_Name, True); - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - exit when Source.File_Name = Source_Name; - Source_Id := Source.Next; - end loop; - - if Source_Id = No_Other_Source then - if Ada_Is_A_Language then - Ada_Mains.Increment_Last; - Ada_Mains.Table (Ada_Mains.Last) := new String'(Main); - - else - Report_Error - (Main, - " is not a valid source of project ", - Project_Name); - end if; - - else - Compile (Source_Id, Data, Dummy); - end if; - end if; - end; - end loop; - end if; - - if Ada_Mains.Last > 0 then - - -- Invoke gnatmake for all Ada sources - - Last_Argument := 0; - Add_Argument (Dash_u, True); - - for Index in 1 .. Ada_Mains.Last loop - Add_Argument (Ada_Mains.Table (Index), True); - end loop; - - Compile_Link_With_Gnatmake (Mains_Specified => False); - end if; - end Compile_Individual_Sources; - - -------------------------------- - -- Compile_Link_With_Gnatmake -- - -------------------------------- - - procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) is - Data : constant Project_Data := - Project_Tree.Projects.Table (Main_Project); - Success : Boolean; - - begin - -- Array Arguments may already contain some arguments, so we don't - -- set Last_Argument to 0. - - -- Get the gnatmake to invoke - - Get_Compiler (Ada_Language_Index); - - -- Specify the project file - - Add_Argument (Dash_P, True); - Add_Argument (Get_Name_String (Data.Path.Display_Name), True); - - -- Add the saved switches, if any - - for Index in 1 .. Saved_Switches.Last loop - Add_Argument (Saved_Switches.Table (Index), True); - end loop; - - -- If Mains_Specified is True, find the mains in package Mains - - if Mains_Specified then - Mains.Reset; - - loop - declare - Main : constant String := Mains.Next_Main; - begin - exit when Main'Length = 0; - Add_Argument (Main, True); - end; - end loop; - end if; - - -- Specify output file name, if any was specified on the command line - - if Output_File_Name /= null then - Add_Argument (Dash_o, True); - Add_Argument (Output_File_Name, True); - end if; - - -- Transmit some switches to gnatmake - - -- -c - - if Compile_Only then - Add_Argument (Dash_c, True); - end if; - - -- -d - - if Display_Compilation_Progress then - Add_Argument (Dash_d, True); - end if; - - -- -eL - - if Follow_Links_For_Files then - Add_Argument (Dash_eL, True); - end if; - - -- -k - - if Keep_Going then - Add_Argument (Dash_k, True); - end if; - - -- -f - - if Force_Compilations then - Add_Argument (Dash_f, True); - end if; - - -- -v - - if Verbose_Mode then - Add_Argument (Dash_v, True); - end if; - - -- -q - - if Quiet_Output then - Add_Argument (Dash_q, True); - end if; - - -- -vP1 and -vP2 - - case Current_Verbosity is - when Default => - null; - - when Medium => - Add_Argument (Dash_vP1, True); - - when High => - Add_Argument (Dash_vP2, True); - end case; - - -- If there are compiling options for Ada, transmit them to gnatmake - - if Comp_Opts.Last (Options (Ada_Language_Index)) /= 0 then - Add_Argument (Dash_cargs, True); - - for Arg in 1 .. Comp_Opts.Last (Options (Ada_Language_Index)) loop - Add_Argument (Options (Ada_Language_Index).Table (Arg), True); - end loop; - end if; - - if not Compile_Only then - - -- Linking options - - if Linker_Options.Last /= 0 then - Add_Argument (Dash_largs, True); - else - Add_Argument (Dash_largs, Verbose_Mode); - end if; - - -- Add the archives - - Add_Archives (For_Gnatmake => True); - - -- If there are linking options from the command line, - -- transmit them to gnatmake. - - for Arg in 1 .. Linker_Options.Last loop - Add_Argument (Linker_Options.Table (Arg), True); - end loop; - end if; - - -- And invoke gnatmake - - Display_Command - (Compiler_Names (Ada_Language_Index).all, - Compiler_Paths (Ada_Language_Index)); - - Spawn - (Compiler_Paths (Ada_Language_Index).all, - Arguments (1 .. Last_Argument), - Success); - - -- Report an error if call to gnatmake failed - - if not Success then - Report_Error - ("invocation of ", - Compiler_Names (Ada_Language_Index).all, - " failed"); - end if; - end Compile_Link_With_Gnatmake; - - --------------------- - -- Compile_Sources -- - --------------------- - - procedure Compile_Sources is - Data : Project_Data; - Source_Id : Other_Source_Id; - Source : Other_Source; - - Local_Errors : Boolean := False; - -- Set to True when there is a compilation error. Used only when - -- Keep_Going is True, to inhibit the building of the archive. - - Need_To_Compile : Boolean; - -- Set to True when a source needs to be compiled/recompiled - - Need_To_Rebuild_Archive : Boolean := Force_Compilations; - -- True when the archive needs to be built/rebuilt unconditionally - - Total_Number_Of_Sources : Int := 0; - - Current_Source_Number : Int := 0; - - begin - -- First, get the number of sources - - for Project in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Data := Project_Tree.Projects.Table (Project); - - if not Data.Virtual and then Data.Other_Sources_Present then - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - Total_Number_Of_Sources := Total_Number_Of_Sources + 1; - Source_Id := Source.Next; - end loop; - end if; - end loop; - - -- Loop through project files - - for Project in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Local_Errors := False; - Data := Project_Tree.Projects.Table (Project); - - -- Nothing to do when no sources of language other than Ada - - if (not Data.Virtual) and then Data.Other_Sources_Present then - - -- If the imported directory switches are unknown, compute them - - if not Data.Include_Data_Set then - Get_Imported_Directories (Project, Data); - Data.Include_Data_Set := True; - Project_Tree.Projects.Table (Project) := Data; - end if; - - Need_To_Rebuild_Archive := Force_Compilations; - - -- Compilation will occur in the object directory - - if Project_Of_Current_Object_Directory /= Project then - Project_Of_Current_Object_Directory := Project; - Change_Dir (Get_Name_String (Data.Object_Directory.Name)); - - if Verbose_Mode then - Write_Str ("Changing to object directory of """); - Write_Name (Data.Display_Name); - Write_Str (""": """); - Write_Name (Data.Object_Directory.Display_Name); - Write_Line (""""); - end if; - end if; - - -- Process each source one by one - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - Current_Source_Number := Current_Source_Number + 1; - Need_To_Compile := Force_Compilations; - - -- Check if compilation is needed - - if not Need_To_Compile then - Check_Compilation_Needed (Source, Need_To_Compile); - end if; - - -- Proceed, if compilation is needed - - if Need_To_Compile then - - -- If a source is compiled/recompiled, of course the - -- archive will need to be built/rebuilt. - - Need_To_Rebuild_Archive := True; - Compile (Source_Id, Data, Local_Errors); - end if; - - if Display_Compilation_Progress then - Write_Str ("completed "); - Write_Int (Current_Source_Number); - Write_Str (" out of "); - Write_Int (Total_Number_Of_Sources); - Write_Str (" ("); - Write_Int - ((Current_Source_Number * 100) / Total_Number_Of_Sources); - Write_Str ("%)..."); - Write_Eol; - end if; - - -- Next source, if any - - Source_Id := Source.Next; - end loop; - - if Need_To_Rebuild_Archive and then (not Data.Library) then - Need_To_Rebuild_Global_Archive := True; - end if; - - -- If there was no compilation error and -c was not used, - -- build / rebuild the archive if necessary. - - if not Local_Errors - and then Data.Library - and then not Data.Langs (Ada_Language_Index) - and then not Compile_Only - then - Build_Library (Project, Need_To_Rebuild_Archive); - end if; - end if; - end loop; - end Compile_Sources; - - --------------- - -- Copyright -- - --------------- - - procedure Copyright is - begin - -- Only output the Copyright notice once - - if not Copyright_Output then - Copyright_Output := True; - Write_Eol; - Write_Str ("GPRMAKE "); - Write_Str (Gnatvsn.Gnat_Version_String); - Write_Str (" Copyright 2004-"); - Write_Str (Gnatvsn.Current_Year); - Write_Str (" Free Software Foundation, Inc."); - Write_Eol; - end if; - end Copyright; - - ------------------------------------ - -- Create_Archive_Dependency_File -- - ------------------------------------ - - procedure Create_Archive_Dependency_File - (Name : String; - First_Source : Other_Source_Id) - is - Source_Id : Other_Source_Id; - Source : Other_Source; - Dep_File : Ada.Text_IO.File_Type; - - begin - -- Create the file in Append mode, to avoid automatic insertion of - -- an end of line if file is empty. - - Create (Dep_File, Append_File, Name); - - Source_Id := First_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - Put_Line (Dep_File, Get_Name_String (Source.Object_Name)); - Put_Line (Dep_File, String (Source.Object_TS)); - Source_Id := Source.Next; - end loop; - - Close (Dep_File); - - exception - when others => - if Is_Open (Dep_File) then - Close (Dep_File); - end if; - end Create_Archive_Dependency_File; - - ------------------------------------------- - -- Create_Global_Archive_Dependency_File -- - ------------------------------------------- - - procedure Create_Global_Archive_Dependency_File (Name : String) is - Source_Id : Other_Source_Id; - Source : Other_Source; - Dep_File : Ada.Text_IO.File_Type; - - begin - -- Create the file in Append mode, to avoid automatic insertion of - -- an end of line if file is empty. - - Create (Dep_File, Append_File, Name); - - -- Get all the object files of non-Ada sources in non-library projects - - for Project in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - if not Project_Tree.Projects.Table (Project).Library then - Source_Id := - Project_Tree.Projects.Table (Project).First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := Project_Tree.Other_Sources.Table (Source_Id); - - -- Put only those object files that are in the global archive - - if Is_Included_In_Global_Archive - (Source.Object_Name, Project) - then - Put_Line (Dep_File, Get_Name_String (Source.Object_Path)); - Put_Line (Dep_File, String (Source.Object_TS)); - end if; - - Source_Id := Source.Next; - end loop; - end if; - end loop; - - Close (Dep_File); - - exception - when others => - if Is_Open (Dep_File) then - Close (Dep_File); - end if; - end Create_Global_Archive_Dependency_File; - - --------------------- - -- Display_Command -- - --------------------- - - procedure Display_Command - (Name : String; - Path : String_Access; - CPATH : String_Access := null; - Ellipse : Boolean := False) - is - Display_Ellipse : Boolean := Ellipse; - - begin - -- Only display the command in Verbose Mode (-v) or when - -- not in Quiet Output (no -q). - - if Verbose_Mode or (not Quiet_Output) then - - -- In Verbose Mode output the full path of the spawned process - - if Verbose_Mode then - if CPATH /= null then - Write_Str ("CPATH = "); - Write_Line (CPATH.all); - end if; - - Write_Str (Path.all); - - else - Write_Str (Name); - end if; - - -- Display only the arguments for which the display flag is set - -- (in Verbose Mode, the display flag is set for all arguments) - - for Arg in 1 .. Last_Argument loop - if Arguments_Displayed (Arg) then - Write_Char (' '); - Write_Str (Arguments (Arg).all); - - elsif Display_Ellipse then - Write_Str (" ..."); - Display_Ellipse := False; - end if; - end loop; - - Write_Eol; - end if; - end Display_Command; - - ------------------ - -- Get_Compiler -- - ------------------ - - procedure Get_Compiler (For_Language : First_Language_Indexes) is - Data : constant Project_Data := - Project_Tree.Projects.Table (Main_Project); - - Ide : constant Package_Id := - Value_Of - (Name_Ide, - In_Packages => Data.Decl.Packages, - In_Tree => Project_Tree); - -- The id of the package IDE in the project file - - Compiler : constant Variable_Value := - Value_Of - (Name => Language_Names.Table (For_Language), - Index => 0, - Attribute_Or_Array_Name => Name_Compiler_Command, - In_Package => Ide, - In_Tree => Project_Tree); - -- The value of Compiler_Command ("language") in package IDE, if defined - - begin - -- No need to do it again if the compiler is known for this language - - if Compiler_Names (For_Language) = null then - - -- If compiler command is not defined for this language in package - -- IDE, use the default compiler for this language. - - if Compiler = Nil_Variable_Value then - if For_Language in Default_Compiler_Names'Range then - Compiler_Names (For_Language) := - Default_Compiler_Names (For_Language); - - else - Osint.Fail - ("unknown compiler name for language """, - Get_Name_String (Language_Names.Table (For_Language)), - """"); - end if; - - else - Compiler_Names (For_Language) := - new String'(Get_Name_String (Compiler.Value)); - end if; - - -- Check we have a GCC compiler (name ends with "gcc" or "g++") - - declare - Comp_Name : constant String := Compiler_Names (For_Language).all; - Last3 : String (1 .. 3); - begin - if Comp_Name'Length >= 3 then - Last3 := Comp_Name (Comp_Name'Last - 2 .. Comp_Name'Last); - Compiler_Is_Gcc (For_Language) := - (Last3 = "gcc") or (Last3 = "g++"); - else - Compiler_Is_Gcc (For_Language) := False; - end if; - end; - - -- Locate the compiler on the path - - Compiler_Paths (For_Language) := - Locate_Exec_On_Path (Compiler_Names (For_Language).all); - - -- Fail if compiler cannot be found - - if Compiler_Paths (For_Language) = null then - if For_Language = Ada_Language_Index then - Osint.Fail - ("unable to locate """, - Compiler_Names (For_Language).all, - """"); - - else - Osint.Fail - ("unable to locate " & - Get_Name_String (Language_Names.Table (For_Language)), - " compiler """, Compiler_Names (For_Language).all & '"'); - end if; - end if; - end if; - end Get_Compiler; - - ------------------------------ - -- Get_Imported_Directories -- - ------------------------------ - - procedure Get_Imported_Directories - (Project : Project_Id; - Data : in out Project_Data) - is - Imported_Projects : Project_List := Data.Imported_Projects; - - Path_Length : Natural := 0; - Position : Natural := 0; - - procedure Add (Source_Dirs : String_List_Id); - -- Add a list of source directories - - procedure Recursive_Get_Dirs (Prj : Project_Id); - -- Recursive procedure to get the source directories of this project - -- file and of the project files it imports, in the correct order. - - --------- - -- Add -- - --------- - - procedure Add (Source_Dirs : String_List_Id) is - Element_Id : String_List_Id; - Element : String_Element; - Add_Arg : Boolean := True; - - begin - -- Add each source directory path name, preceded by "-I" to Arguments - - Element_Id := Source_Dirs; - while Element_Id /= Nil_String loop - Element := Project_Tree.String_Elements.Table (Element_Id); - - if Element.Value /= No_Name then - Get_Name_String (Element.Display_Value); - - if Name_Len > 0 then - - -- Remove a trailing directory separator: this may cause - -- problems on Windows. - - if Name_Len > 1 - and then Name_Buffer (Name_Len) = Directory_Separator - then - Name_Len := Name_Len - 1; - end if; - - declare - Arg : constant String := - "-I" & Name_Buffer (1 .. Name_Len); - begin - -- Check if directory is already in the list. If it is, - -- no need to put it there again. - - Add_Arg := True; - - for Index in 1 .. Last_Argument loop - if Arguments (Index).all = Arg then - Add_Arg := False; - exit; - end if; - end loop; - - if Add_Arg then - if Path_Length /= 0 then - Path_Length := Path_Length + 1; - end if; - - Path_Length := Path_Length + Name_Len; - - Add_Argument (Arg, True); - end if; - end; - end if; - end if; - - Element_Id := Element.Next; - end loop; - end Add; - - ------------------------ - -- Recursive_Get_Dirs -- - ------------------------ - - procedure Recursive_Get_Dirs (Prj : Project_Id) is - Data : Project_Data; - Imported : Project_List; - - begin - -- Nothing to do if project is undefined - - if Prj /= No_Project then - Data := Project_Tree.Projects.Table (Prj); - - -- Nothing to do if project has already been processed - - if not Data.Seen then - - -- Mark the project as processed, to avoid multiple processing - -- of the same project. - - Project_Tree.Projects.Table (Prj).Seen := True; - - -- Add the source directories of this project - - if not Data.Virtual then - Add (Data.Source_Dirs); - end if; - - Recursive_Get_Dirs (Data.Extends); - - -- Call itself for all imported projects, if any - - Imported := Data.Imported_Projects; - while Imported /= Empty_Project_List loop - Recursive_Get_Dirs - (Project_Tree.Project_Lists.Table (Imported).Project); - Imported := - Project_Tree.Project_Lists.Table (Imported).Next; - end loop; - end if; - end if; - end Recursive_Get_Dirs; - - -- Start of processing for Get_Imported_Directories - - begin - -- First, mark all project as not processed - - for J in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Project_Tree.Projects.Table (J).Seen := False; - end loop; - - -- Empty Arguments - - Last_Argument := 0; - - -- Process this project individually, project data are already known - - Project_Tree.Projects.Table (Project).Seen := True; - - Add (Data.Source_Dirs); - - Recursive_Get_Dirs (Data.Extends); - - while Imported_Projects /= Empty_Project_List loop - Recursive_Get_Dirs - (Project_Tree.Project_Lists.Table - (Imported_Projects).Project); - Imported_Projects := Project_Tree.Project_Lists.Table - (Imported_Projects).Next; - end loop; - - Data.Imported_Directories_Switches := - new Argument_List'(Arguments (1 .. Last_Argument)); - - -- Create the Include_Path, from the Arguments - - Data.Include_Path := new String (1 .. Path_Length); - Data.Include_Path (1 .. Arguments (1)'Length - 2) := - Arguments (1)(Arguments (1)'First + 2 .. Arguments (1)'Last); - Position := Arguments (1)'Length - 2; - - for Arg in 2 .. Last_Argument loop - Position := Position + 1; - Data.Include_Path (Position) := Path_Separator; - Data.Include_Path - (Position + 1 .. Position + Arguments (Arg)'Length - 2) := - Arguments (Arg)(Arguments (Arg)'First + 2 .. Arguments (Arg)'Last); - Position := Position + Arguments (Arg)'Length - 2; - end loop; - - Last_Argument := 0; - end Get_Imported_Directories; - - ------------- - -- Gprmake -- - ------------- - - procedure Gprmake is - begin - Makegpr.Initialize; - - if Verbose_Mode then - Write_Eol; - Write_Str ("Parsing project file """); - Write_Str (Project_File_Name.all); - Write_Str ("""."); - Write_Eol; - end if; - - -- Parse and process project files for other languages (not for Ada) - - Prj.Pars.Parse - (Project => Main_Project, - In_Tree => Project_Tree, - Project_File_Name => Project_File_Name.all, - Packages_To_Check => Packages_To_Check); - - -- Fail if parsing/processing was unsuccessful - - if Main_Project = No_Project then - Osint.Fail ("""", Project_File_Name.all, """ processing failed"); - end if; - - if Verbose_Mode then - Write_Eol; - Write_Str ("Parsing of project file """); - Write_Str (Project_File_Name.all); - Write_Str (""" is finished."); - Write_Eol; - end if; - - -- If -f was specified, we will certainly need to link (except when - -- -u or -c were specified, of course). - - Need_To_Relink := Force_Compilations; - - if Unique_Compile then - if Mains.Number_Of_Mains = 0 then - Osint.Fail - ("No source specified to compile in 'unique compile' mode"); - else - Compile_Individual_Sources; - Report_Total_Errors ("compilation"); - end if; - - else - declare - Data : constant Prj.Project_Data := - Project_Tree.Projects.Table (Main_Project); - begin - if Data.Library and then Mains.Number_Of_Mains /= 0 then - Osint.Fail - ("Cannot specify mains on the command line " & - "for a Library Project"); - end if; - - -- First check for C++, to link libraries with g++, - -- rather than gcc. - - Check_For_C_Plus_Plus; - - -- Compile sources and build archives for library project, - -- if necessary. - - Compile_Sources; - - -- When Keep_Going is True, if we had some errors, fail now, - -- reporting the number of compilation errors. - -- Do not attempt to link. - - Report_Total_Errors ("compilation"); - - -- If -c was not specified, link the executables, - -- if there are any. - - if not Compile_Only - and then not Data.Library - and then Data.Object_Directory /= No_Path_Information - then - Build_Global_Archive; - Link_Executables; - end if; - - -- When Keep_Going is True, if we had some errors, fail, reporting - -- the number of linking errors. - - Report_Total_Errors ("linking"); - end; - end if; - end Gprmake; - - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize is - begin - Set_Mode (Ada_Only); - - -- Do some necessary package initializations - - Csets.Initialize; - Namet.Initialize; - Snames.Initialize; - Prj.Initialize (Project_Tree); - Mains.Delete; - - -- Add the directory where gprmake is invoked in front of the path, - -- if gprmake is invoked from a bin directory or with directory - -- information. Only do this if the platform is not VMS, where the - -- notion of path does not really exist. - - -- Below code shares nasty code duplication with make.adb code??? - - if not OpenVMS then - declare - Prefix : constant String := Executable_Prefix_Path; - Command : constant String := Command_Name; - - begin - if Prefix'Length > 0 then - declare - PATH : constant String := - Prefix & Directory_Separator & "bin" & - Path_Separator & - Getenv ("PATH").all; - begin - Setenv ("PATH", PATH); - end; - - else - for Index in reverse Command'Range loop - if Command (Index) = Directory_Separator then - declare - Absolute_Dir : constant String := - Normalize_Pathname - (Command (Command'First .. Index)); - PATH : constant String := - Absolute_Dir & - Path_Separator & - Getenv ("PATH").all; - begin - Setenv ("PATH", PATH); - end; - - exit; - end if; - end loop; - end if; - end; - end if; - - -- Set Name_Ide and Name_Compiler_Command - - Name_Len := 0; - Add_Str_To_Name_Buffer ("ide"); - Name_Ide := Name_Find; - - Name_Len := 0; - Add_Str_To_Name_Buffer ("compiler_command"); - Name_Compiler_Command := Name_Find; - - -- Make sure the Saved_Switches table is empty - - Saved_Switches.Set_Last (0); - - -- Get the command line arguments - - Scan_Args : for Next_Arg in 1 .. Argument_Count loop - Scan_Arg (Argument (Next_Arg)); - end loop Scan_Args; - - -- Fail if command line ended with "-P" - - if Project_File_Name_Expected then - Osint.Fail ("project file name missing after -P"); - - -- Or if it ended with "-o" - - elsif Output_File_Name_Expected then - Osint.Fail ("output file name missing after -o"); - end if; - - -- If no project file was specified, display the usage and fail - - if Project_File_Name = null then - Usage; - Exit_Program (E_Success); - end if; - - -- To be able of finding libgnat.a in MLib.Tgt, we need to have the - -- default search dirs established in Osint. - - Osint.Add_Default_Search_Dirs; - end Initialize; - - ----------------------------------- - -- Is_Included_In_Global_Archive -- - ----------------------------------- - - function Is_Included_In_Global_Archive - (Object_Name : File_Name_Type; - Project : Project_Id) return Boolean - is - Data : Project_Data := Project_Tree.Projects.Table (Project); - Source : Other_Source_Id; - - begin - while Data.Extended_By /= No_Project loop - Data := Project_Tree.Projects.Table (Data.Extended_By); - - Source := Data.First_Other_Source; - while Source /= No_Other_Source loop - if Project_Tree.Other_Sources.Table (Source).Object_Name = - Object_Name - then - return False; - else - Source := - Project_Tree.Other_Sources.Table (Source).Next; - end if; - end loop; - end loop; - - return True; - end Is_Included_In_Global_Archive; - - ---------------------- - -- Link_Executables -- - ---------------------- - - procedure Link_Executables is - Data : constant Project_Data := - Project_Tree.Projects.Table (Main_Project); - - Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0; - -- True if main sources were specified on the command line - - Object_Dir : constant String := - Get_Name_String (Data.Object_Directory.Display_Name); - -- Path of the object directory of the main project - - Source_Id : Other_Source_Id; - Source : Other_Source; - Success : Boolean; - - Linker_Name : String_Access; - Linker_Path : String_Access; - -- The linker name and path, when linking is not done by gnatlink - - Link_Done : Boolean := False; - -- Set to True when the linker is invoked directly (not through - -- gnatmake) to be able to report if mains were up to date at the end - -- of execution. - - procedure Add_C_Plus_Plus_Link_For_Gnatmake; - -- Add the --LINK= switch for gnatlink, depending on the C++ compiler - - procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type); - -- Check if there is an archive that is more recent than the executable - -- to decide if we need to relink. - - procedure Choose_C_Plus_Plus_Link_Process; - -- If the C++ compiler is not g++, create the correct script to link - - procedure Link_Foreign - (Main : String; - Main_Id : File_Name_Type; - Source : Other_Source); - -- Link a non-Ada main, when there is no Ada code - - --------------------------------------- - -- Add_C_Plus_Plus_Link_For_Gnatmake -- - --------------------------------------- - - procedure Add_C_Plus_Plus_Link_For_Gnatmake is - begin - Add_Argument - ("--LINK=" & Compiler_Names (C_Plus_Plus_Language_Index).all, - Verbose_Mode); - end Add_C_Plus_Plus_Link_For_Gnatmake; - - ----------------------- - -- Check_Time_Stamps -- - ----------------------- - - procedure Check_Time_Stamps (Exec_Time_Stamp : Time_Stamp_Type) is - Prj_Data : Project_Data; - - begin - for Prj in Project_Table.First .. - Project_Table.Last (Project_Tree.Projects) - loop - Prj_Data := Project_Tree.Projects.Table (Prj); - - -- There is an archive only in project - -- files with sources other than Ada - -- sources. - - if Data.Other_Sources_Present then - declare - Archive_Path : constant String := Get_Name_String - (Prj_Data.Object_Directory.Display_Name) - & Directory_Separator - & "lib" & Get_Name_String (Prj_Data.Display_Name) - & '.' & Archive_Ext; - Archive_TS : Time_Stamp_Type; - begin - Name_Len := 0; - Add_Str_To_Name_Buffer (Archive_Path); - Archive_TS := File_Stamp (File_Name_Type'(Name_Find)); - - -- If the archive is later than the - -- executable, we need to relink. - - if Archive_TS /= Empty_Time_Stamp - and then - Exec_Time_Stamp < Archive_TS - then - Need_To_Relink := True; - - if Verbose_Mode then - Write_Str (" -> "); - Write_Str (Archive_Path); - Write_Str (" has time stamp "); - Write_Str ("later than "); - Write_Line ("executable"); - end if; - - exit; - end if; - end; - end if; - end loop; - end Check_Time_Stamps; - - ------------------------------------- - -- Choose_C_Plus_Plus_Link_Process -- - ------------------------------------- - - procedure Choose_C_Plus_Plus_Link_Process is - begin - if Compiler_Names (C_Plus_Plus_Language_Index) = null then - Get_Compiler (C_Plus_Plus_Language_Index); - end if; - end Choose_C_Plus_Plus_Link_Process; - - ------------------ - -- Link_Foreign -- - ------------------ - - procedure Link_Foreign - (Main : String; - Main_Id : File_Name_Type; - Source : Other_Source) - is - Executable_Name : constant String := - Get_Name_String - (Executable_Of - (Project => Main_Project, - In_Tree => Project_Tree, - Main => Main_Id, - Index => 0, - Ada_Main => False)); - -- File name of the executable - - Executable_Path : constant String := - Get_Name_String - (Data.Exec_Directory.Display_Name) & - Directory_Separator & Executable_Name; - -- Path name of the executable - - Exec_Time_Stamp : Time_Stamp_Type; - - begin - -- Now, check if the executable is up to date. It is considered - -- up to date if its time stamp is not earlier that the time stamp - -- of any archive. Only do that if we don't know if we need to link. - - if not Need_To_Relink then - - -- Get the time stamp of the executable - - Name_Len := 0; - Add_Str_To_Name_Buffer (Executable_Path); - Exec_Time_Stamp := File_Stamp (File_Name_Type'(Name_Find)); - - if Verbose_Mode then - Write_Str (" Checking executable "); - Write_Line (Executable_Name); - end if; - - -- If executable does not exist, we need to link - - if Exec_Time_Stamp = Empty_Time_Stamp then - Need_To_Relink := True; - - if Verbose_Mode then - Write_Line (" -> not found"); - end if; - - -- Otherwise, get the time stamps of each archive. If one of - -- them is found later than the executable, we need to relink. - - else - Check_Time_Stamps (Exec_Time_Stamp); - end if; - - -- If Need_To_Relink is False, we are done - - if Verbose_Mode and (not Need_To_Relink) then - Write_Line (" -> up to date"); - end if; - end if; - - -- Prepare to link - - if Need_To_Relink then - Link_Done := True; - - Last_Argument := 0; - - -- Specify the executable path name - - Add_Argument (Dash_o, True); - Add_Argument - (Get_Name_String (Data.Exec_Directory.Display_Name) & - Directory_Separator & - Get_Name_String - (Executable_Of - (Project => Main_Project, - In_Tree => Project_Tree, - Main => Main_Id, - Index => 0, - Ada_Main => False)), - True); - - -- Specify the object file of the main source - - Add_Argument - (Object_Dir & Directory_Separator & - Get_Name_String (Source.Object_Name), - True); - - -- Add all the archives, in a correct order - - Add_Archives (For_Gnatmake => False); - - -- Add the switches specified in package Linker of - -- the main project. - - Add_Switches - (Data => Data, - Proc => Linker, - Language => Source.Language, - File_Name => Main_Id); - - -- Add the switches specified in attribute - -- Linker_Options of packages Linker. - - if Link_Options_Switches = null then - Link_Options_Switches := - new Argument_List' - (Linker_Options_Switches (Main_Project, Project_Tree)); - end if; - - Add_Arguments (Link_Options_Switches.all, True); - - -- Add the linking options specified on the - -- command line. - - for Arg in 1 .. Linker_Options.Last loop - Add_Argument (Linker_Options.Table (Arg), True); - end loop; - - -- If there are shared libraries and the run path - -- option is supported, add the run path switch. - - if Lib_Path.Last > 0 then - Add_Argument - (Path_Option.all & - String (Lib_Path.Table (1 .. Lib_Path.Last)), - Verbose_Mode); - end if; - - -- And invoke the linker - - Display_Command (Linker_Name.all, Linker_Path); - Spawn - (Linker_Path.all, - Arguments (1 .. Last_Argument), - Success); - - if not Success then - Report_Error ("could not link ", Main); - end if; - end if; - end Link_Foreign; - - -- Start of processing of Link_Executables - - begin - -- If no mains specified, get mains from attribute Main, if it exists - - if not Mains_Specified then - declare - Element_Id : String_List_Id; - Element : String_Element; - - begin - Element_Id := Data.Mains; - while Element_Id /= Nil_String loop - Element := Project_Tree.String_Elements.Table (Element_Id); - - if Element.Value /= No_Name then - Mains.Add_Main (Get_Name_String (Element.Value)); - end if; - - Element_Id := Element.Next; - end loop; - end; - end if; - - if Mains.Number_Of_Mains = 0 then - - -- If the attribute Main is an empty list or not specified, - -- there is nothing to do. - - if Verbose_Mode then - Write_Line ("No main to link"); - end if; - return; - end if; - - -- Check if -o was used for several mains - - if Output_File_Name /= null and then Mains.Number_Of_Mains > 1 then - Osint.Fail ("cannot specify an executable name for several mains"); - end if; - - -- Check how we are going to do the link - - if not Data.Other_Sources_Present then - - -- Only Ada sources in the main project, and even maybe not - - if Data.Extends = No_Project and then - not Data.Langs (Ada_Language_Index) - then - -- Fail if the main project has no source of any language - - Osint.Fail - ("project """, - Get_Name_String (Data.Name), - """ has no sources, so no main can be linked"); - - else - -- Only Ada sources in the main project, call gnatmake directly - - Last_Argument := 0; - - -- Choose correct linker if there is C++ code in other projects - - if C_Plus_Plus_Is_Used then - Choose_C_Plus_Plus_Link_Process; - Add_Argument (Dash_largs, Verbose_Mode); - Add_C_Plus_Plus_Link_For_Gnatmake; - Add_Argument (Dash_margs, Verbose_Mode); - end if; - - Compile_Link_With_Gnatmake (Mains_Specified); - end if; - - else - -- There are other language sources. First check if there are also - -- sources in Ada. - - if Data.Langs (Ada_Language_Index) then - - -- There is a mix of Ada and other language sources in the main - -- project. Any main that is not a source of the other languages - -- will be deemed to be an Ada main. - - -- Find the mains of the other languages and the Ada mains - - Mains.Reset; - Ada_Mains.Set_Last (0); - Other_Mains.Set_Last (0); - - -- For each main - - loop - declare - Main : constant String := Mains.Next_Main; - Main_Id : File_Name_Type; - - begin - exit when Main'Length = 0; - - -- Get the main file name - - Name_Len := 0; - Add_Str_To_Name_Buffer (Main); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Main_Id := Name_Find; - - -- Check if it is a source of a language other than Ada - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := - Project_Tree.Other_Sources.Table (Source_Id); - exit when Source.File_Name = Main_Id; - Source_Id := Source.Next; - end loop; - - -- If it is not, put it in the list of Ada mains - - if Source_Id = No_Other_Source then - Ada_Mains.Increment_Last; - Ada_Mains.Table (Ada_Mains.Last) := new String'(Main); - - -- Otherwise, put it in the list of other mains - - else - Other_Mains.Increment_Last; - Other_Mains.Table (Other_Mains.Last) := Source; - end if; - end; - end loop; - - -- If C++ is one of the other language, create the shell script - -- to do the link. - - if C_Plus_Plus_Is_Used then - Choose_C_Plus_Plus_Link_Process; - end if; - - -- Call gnatmake with the necessary switches for each non-Ada - -- main, if there are some. - - for Main in 1 .. Other_Mains.Last loop - declare - Source : constant Other_Source := Other_Mains.Table (Main); - - begin - Last_Argument := 0; - - -- Add -o if -o was specified - - if Output_File_Name = null then - Add_Argument (Dash_o, True); - Add_Argument - (Get_Name_String - (Executable_Of - (Project => Main_Project, - In_Tree => Project_Tree, - Main => Other_Mains.Table (Main).File_Name, - Index => 0, - Ada_Main => False)), - True); - end if; - - -- Call gnatmake with the -B switch - - Add_Argument (Dash_B, True); - - -- Add to the linking options the object file of the source - - Add_Argument (Dash_largs, Verbose_Mode); - Add_Argument - (Get_Name_String (Source.Object_Name), Verbose_Mode); - - -- If C++ is one of the language, add the --LINK switch - -- to the linking switches. - - if C_Plus_Plus_Is_Used then - Add_C_Plus_Plus_Link_For_Gnatmake; - end if; - - -- Add -margs so that the following switches are for - -- gnatmake - - Add_Argument (Dash_margs, Verbose_Mode); - - -- And link with gnatmake - - Compile_Link_With_Gnatmake (Mains_Specified => False); - end; - end loop; - - -- If there are also Ada mains, call gnatmake for all these mains - - if Ada_Mains.Last /= 0 then - Last_Argument := 0; - - -- Put all the Ada mains as the first arguments - - for Main in 1 .. Ada_Mains.Last loop - Add_Argument (Ada_Mains.Table (Main).all, True); - end loop; - - -- If C++ is one of the languages, add the --LINK switch to - -- the linking switches. - - if Data.Langs (C_Plus_Plus_Language_Index) then - Add_Argument (Dash_largs, Verbose_Mode); - Add_C_Plus_Plus_Link_For_Gnatmake; - Add_Argument (Dash_margs, Verbose_Mode); - end if; - - -- And link with gnatmake - - Compile_Link_With_Gnatmake (Mains_Specified => False); - end if; - - else - -- No Ada source in main project - - -- First, get the linker to invoke - - if Data.Langs (C_Plus_Plus_Language_Index) then - Get_Compiler (C_Plus_Plus_Language_Index); - Linker_Name := Compiler_Names (C_Plus_Plus_Language_Index); - Linker_Path := Compiler_Paths (C_Plus_Plus_Language_Index); - - else - Get_Compiler (C_Language_Index); - Linker_Name := Compiler_Names (C_Language_Index); - Linker_Path := Compiler_Paths (C_Language_Index); - end if; - - Link_Done := False; - - Mains.Reset; - - -- Get each main, check if it is a source of the main project, - -- and if it is, invoke the linker. - - loop - declare - Main : constant String := Mains.Next_Main; - Main_Id : File_Name_Type; - - begin - exit when Main'Length = 0; - - -- Get the file name of the main - - Name_Len := 0; - Add_Str_To_Name_Buffer (Main); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Main_Id := Name_Find; - - -- Check if it is a source of the main project file - - Source_Id := Data.First_Other_Source; - while Source_Id /= No_Other_Source loop - Source := - Project_Tree.Other_Sources.Table (Source_Id); - exit when Source.File_Name = Main_Id; - Source_Id := Source.Next; - end loop; - - -- Report an error if it is not - - if Source_Id = No_Other_Source then - Report_Error - (Main, "is not a source of project ", - Get_Name_String (Data.Name)); - - else - Link_Foreign (Main, Main_Id, Source); - end if; - end; - end loop; - - -- If no linking was done, report it, except in Quiet Output - - if (Verbose_Mode or (not Quiet_Output)) and (not Link_Done) then - Osint.Write_Program_Name; - - if Mains.Number_Of_Mains = 1 then - - -- If there is only one executable, report its name too - - Write_Str (": """); - Mains.Reset; - - declare - Main : constant String := Mains.Next_Main; - Main_Id : File_Name_Type; - begin - Name_Len := 0; - Add_Str_To_Name_Buffer (Main); - Main_Id := Name_Find; - Write_Str - (Get_Name_String - (Executable_Of - (Project => Main_Project, - In_Tree => Project_Tree, - Main => Main_Id, - Index => 0, - Ada_Main => False))); - Write_Line (""" up to date"); - end; - - else - Write_Line (": all executables up to date"); - end if; - end if; - end if; - end if; - end Link_Executables; - - ------------------ - -- Report_Error -- - ------------------ - - procedure Report_Error - (S1 : String; - S2 : String := ""; - S3 : String := "") - is - begin - -- If Keep_Going is True, output error message preceded by error header - - if Keep_Going then - Total_Number_Of_Errors := Total_Number_Of_Errors + 1; - Write_Str (Error_Header); - Write_Str (S1); - Write_Str (S2); - Write_Str (S3); - Write_Eol; - - -- Otherwise just fail - - else - Osint.Fail (S1, S2, S3); - end if; - end Report_Error; - - ------------------------- - -- Report_Total_Errors -- - ------------------------- - - procedure Report_Total_Errors (Kind : String) is - begin - if Total_Number_Of_Errors /= 0 then - if Total_Number_Of_Errors = 1 then - Osint.Fail - ("One ", Kind, " error"); - - else - Osint.Fail - ("Total of" & Total_Number_Of_Errors'Img, - ' ' & Kind & " errors"); - end if; - end if; - end Report_Total_Errors; - - -------------- - -- Scan_Arg -- - -------------- - - procedure Scan_Arg (Arg : String) is - begin - pragma Assert (Arg'First = 1); - - if Arg'Length = 0 then - return; - end if; - - -- If preceding switch was -P, a project file name need to be - -- specified, not a switch. - - if Project_File_Name_Expected then - if Arg (1) = '-' then - Osint.Fail ("project file name missing after -P"); - else - Project_File_Name_Expected := False; - Project_File_Name := new String'(Arg); - end if; - - -- If preceding switch was -o, an executable name need to be - -- specified, not a switch. - - elsif Output_File_Name_Expected then - if Arg (1) = '-' then - Osint.Fail ("output file name missing after -o"); - else - Output_File_Name_Expected := False; - Output_File_Name := new String'(Arg); - end if; - - -- Set the processor/language for the following switches - - -- -cargs: Ada compiler arguments - - elsif Arg = "-cargs" then - Current_Language := Ada_Language_Index; - Current_Processor := Compiler; - - elsif Arg'Length > 7 and then Arg (1 .. 7) = "-cargs:" then - Name_Len := 0; - Add_Str_To_Name_Buffer (Arg (8 .. Arg'Last)); - To_Lower (Name_Buffer (1 .. Name_Len)); - - declare - Lang : constant Name_Id := Name_Find; - begin - Current_Language := Language_Indexes.Get (Lang); - - if Current_Language = No_Language_Index then - Add_Language_Name (Lang); - Current_Language := Last_Language_Index; - end if; - - Current_Processor := Compiler; - end; - - elsif Arg = "-largs" then - Current_Processor := Linker; - - -- -gargs: gprmake - - elsif Arg = "-gargs" then - Current_Processor := None; - - -- A special test is needed for the -o switch within a -largs since - -- that is another way to specify the name of the final executable. - - elsif Current_Processor = Linker and then Arg = "-o" then - Osint.Fail - ("switch -o not allowed within a -largs. Use -o directly."); - - -- If current processor is not gprmake directly, store the option in - -- the appropriate table. - - elsif Current_Processor /= None then - Add_Option (Arg); - - -- Switches start with '-' - - elsif Arg (1) = '-' then - if Arg'Length > 3 and then Arg (1 .. 3) = "-aP" then - Add_Search_Project_Directory (Arg (4 .. Arg'Last)); - - -- Record the switch, so that it is passed to gnatmake, if - -- gnatmake is called. - - Saved_Switches.Append (new String'(Arg)); - - elsif Arg = "-c" then - Compile_Only := True; - - -- Make sure that when a main is specified and switch -c is used, - -- only the main(s) is/are compiled. - - if Mains.Number_Of_Mains > 0 then - Unique_Compile := True; - end if; - - elsif Arg = "-d" then - Display_Compilation_Progress := True; - - elsif Arg = "-eL" then - Follow_Links_For_Files := True; - - elsif Arg = "-f" then - Force_Compilations := True; - - elsif Arg = "-h" then - Usage; - - elsif Arg = "-k" then - Keep_Going := True; - - elsif Arg = "-o" then - if Output_File_Name /= null then - Osint.Fail ("cannot specify several -o switches"); - - else - Output_File_Name_Expected := True; - end if; - - elsif Arg'Length >= 2 and then Arg (2) = 'P' then - if Project_File_Name /= null then - Osint.Fail ("cannot have several project files specified"); - - elsif Arg'Length = 2 then - Project_File_Name_Expected := True; - - else - Project_File_Name := new String'(Arg (3 .. Arg'Last)); - end if; - - elsif Arg = "-p" or else Arg = "--create-missing-dirs" then - Setup_Projects := True; - - elsif Arg = "-q" then - Quiet_Output := True; - - elsif Arg = "-u" then - Unique_Compile := True; - Compile_Only := True; - - elsif Arg = "-v" then - Verbose_Mode := True; - Copyright; - - elsif Arg'Length = 4 and then Arg (1 .. 3) = "-vP" - and then Arg (4) in '0' .. '2' - then - case Arg (4) is - when '0' => - Current_Verbosity := Prj.Default; - when '1' => - Current_Verbosity := Prj.Medium; - when '2' => - Current_Verbosity := Prj.High; - when others => - null; - end case; - - elsif Arg'Length >= 3 and then Arg (2) = 'X' - and then Is_External_Assignment (Arg) - then - -- Is_External_Assignment has side effects when it returns True - - -- Record the -X switch, so that it will be passed to gnatmake, - -- if gnatmake is called. - - Saved_Switches.Append (new String'(Arg)); - - else - Osint.Fail ("illegal option """, Arg, """"); - end if; - - else - -- Not a switch: must be a main - - Mains.Add_Main (Arg); - - -- Make sure that when a main is specified and switch -c is used, - -- only the main(s) is/are compiled. - - if Compile_Only then - Unique_Compile := True; - end if; - end if; - end Scan_Arg; - - ----------------- - -- Strip_CR_LF -- - ----------------- - - function Strip_CR_LF (Text : String) return String is - To : String (1 .. Text'Length); - Index_To : Natural := 0; - - begin - for Index in Text'Range loop - if (Text (Index) /= ASCII.CR) and then (Text (Index) /= ASCII.LF) then - Index_To := Index_To + 1; - To (Index_To) := Text (Index); - end if; - end loop; - - return To (1 .. Index_To); - end Strip_CR_LF; - - ----------- - -- Usage -- - ----------- - - procedure Usage is - begin - if not Usage_Output then - Usage_Output := True; - Copyright; - - Write_Str ("Usage: "); - Osint.Write_Program_Name; - Write_Str (" -P<project file> [opts] [name] {"); - Write_Str ("[-cargs:lang opts] "); - Write_Str ("[-largs opts] [-gargs opts]}"); - Write_Eol; - Write_Eol; - Write_Str (" name is zero or more file names"); - Write_Eol; - Write_Eol; - - -- GPRMAKE switches - - Write_Str ("gprmake switches:"); - Write_Eol; - - -- Line for -aP - - Write_Str (" -aPdir Add directory dir to project search path"); - Write_Eol; - - -- Line for -c - - Write_Str (" -c Compile only"); - Write_Eol; - - -- Line for -eL - - Write_Str (" -eL Follow symbolic links when processing " & - "project files"); - Write_Eol; - - -- Line for -f - - Write_Str (" -f Force recompilations"); - Write_Eol; - - -- Line for -k - - Write_Str (" -k Keep going after compilation errors"); - Write_Eol; - - -- Line for -o - - Write_Str (" -o name Choose an alternate executable name"); - Write_Eol; - - -- Line for -p - - Write_Str (" -p Create missing obj, lib and exec dirs"); - Write_Eol; - - -- Line for -P - - Write_Str (" -Pproj Use GNAT Project File proj"); - Write_Eol; - - -- Line for -q - - Write_Str (" -q Be quiet/terse"); - Write_Eol; - - -- Line for -u - - Write_Str - (" -u Unique compilation. Only compile the given files"); - Write_Eol; - - -- Line for -v - - Write_Str (" -v Verbose output"); - Write_Eol; - - -- Line for -vPx - - Write_Str (" -vPx Specify verbosity when parsing Project Files"); - Write_Eol; - - -- Line for -X - - Write_Str (" -Xnm=val Specify an external reference for " & - "Project Files"); - Write_Eol; - Write_Eol; - - -- Line for -cargs - - Write_Line (" -cargs opts opts are passed to the Ada compiler"); - - -- Line for -cargs:lang - - Write_Line (" -cargs:<lang> opts"); - Write_Line (" opts are passed to the compiler " & - "for language < lang > "); - - -- Line for -largs - - Write_Str (" -largs opts opts are passed to the linker"); - Write_Eol; - - -- Line for -gargs - - Write_Str (" -gargs opts opts directly interpreted by gprmake"); - Write_Eol; - Write_Eol; - - end if; - end Usage; - -begin - Makeutl.Do_Fail := Report_Error'Access; -end Makegpr; diff --git a/gcc/ada/makegpr.ads b/gcc/ada/makegpr.ads deleted file mode 100644 index 026118f6fbc..00000000000 --- a/gcc/ada/makegpr.ads +++ /dev/null @@ -1,34 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- M A K E G P R -- --- -- --- S p e c -- --- -- --- Copyright (C) 2004-2007, 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 3, 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 COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- The following package implements the facilities to compile, bind and/or --- link a set of Ada and non Ada sources, specified in Project Files. - -package Makegpr is - - procedure Gprmake; - -- The driver of gprmake - -end Makegpr; diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 3730199d69a..7e86facd99d 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -322,7 +322,8 @@ package body MLib.Prj is -- g-trasym.obj. Object_Directory_Path : constant String := - Get_Name_String (Data.Object_Directory.Display_Name); + Get_Name_String + (Data.Object_Directory.Display_Name); Standalone : constant Boolean := Data.Standalone_Library; @@ -1397,8 +1398,8 @@ package body MLib.Prj is if In_Main_Object_Directory or else Last < 5 - or else C_Filename (1 .. B_Start'Length) /= - B_Start.all + or else + C_Filename (1 .. B_Start'Length) /= B_Start.all then Name_Len := Last; Name_Buffer (1 .. Name_Len) := @@ -1439,8 +1440,8 @@ package body MLib.Prj is (In_Tree.Units) loop if In_Tree.Units.Table - (Index).File_Names - (Body_Part).Name /= No_File + (Index).File_Names + (Body_Part).Name /= No_File then Proj := In_Tree.Units.Table (Index). @@ -1448,7 +1449,7 @@ package body MLib.Prj is (Body_Part).Project; Fname := In_Tree.Units.Table (Index). - File_Names (Body_Part).Name; + File_Names (Body_Part).Name; elsif In_Tree.Units.Table @@ -1459,11 +1460,11 @@ package body MLib.Prj is Proj := In_Tree.Units.Table (Index).File_Names - (Specification).Project; + (Specification).Project; Fname := In_Tree.Units.Table (Index).File_Names - (Specification).Name; + (Specification).Name; else Proj := No_Project; @@ -1473,8 +1474,8 @@ package body MLib.Prj is -- If the source is in the -- project or a project it - -- extends, we may put it in the - -- library. + -- extends, we may put it in + -- the library. if Add_It then Add_It := Check_Project (Proj); diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb index 2eceb15db03..d743bb138e8 100644 --- a/gcc/ada/mlib-utl.adb +++ b/gcc/ada/mlib-utl.adb @@ -136,7 +136,7 @@ package body MLib.Utl is begin if Ar_Exec = null then - Ar_Name := Osint.Program_Name (Archive_Builder); + Ar_Name := Osint.Program_Name (Archive_Builder, "gnatmake"); Ar_Exec := Locate_Exec_On_Path (Ar_Name.all); if Ar_Exec = null then @@ -177,7 +177,7 @@ package body MLib.Utl is -- ranlib - Ranlib_Name := Osint.Program_Name (Archive_Indexer); + Ranlib_Name := Osint.Program_Name (Archive_Indexer, "gnatmake"); if Ranlib_Name'Length > 0 then Ranlib_Exec := Locate_Exec_On_Path (Ranlib_Name.all); @@ -408,7 +408,7 @@ package body MLib.Utl is if Driver_Name = No_Name then if Gcc_Exec = null then if Gcc_Name = null then - Gcc_Name := Osint.Program_Name ("gcc"); + Gcc_Name := Osint.Program_Name ("gcc", "gnatmake"); end if; Gcc_Exec := Locate_Exec_On_Path (Gcc_Name.all); diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index b226802cf07..993ecdf3578 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1874,8 +1874,10 @@ package body Osint is -- Program_Name -- ------------------ - function Program_Name (Nam : String) return String_Access is - Res : String_Access; + function Program_Name (Nam : String; Prog : String) return String_Access is + End_Of_Prefix : Natural := 0; + Start_Of_Prefix : Positive := 1; + Start_Of_Suffix : Positive; begin -- GNAAMP tool names require special treatment @@ -1907,34 +1909,42 @@ package body Osint is Find_Program_Name; - -- Find the target prefix if any, for the cross compilation case. - -- For instance in "alpha-dec-vxworks-gcc" the target prefix is - -- "alpha-dec-vxworks-" - - while Name_Len > 0 loop + Start_Of_Suffix := Name_Len + 1; - -- All done if we find the last hyphen + -- Find the target prefix if any, for the cross compilation case. + -- For instance in "powerpc-elf-gcc" the target prefix is + -- "powerpc-elf-" + -- Ditto for suffix, e.g. in "gcc-4.1", the suffix is "-4.1" - if Name_Buffer (Name_Len) = '-' then + for J in reverse 1 .. Name_Len loop + if Name_Buffer (J) = '/' + or else Name_Buffer (J) = Directory_Separator + or else Name_Buffer (J) = ':' + then + Start_Of_Prefix := J + 1; exit; + end if; + end loop; - -- If directory separator found, we don't want to look further - -- since in this case, no prefix has been found. + -- Find End_Of_Prefix - elsif Is_Directory_Separator (Name_Buffer (Name_Len)) then - Name_Len := 0; + for J in Start_Of_Prefix .. Name_Len - Prog'Length + 1 loop + if Name_Buffer (J .. J + Prog'Length - 1) = Prog then + End_Of_Prefix := J - 1; exit; end if; - - Name_Len := Name_Len - 1; end loop; + if End_Of_Prefix > 1 then + Start_Of_Suffix := End_Of_Prefix + Prog'Length + 1; + end if; + -- Create the new program name - Res := new String (1 .. Name_Len + Nam'Length); - Res.all (1 .. Name_Len) := Name_Buffer (1 .. Name_Len); - Res.all (Name_Len + 1 .. Name_Len + Nam'Length) := Nam; - return Res; + return new String' + (Name_Buffer (Start_Of_Prefix .. End_Of_Prefix) + & Nam + & Name_Buffer (Start_Of_Suffix .. Name_Len)); end Program_Name; ------------------------------ diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index d98588b76f3..6cf7530f7fe 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -105,7 +105,7 @@ package Osint is -- Put simple name of current program being run (excluding the directory -- path) in Name_Buffer, with the length in Name_Len. - function Program_Name (Nam : String) return String_Access; + function Program_Name (Nam : String; Prog : String) return String_Access; -- In the native compilation case, Create a string containing Nam. In the -- cross compilation case, looks at the prefix of the current program being -- run and prepend it to Nam. For instance if the program being run is @@ -113,6 +113,9 @@ package Osint is -- to "<target>-gcc". In the specific case where AAMP_On_Target is set, the -- name "gcc" is mapped to "gnaamp", and names of the form "gnat*" are -- mapped to "gnaamp*". This function clobbers Name_Buffer and Name_Len. + -- Also look at any suffix, e.g. gnatmake-4.1 -> "gcc-4.1". + -- Prog is the default name of the current program being executed, e.g. + -- "gnatmake", "gnatlink". procedure Write_Program_Name; -- Writes name of program as invoked to the current output diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index a3997f0968b..98a55f7379b 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -1172,7 +1172,7 @@ package body Prj.Makr is if Gcc_Path = null then declare Prefix_Gcc : String_Access := - Program_Name (Gcc); + Program_Name (Gcc, "gnatname"); begin Gcc_Path := Locate_Exec_On_Path (Prefix_Gcc.all); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 7e61f55bfdf..d84ba7fbbf7 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -4692,7 +4692,7 @@ package body Prj.Nmsc is Data.Other_Sources_Present := False; else - -- If the configuration file does not define a language either + -- Fail if there is no default language defined if Def_Lang.Default then if not Default_Language_Is_Ada then @@ -4707,8 +4707,6 @@ package body Prj.Nmsc is end if; else - -- ??? Are we supporting a single default language in the - -- configuration file ? Get_Name_String (Def_Lang.Value); To_Lower (Name_Buffer (1 .. Name_Len)); Def_Lang_Id := Name_Find; @@ -5208,8 +5206,7 @@ package body Prj.Nmsc is In_Tree.Sources.Table (Source).Other_Part /= No_Source then - Source := - In_Tree.Sources.Table (Source).Other_Part; + Source := In_Tree.Sources.Table (Source).Other_Part; end if; String_Element_Table.Increment_Last diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index ab9208f9e94..67c913378dd 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -39,6 +39,8 @@ with Table; with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Exceptions; use Ada.Exceptions; +with GNAT.Directory_Operations; use GNAT.Directory_Operations; + with System.HTable; use System.HTable; package body Prj.Part is @@ -1864,15 +1866,65 @@ package body Prj.Part is ------------------- function Try_Path_Name (Path : String) return String_Access is + Prj_Path : constant String := Project_Path; + First : Natural; + Last : Natural; + Result : String_Access := null; + begin if Current_Verbosity = High then Write_Str (" Trying "); Write_Line (Path); end if; - return Locate_Regular_File - (File_Name => Path, - Path => Project_Path); + if Is_Absolute_Path (Path) then + if Is_Regular_File (Path) then + Result := new String'(Path); + end if; + + else + -- Because we don't want to resolve symbolic links, we cannot use + -- Locate_Regular_File. So, we try each possible path + -- successively. + + First := Prj_Path'First; + while First <= Prj_Path'Last loop + while First <= Prj_Path'Last + and then Prj_Path (First) = Path_Separator + loop + First := First + 1; + end loop; + + exit when First > Prj_Path'Last; + + Last := First; + while Last < Prj_Path'Last + and then Prj_Path (Last + 1) /= Path_Separator + loop + Last := Last + 1; + end loop; + + Name_Len := 0; + + if not Is_Absolute_Path (Prj_Path (First .. Last)) then + Add_Str_To_Name_Buffer (Get_Current_Dir); + Add_Char_To_Name_Buffer (Directory_Separator); + end if; + + Add_Str_To_Name_Buffer (Prj_Path (First .. Last)); + Add_Char_To_Name_Buffer (Directory_Separator); + Add_Str_To_Name_Buffer (Path); + + if Is_Regular_File (Name_Buffer (1 .. Name_Len)) then + Result := new String'(Name_Buffer (1 .. Name_Len)); + exit; + end if; + + First := Last + 1; + end loop; + end if; + + return Result; end Try_Path_Name; -- Local Declarations diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index edeb3ace65c..5d8caa79cd3 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1275,7 +1275,7 @@ package Prj is Config : Project_Configuration; - Path : Path_Information := No_Path_Information; + Path : Path_Information := No_Path_Information; -- The path name of the project file Virtual : Boolean := False; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 5049c5b1be4..2f1bd5dec3d 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.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- -- @@ -321,7 +321,16 @@ package body Restrict is if Restriction_Warnings (R) then Restriction_Msg ("|violation of restriction %#?", Rimage, N); else - Restriction_Msg ("|violation of restriction %#", Rimage, N); + -- 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 diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index fbc8a8a54f8..bb81d85ed79 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -105,14 +105,18 @@ package Restrict is Implementation_Restriction : array (All_Restrictions) of Boolean := (Simple_Barriers => True, + No_Asynchronous_Control => True, No_Calendar => True, No_Dispatching_Calls => True, No_Dynamic_Attachment => True, + No_Elaboration_Code => True, No_Enumeration_Maps => True, No_Entry_Calls_In_Elaboration_Code => True, No_Entry_Queue => True, No_Exception_Handlers => True, No_Exception_Registration => True, + No_Implementation_Attributes => True, + No_Implementation_Pragmas => True, No_Implicit_Conditionals => True, No_Implicit_Dynamic_Code => True, No_Implicit_Loops => True, @@ -126,12 +130,11 @@ package Restrict is No_Streams => True, No_Task_Attributes_Package => True, No_Task_Termination => True, + No_Unchecked_Conversion => True, + No_Unchecked_Deallocation => True, No_Wide_Characters => True, Static_Priorities => True, Static_Storage_Size => True, - No_Implementation_Attributes => True, - No_Implementation_Pragmas => True, - No_Elaboration_Code => True, others => False); -- The following table records entries made by Restrictions pragmas diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 76110c036ef..b3bbf6a3539 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -144,6 +144,7 @@ package Rtsfind is -- Children of Ada.Real_Time Ada_Real_Time_Delays, + Ada_Real_Time_Timing_Events, -- Children of Ada.Streams @@ -394,7 +395,7 @@ package Rtsfind is -- Range of values for children of Ada.Interrupts subtype Ada_Real_Time_Child is Ada_Child - range Ada_Real_Time_Delays .. Ada_Real_Time_Delays; + range Ada_Real_Time_Delays .. Ada_Real_Time_Timing_Events; -- Range of values for children of Ada.Real_Time subtype Ada_Streams_Child is Ada_Child @@ -470,6 +471,12 @@ package Rtsfind is RE_Null, + RO_CA_Time, -- Ada.Calendar + + RO_CA_Delay_For, -- Ada.Calendar.Delays + RO_CA_Delay_Until, -- Ada.Calendar.Delays + RO_CA_To_Duration, -- Ada.Calendar.Delays + RE_Set_Deadline, -- Ada.Dispatching.EDF RE_Code_Loc, -- Ada.Exceptions @@ -503,6 +510,16 @@ package Rtsfind is RE_Names, -- Ada.Interrupts.Names + RE_Clock, -- Ada.Real_Time + RE_Time_Span, -- Ada.Real_Time + RE_Time_Span_Zero, -- Ada.Real_Time + RO_RT_Time, -- Ada.Real_Time + + RO_RT_Delay_Until, -- Ada.Real_Time.Delays + RO_RT_To_Duration, -- Ada.Real_Time.Delays + + RE_Timing_Event, -- Ada_Real_Time_Timing_Events + RE_Root_Stream_Type, -- Ada.Streams RE_Stream_Element, -- Ada.Streams @@ -590,24 +607,13 @@ package Rtsfind is RE_TK_Tagged, -- Ada.Tags RE_TK_Task, -- Ada.Tags + RE_Set_Specific_Handler, -- Ada.Task_Termination + RE_Specific_Handler, -- Ada.Task_Termination + RE_Abort_Task, -- Ada.Task_Identification RE_Current_Task, -- Ada.Task_Identification RO_AT_Task_Id, -- Ada.Task_Identification - RO_CA_Time, -- Ada.Calendar - - RO_CA_Delay_For, -- Ada.Calendar.Delays - RO_CA_Delay_Until, -- Ada.Calendar.Delays - RO_CA_To_Duration, -- Ada.Calendar.Delays - - RE_Clock, -- Ada.Real_Time - RE_Time_Span, -- Ada.Real_Time - RE_Time_Span_Zero, -- Ada.Real_Time - RO_RT_Time, -- Ada.Real_Time - - RO_RT_Delay_Until, -- Ada.Real_Time.Delays - RO_RT_To_Duration, -- Ada.Real_Time.Delays - RE_Integer_64, -- Interfaces RE_Unsigned_8, -- Interfaces RE_Unsigned_16, -- Interfaces @@ -1599,14 +1605,20 @@ package Rtsfind is RO_TS_Set_Entry_Name, -- System.Tasking.Stages RE_Terminated); -- System.Tasking.Stages - -- The following declarations build a table that is indexed by the - -- RTE function to determine the unit containing the given entity. - -- This table is sorted in order of package names. + -- The following declarations build a table that is indexed by the RTE + -- function to determine the unit containing the given entity. This table + -- is sorted in order of package names. RE_Unit_Table : array (RE_Id) of RTU_Id := ( RE_Null => RTU_Null, + RO_CA_Time => Ada_Calendar, + + RO_CA_Delay_For => Ada_Calendar_Delays, + RO_CA_Delay_Until => Ada_Calendar_Delays, + RO_CA_To_Duration => Ada_Calendar_Delays, + RE_Set_Deadline => Ada_Dispatching_EDF, RE_Code_Loc => Ada_Exceptions, @@ -1640,6 +1652,16 @@ package Rtsfind is RE_Names => Ada_Interrupts_Names, + RE_Clock => Ada_Real_Time, + RE_Time_Span => Ada_Real_Time, + RE_Time_Span_Zero => Ada_Real_Time, + RO_RT_Time => Ada_Real_Time, + + RO_RT_Delay_Until => Ada_Real_Time_Delays, + RO_RT_To_Duration => Ada_Real_Time_Delays, + + RE_Timing_Event => Ada_Real_Time_Timing_Events, + RE_Root_Stream_Type => Ada_Streams, RE_Stream_Element => Ada_Streams, @@ -1727,22 +1749,13 @@ package Rtsfind is RE_TK_Tagged => Ada_Tags, RE_TK_Task => Ada_Tags, + RE_Set_Specific_Handler => Ada_Task_Termination, + RE_Specific_Handler => Ada_Task_Termination, + RE_Abort_Task => Ada_Task_Identification, RE_Current_Task => Ada_Task_Identification, RO_AT_Task_Id => Ada_Task_Identification, - RO_CA_Time => Ada_Calendar, - RO_CA_Delay_For => Ada_Calendar_Delays, - RO_CA_Delay_Until => Ada_Calendar_Delays, - RO_CA_To_Duration => Ada_Calendar_Delays, - - RE_Clock => Ada_Real_Time, - RE_Time_Span => Ada_Real_Time, - RE_Time_Span_Zero => Ada_Real_Time, - RO_RT_Time => Ada_Real_Time, - RO_RT_Delay_Until => Ada_Real_Time_Delays, - RO_RT_To_Duration => Ada_Real_Time_Delays, - RE_Integer_64 => Interfaces, RE_Unsigned_8 => Interfaces, RE_Unsigned_16 => Interfaces, diff --git a/gcc/ada/s-direio.adb b/gcc/ada/s-direio.adb index fc4bd8e9d9a..c764a1c658e 100644 --- a/gcc/ada/s-direio.adb +++ b/gcc/ada/s-direio.adb @@ -251,21 +251,23 @@ package body System.Direct_IO is ----------- procedure Reset (File : in out File_Type; Mode : FCB.File_Mode) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); + pragma Unmodified (File); + -- File is actually modified via Unrestricted_Access below, but + -- GNAT will generate a warning anyway. + begin - FIO.Reset (AFCB'Access, Mode); + FIO.Reset (AP (File)'Unrestricted_Access, Mode); File.Index := 1; File.Last_Op := Op_Read; end Reset; procedure Reset (File : in out File_Type) is - AFCB : aliased AP; - for AFCB'Address use File'Address; - pragma Import (Ada, AFCB); + pragma Unmodified (File); + -- File is actually modified via Unrestricted_Access below, but + -- GNAT will generate a warning anyway. + begin - FIO.Reset (AFCB'Access); + FIO.Reset (AP (File)'Unrestricted_Access); File.Index := 1; File.Last_Op := Op_Read; end Reset; diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 2c5ffb60832..bbe422377de 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -89,6 +89,7 @@ package System.Rident is No_Implicit_Loops, -- GNAT No_Initialize_Scalars, -- GNAT No_Local_Allocators, -- (RM H.4(8)) + No_Local_Timing_Events, -- (RM D.7(10.2/2)) No_Local_Protected_Objects, -- GNAT No_Nested_Finalization, -- (RM D.7(4)) No_Protected_Type_Allocators, -- GNAT @@ -99,6 +100,7 @@ package System.Rident is No_Requeue_Statements, -- GNAT No_Secondary_Stack, -- GNAT No_Select_Statements, -- GNAT (Ravenscar) + No_Specific_Termination_Handlers, -- (RM D.7(10.7/2)) No_Standard_Storage_Pools, -- GNAT No_Streams, -- GNAT No_Task_Allocators, -- (RM D.7(7)) diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index c6a3e25a881..4f50dc01789 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -414,6 +414,22 @@ package body Sem_Aggr is return; end if; + -- Ada 2005 (AI-230): Generate a conversion to an anonymous access + -- component's type to force the appropriate accessibility checks. + + -- Ada 2005 (AI-231): Generate conversion to the null-excluding + -- type to force the corresponding run-time check + + if Is_Access_Type (Check_Typ) + and then ((Is_Local_Anonymous_Access (Check_Typ)) + or else (Can_Never_Be_Null (Check_Typ) + and then not Can_Never_Be_Null (Exp_Typ))) + then + Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp))); + Analyze_And_Resolve (Exp, Check_Typ); + Check_Unset_Reference (Exp); + end if; + -- This is really expansion activity, so make sure that expansion -- is on and is allowed. @@ -486,20 +502,6 @@ package body Sem_Aggr is Check_Unset_Reference (Exp); end if; - -- Ada 2005 (AI-230): Generate a conversion to an anonymous access - -- component's type to force the appropriate accessibility checks. - - -- Ada 2005 (AI-231): Generate conversion to the null-excluding - -- type to force the corresponding run-time check - - elsif Is_Access_Type (Check_Typ) - and then ((Is_Local_Anonymous_Access (Check_Typ)) - or else (Can_Never_Be_Null (Check_Typ) - and then not Can_Never_Be_Null (Exp_Typ))) - then - Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp))); - Analyze_And_Resolve (Exp, Check_Typ); - Check_Unset_Reference (Exp); end if; end Aggregate_Constraint_Checks; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 0cb2ace755e..14f9102d369 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3501,6 +3501,13 @@ package body Sem_Attr is Error_Attr ("attribute % cannot apply to limited objects", P); end if; + if Is_Entity_Name (P) + and then Is_Constant_Object (Entity (P)) + then + Error_Msg_N + ("?attribute Old applied to constant has no effect", P); + end if; + -- Check that the expression does not refer to local entities Check_Local : declare diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a375eedee7c..f0065b73901 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -712,6 +712,10 @@ package body Sem_Ch3 is -- E is some record type. This routine computes E's Stored_Constraint -- from its Discriminant_Constraint. + procedure Diagnose_Interface (N : Node_Id; E : Entity_Id); + -- Check that an entity in a list of progenitors is an interface, + -- emit error otherwise. + ----------------------- -- Access_Definition -- ----------------------- @@ -3060,6 +3064,14 @@ package body Sem_Ch3 is then Set_In_Private_Part (Id); end if; + + -- Check for violation of No_Local_Timing_Events + + if Is_RTE (Etype (Id), RE_Timing_Event) + and then not Is_Library_Level_Entity (Id) + then + Check_Restriction (No_Local_Timing_Events, N); + end if; end Analyze_Object_Declaration; --------------------------- @@ -3098,10 +3110,7 @@ package body Sem_Ch3 is while Present (Intf) loop T := Find_Type_Of_Subtype_Indic (Intf); - if not Is_Interface (T) then - Error_Msg_NE ("(Ada 2005) & must be an interface", Intf, T); - end if; - + Diagnose_Interface (Intf, T); Next (Intf); end loop; end; @@ -6276,14 +6285,13 @@ package body Sem_Ch3 is C1 := First_Elmt (New_Discrs); C2 := First_Elmt (Discriminant_Constraint (Derived_Type)); while Present (C1) and then Present (C2) loop - if Fully_Conformant_Expressions (Node (C1), Node (C2)) or else - (Is_OK_Static_Expression (Node (C1)) - and then - Is_OK_Static_Expression (Node (C2)) - and then - Expr_Value (Node (C1)) = Expr_Value (Node (C2))) + (Is_OK_Static_Expression (Node (C1)) + and then + Is_OK_Static_Expression (Node (C2)) + and then + Expr_Value (Node (C1)) = Expr_Value (Node (C2))) then null; @@ -8660,8 +8668,7 @@ package body Sem_Ch3 is Iface_Def := Type_Definition (Parent_Node); if not Is_Interface (Iface_Typ) then - Error_Msg_NE ("(Ada 2005) & must be an interface", - Iface, Iface_Typ); + Diagnose_Interface (Iface, Iface_Typ); else Check_Ifaces (Iface_Def, Iface); @@ -8701,8 +8708,7 @@ package body Sem_Ch3 is Iface_Def := Type_Definition (Parent_Node); if not Is_Interface (Iface_Typ) then - Error_Msg_NE ("(Ada 2005) & must be an interface", - Iface, Iface_Typ); + Diagnose_Interface (Iface, Iface_Typ); else -- "The declaration of a specific descendant of an interface @@ -11391,7 +11397,16 @@ package body Sem_Ch3 is while Present (Prim_Elmt) loop Iface_Subp := Node (Prim_Elmt); - if not Is_Predefined_Dispatching_Operation (Iface_Subp) then + -- Exclude derivation of predefined primitives except those + -- that come from source. Required to catch declarations of + -- equality operators of interfaces. For example: + + -- type Iface is interface; + -- function "=" (Left, Right : Iface) return Boolean; + + if not Is_Predefined_Dispatching_Operation (Iface_Subp) + or else Comes_From_Source (Iface_Subp) + then E := Find_Primitive_Covering_Interface (Tagged_Type => Tagged_Type, Iface_Prim => Iface_Subp); @@ -12441,8 +12456,7 @@ package body Sem_Ch3 is if Interface_Present (Def) then if not Is_Interface (Parent_Type) then - Error_Msg_NE - ("(Ada 2005) & must be an interface", Indic, Parent_Type); + Diagnose_Interface (Indic, Parent_Type); else Parent_Node := Parent (Base_Type (Parent_Type)); @@ -12535,7 +12549,7 @@ package body Sem_Ch3 is T := Find_Type_Of_Subtype_Indic (Intf); if not Is_Interface (T) then - Error_Msg_NE ("(Ada 2005) & must be an interface", Intf, T); + Diagnose_Interface (Intf, T); -- Check the rules of 3.9.4(12/2) and 7.5(2/2) that disallow -- a limited type from having a nonlimited progenitor. @@ -12848,6 +12862,19 @@ package body Sem_Ch3 is end if; end Derived_Type_Declaration; + ------------------------ + -- Diagnose_Interface -- + ------------------------ + + procedure Diagnose_Interface (N : Node_Id; E : Entity_Id) is + begin + if not Is_Interface (E) + and then E /= Any_Type + then + Error_Msg_NE ("(Ada 2005) & must be an interface", N, E); + end if; + end Diagnose_Interface; + ---------------------------------- -- Enumeration_Type_Declaration -- ---------------------------------- @@ -16619,7 +16646,8 @@ package body Sem_Ch3 is -- view of the type. function Designates_T (Subt : Node_Id) return Boolean; - -- Check whether a node designates the enclosing record type + -- Check whether a node designates the enclosing record type, or 'Class + -- of that type function Mentions_T (Acc_Def : Node_Id) return Boolean; -- Check whether an access definition includes a reference to @@ -16637,13 +16665,25 @@ package body Sem_Ch3 is Inc_T : Entity_Id; H : Entity_Id; + -- Is_Tagged indicates whether the type is tagged. It is tagged if + -- it's "is new ... with record" or else "is tagged record ...". + + Is_Tagged : constant Boolean := + (Nkind (Type_Definition (Typ_Decl)) = N_Derived_Type_Definition + and then + Present + (Record_Extension_Part (Type_Definition (Typ_Decl)))) + or else + (Nkind (Type_Definition (Typ_Decl)) = N_Record_Definition + and then Tagged_Present (Type_Definition (Typ_Decl))); + begin -- If there is a previous partial view, no need to create a new one -- If the partial view, given by Prev, is incomplete, If Prev is -- a private declaration, full declaration is flagged accordingly. if Prev /= Typ then - if Tagged_Present (Type_Definition (Typ_Decl)) then + if Is_Tagged then Make_Class_Wide_Type (Prev); Set_Class_Wide_Type (Typ, Class_Wide_Type (Prev)); Set_Etype (Class_Wide_Type (Typ), Typ); @@ -16652,6 +16692,15 @@ package body Sem_Ch3 is return; elsif Has_Private_Declaration (Typ) then + + -- If we refer to T'Class inside T, and T is the completion of a + -- private type, then we need to make sure the class-wide type + -- exists. + + if Is_Tagged then + Make_Class_Wide_Type (Typ); + end if; + return; -- If there was a previous anonymous access type, the incomplete @@ -16693,14 +16742,9 @@ package body Sem_Ch3 is Analyze (Decl); Set_Full_View (Inc_T, Typ); - if (Nkind (Type_Definition (Typ_Decl)) = N_Derived_Type_Definition - and then - Present - (Record_Extension_Part (Type_Definition (Typ_Decl)))) - or else Tagged_Present (Type_Definition (Typ_Decl)) - then + if Is_Tagged then -- Create a common class-wide type for both views, and set - -- the etype of the class-wide type to the full view. + -- the Etype of the class-wide type to the full view. Make_Class_Wide_Type (Inc_T); Set_Class_Wide_Type (Typ, Class_Wide_Type (Inc_T)); diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index a341069bf75..89b85fe2c23 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -171,6 +171,7 @@ package Sem_Ch3 is -- family declaration or a loop iteration. The index is given by an -- index declaration (a 'box'), or by a discrete range. The later can -- be the name of a discrete type, or a subtype indication. + -- -- Related_Nod is the node where the potential generated implicit types -- will be inserted. The 2 last parameters are used for creating the name. diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index e5de05b3a58..11439419a25 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -582,9 +582,15 @@ package body Sem_Ch5 is -- 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 + -- are component subtypes. if Ada_Version >= Ada_05 - and then Ekind (T1) = E_Anonymous_Access_Type + and then + Is_Access_Type (T1) + and then + (Is_Local_Anonymous_Access (T1) + or else Can_Never_Be_Null (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 14a305b5090..640a20d0a54 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1602,6 +1602,7 @@ package body Sem_Ch6 is elsif Nkind (Parent (N)) = N_Compilation_Unit then Freeze_Before (N, Spec_Id); end if; + else Spec_Id := Corresponding_Spec (N); end if; @@ -2459,18 +2460,17 @@ package body Sem_Ch6 is Push_Scope (Designator); Process_Formals (Formals, N); - -- Ada 2005 (AI-345): Allow the overriding of interface primitives - -- by subprograms which belong to a concurrent type implementing an - -- interface. Set the parameter type of each controlling formal to - -- the corresponding record type. + -- Ada 2005 (AI-345): If this is an overriding operation of an + -- inherited interface operation, and the controlling type is + -- a synchronized type, replace the type with its corresponding + -- record, to match the proper signature of an overriding operation. if Ada_Version >= Ada_05 then Formal := First_Formal (Designator); while Present (Formal) loop Formal_Typ := Etype (Formal); - if (Ekind (Formal_Typ) = E_Protected_Type - or else Ekind (Formal_Typ) = E_Task_Type) + if Is_Concurrent_Type (Formal_Typ) and then Present (Corresponding_Record_Type (Formal_Typ)) and then Present (Interfaces (Corresponding_Record_Type (Formal_Typ))) @@ -2496,21 +2496,19 @@ package body Sem_Ch6 is May_Need_Actuals (Designator); - -- Ada 2005 (AI-251): In case of primitives associated with abstract - -- interface types the following error message will be reported later - -- (see Analyze_Subprogram_Declaration). + -- Ada 2005 (AI-251): If the return type is abstract, verify that + -- the subprogram is abstract also. This does not apply to renaming + -- declarations, where abstractness is inherited. + -- In case of primitives associated with abstract interface types + -- the check is applied later (see Analyze_Subprogram_Declaration). if Is_Abstract_Type (Etype (Designator)) and then not Is_Interface (Etype (Designator)) + and then Nkind (Parent (N)) /= N_Subprogram_Renaming_Declaration and then Nkind (Parent (N)) /= N_Abstract_Subprogram_Declaration and then (Nkind (Parent (N))) /= N_Formal_Abstract_Subprogram_Declaration - and then - (Nkind (Parent (N)) /= N_Subprogram_Renaming_Declaration - or else not Is_Entity_Name (Name (Parent (N))) - or else not Is_Abstract_Subprogram - (Entity (Name (Parent (N))))) then Error_Msg_N ("function that returns abstract type must be abstract", N); @@ -5001,7 +4999,7 @@ package body Sem_Ch6 is -- can be called in a dispatching context and such calls must be -- handled like calls to a class-wide function. - if not Is_Constrained (Result_Subt) + if not Is_Constrained (Underlying_Type (Result_Subt)) or else Is_Tagged_Type (Underlying_Type (Result_Subt)) then Discard := @@ -6203,7 +6201,6 @@ package body Sem_Ch6 is procedure Check_Synchronized_Overriding (Def_Id : Entity_Id; - First_Hom : Entity_Id; Overridden_Subp : out Entity_Id); -- First determine if Def_Id is an entry or a subprogram either defined -- in the scope of a task or protected type, or is a primitive of such @@ -6398,22 +6395,198 @@ package body Sem_Ch6 is procedure Check_Synchronized_Overriding (Def_Id : Entity_Id; - First_Hom : Entity_Id; Overridden_Subp : out Entity_Id) is - Formal_Typ : Entity_Id; Ifaces_List : Elist_Id; In_Scope : Boolean; Typ : Entity_Id; + function Has_Correct_Formal_Mode + (Tag_Typ : Entity_Id; + Subp : Entity_Id) return Boolean; + -- For an overridden subprogram Subp, check whether the mode of its + -- first parameter is correct depending on the kind of Tag_Typ. + + function Matches_Prefixed_View_Profile + (Prim_Params : List_Id; + Iface_Params : List_Id) return Boolean; + -- Determine whether a subprogram's parameter profile Prim_Params + -- matches that of a potentially overridden interface subprogram + -- Iface_Params. Also determine if the type of first parameter of + -- Iface_Params is an implemented interface. + + ----------------------------- + -- Has_Correct_Formal_Mode -- + ----------------------------- + + function Has_Correct_Formal_Mode + (Tag_Typ : Entity_Id; + Subp : Entity_Id) return Boolean + is + Formal : constant Node_Id := First_Formal (Subp); + + begin + -- In order for an entry or a protected procedure to override, the + -- first parameter of the overridden routine must be of mode + -- "out", "in out" or access-to-variable. + + if (Ekind (Subp) = E_Entry + or else Ekind (Subp) = E_Procedure) + and then Is_Protected_Type (Tag_Typ) + and then Ekind (Formal) /= E_In_Out_Parameter + and then Ekind (Formal) /= E_Out_Parameter + and then Nkind (Parameter_Type (Parent (Formal))) /= + N_Access_Definition + then + return False; + end if; + + -- All other cases are OK since a task entry or routine does not + -- have a restriction on the mode of the first parameter of the + -- overridden interface routine. + + return True; + end Has_Correct_Formal_Mode; + + ----------------------------------- + -- Matches_Prefixed_View_Profile -- + ----------------------------------- + + function Matches_Prefixed_View_Profile + (Prim_Params : List_Id; + Iface_Params : List_Id) return Boolean + is + Iface_Id : Entity_Id; + Iface_Param : Node_Id; + Iface_Typ : Entity_Id; + Prim_Id : Entity_Id; + Prim_Param : Node_Id; + Prim_Typ : Entity_Id; + + function Is_Implemented + (Ifaces_List : Elist_Id; + Iface : Entity_Id) return Boolean; + -- Determine if Iface is implemented by the current task or + -- protected type. + + -------------------- + -- Is_Implemented -- + -------------------- + + function Is_Implemented + (Ifaces_List : Elist_Id; + Iface : Entity_Id) return Boolean + is + Iface_Elmt : Elmt_Id; + + begin + Iface_Elmt := First_Elmt (Ifaces_List); + while Present (Iface_Elmt) loop + if Node (Iface_Elmt) = Iface then + return True; + end if; + + Next_Elmt (Iface_Elmt); + end loop; + + return False; + end Is_Implemented; + + -- Start of processing for Matches_Prefixed_View_Profile + + begin + Iface_Param := First (Iface_Params); + Iface_Typ := Etype (Defining_Identifier (Iface_Param)); + + if Is_Access_Type (Iface_Typ) then + Iface_Typ := Designated_Type (Iface_Typ); + end if; + + Prim_Param := First (Prim_Params); + + -- The first parameter of the potentially overridden subprogram + -- must be an interface implemented by Prim. + + if not Is_Interface (Iface_Typ) + or else not Is_Implemented (Ifaces_List, Iface_Typ) + then + return False; + end if; + + -- The checks on the object parameters are done, move onto the + -- rest of the parameters. + + if not In_Scope then + Prim_Param := Next (Prim_Param); + end if; + + Iface_Param := Next (Iface_Param); + while Present (Iface_Param) and then Present (Prim_Param) loop + Iface_Id := Defining_Identifier (Iface_Param); + Iface_Typ := Find_Parameter_Type (Iface_Param); + + if Is_Access_Type (Iface_Typ) then + Iface_Typ := Directly_Designated_Type (Iface_Typ); + end if; + + Prim_Id := Defining_Identifier (Prim_Param); + Prim_Typ := Find_Parameter_Type (Prim_Param); + + if Is_Access_Type (Prim_Typ) then + Prim_Typ := Directly_Designated_Type (Prim_Typ); + end if; + + -- Case of multiple interface types inside a parameter profile + + -- (Obj_Param : in out Iface; ...; Param : Iface) + + -- If the interface type is implemented, then the matching type + -- in the primitive should be the implementing record type. + + if Ekind (Iface_Typ) = E_Record_Type + and then Is_Interface (Iface_Typ) + and then Is_Implemented (Ifaces_List, Iface_Typ) + then + if Prim_Typ /= Typ then + return False; + end if; + + -- The two parameters must be both mode and subtype conformant + + elsif Ekind (Iface_Id) /= Ekind (Prim_Id) + or else not + Conforming_Types (Iface_Typ, Prim_Typ, Subtype_Conformant) + then + return False; + end if; + + Next (Iface_Param); + Next (Prim_Param); + end loop; + + -- One of the two lists contains more parameters than the other + + if Present (Iface_Param) or else Present (Prim_Param) then + return False; + end if; + + return True; + end Matches_Prefixed_View_Profile; + + -- Start of processing for Check_Synchronized_Overriding + begin Overridden_Subp := Empty; - -- Def_Id must be an entry or a subprogram + -- Def_Id must be an entry or a subprogram. We should skip predefined + -- primitives internally generated by the frontend; however at this + -- stage predefined primitives are still not fully decorated. As a + -- minor optimization we skip here internally generated subprograms. - if Ekind (Def_Id) /= E_Entry - and then Ekind (Def_Id) /= E_Function - and then Ekind (Def_Id) /= E_Procedure + if (Ekind (Def_Id) /= E_Entry + and then Ekind (Def_Id) /= E_Function + and then Ekind (Def_Id) /= E_Procedure) + or else not Comes_From_Source (Def_Id) then return; end if; @@ -6429,15 +6602,25 @@ package body Sem_Ch6 is Typ := Scope (Def_Id); In_Scope := True; - -- The subprogram may be a primitive of a concurrent type + -- The enclosing scope is not a synchronized type and the subprogram + -- has no formals - elsif Present (First_Formal (Def_Id)) then - Formal_Typ := Etype (First_Formal (Def_Id)); + elsif No (First_Formal (Def_Id)) then + return; - if Is_Concurrent_Type (Formal_Typ) - and then not Is_Generic_Actual_Type (Formal_Typ) + -- The subprogram has formals and hence it may be a primitive of a + -- concurrent type + + else + Typ := Etype (First_Formal (Def_Id)); + + if Is_Access_Type (Typ) then + Typ := Directly_Designated_Type (Typ); + end if; + + if Is_Concurrent_Type (Typ) + and then not Is_Generic_Actual_Type (Typ) then - Typ := Formal_Typ; In_Scope := False; -- This case occurs when the concurrent type is declared within @@ -6445,37 +6628,152 @@ package body Sem_Ch6 is -- built and used as the type of the first formal, we just have -- to retrieve the corresponding concurrent type. - elsif Is_Concurrent_Record_Type (Formal_Typ) - and then Present (Corresponding_Concurrent_Type (Formal_Typ)) + elsif Is_Concurrent_Record_Type (Typ) + and then Present (Corresponding_Concurrent_Type (Typ)) then - Typ := Corresponding_Concurrent_Type (Formal_Typ); + Typ := Corresponding_Concurrent_Type (Typ); In_Scope := False; else return; end if; - else + end if; + + -- There is no overriding to check if is an inherited operation in a + -- type derivation on for a generic actual. + + Collect_Interfaces (Typ, Ifaces_List); + + if Is_Empty_Elmt_List (Ifaces_List) then return; end if; - -- Gather all limited, protected and task interfaces that Typ - -- implements. There is no overriding to check if is an inherited - -- operation in a type derivation on for a generic actual. + -- Determine whether entry or subprogram Def_Id overrides a primitive + -- operation that belongs to one of the interfaces in Ifaces_List. - if Nkind (Parent (Typ)) /= N_Full_Type_Declaration - and then - not Nkind_In (Parent (Def_Id), N_Subtype_Declaration, - N_Task_Type_Declaration, - N_Protected_Type_Declaration) - then - Collect_Interfaces (Typ, Ifaces_List); + declare + Candidate : Entity_Id := Empty; + Hom : Entity_Id := Empty; + Iface_Typ : Entity_Id; + Subp : Entity_Id := Empty; + + begin + -- Traverse the homonym chain, looking at a potentially + -- overridden subprogram that belongs to an implemented + -- interface. + + Hom := Current_Entity_In_Scope (Def_Id); + while Present (Hom) loop + Subp := Hom; + + -- Entries can override abstract or null interface + -- procedures + + if Ekind (Def_Id) = E_Entry + and then Ekind (Subp) = E_Procedure + and then Nkind (Parent (Subp)) = N_Procedure_Specification + and then (Is_Abstract_Subprogram (Subp) + or else Null_Present (Parent (Subp))) + then + while Present (Alias (Subp)) loop + Subp := Alias (Subp); + end loop; - if not Is_Empty_Elmt_List (Ifaces_List) then - Overridden_Subp := - Find_Overridden_Synchronized_Primitive - (Def_Id, First_Hom, Ifaces_List, In_Scope); + if Matches_Prefixed_View_Profile + (Parameter_Specifications (Parent (Def_Id)), + Parameter_Specifications (Parent (Subp))) + then + Candidate := Subp; + + -- Absolute match + + if Has_Correct_Formal_Mode (Typ, Candidate) then + Overridden_Subp := Candidate; + return; + end if; + end if; + + -- Procedures can override abstract or null interface + -- procedures + + elsif Ekind (Def_Id) = E_Procedure + and then Ekind (Subp) = E_Procedure + and then Nkind (Parent (Subp)) = N_Procedure_Specification + and then (Is_Abstract_Subprogram (Subp) + or else Null_Present (Parent (Subp))) + and then Matches_Prefixed_View_Profile + (Parameter_Specifications (Parent (Def_Id)), + Parameter_Specifications (Parent (Subp))) + then + Candidate := Subp; + + -- Absolute match + + if Has_Correct_Formal_Mode (Typ, Candidate) then + Overridden_Subp := Candidate; + return; + end if; + + -- Functions can override abstract interface functions + + elsif Ekind (Def_Id) = E_Function + and then Ekind (Subp) = E_Function + and then Nkind (Parent (Subp)) = N_Function_Specification + and then Is_Abstract_Subprogram (Subp) + and then Matches_Prefixed_View_Profile + (Parameter_Specifications (Parent (Def_Id)), + Parameter_Specifications (Parent (Subp))) + and then Etype (Result_Definition (Parent (Def_Id))) = + Etype (Result_Definition (Parent (Subp))) + then + Overridden_Subp := Subp; + return; + end if; + + Hom := Homonym (Hom); + end loop; + + -- After examining all candidates for overriding, we are + -- left with the best match which is a mode incompatible + -- interface routine. Do not emit an error if the Expander + -- is active since this error will be detected later on + -- after all concurrent types are expanded and all wrappers + -- are built. This check is meant for spec-only + -- compilations. + + if Present (Candidate) + and then not Expander_Active + then + Iface_Typ := + Find_Parameter_Type (Parent (First_Formal (Candidate))); + + -- Def_Id is primitive of a protected type, declared + -- inside the type, and the candidate is primitive of a + -- limited or synchronized interface. + + if In_Scope + and then Is_Protected_Type (Typ) + and then + (Is_Limited_Interface (Iface_Typ) + or else Is_Protected_Interface (Iface_Typ) + or else Is_Synchronized_Interface (Iface_Typ) + or else Is_Task_Interface (Iface_Typ)) + then + -- Must reword this message, comma before to in -gnatj + -- mode ??? + + Error_Msg_NE + ("first formal of & must be of mode `OUT`, `IN OUT`" + & " or access-to-variable", Typ, Candidate); + Error_Msg_N + ("\to be overridden by protected procedure or entry " + & "(RM 9.4(11.9/2))", Typ); + end if; end if; - end if; + + Overridden_Subp := Candidate; + return; + end; end Check_Synchronized_Overriding; ---------------------------- @@ -6528,7 +6826,7 @@ package body Sem_Ch6 is -- has an overriding indicator. if Comes_From_Source (S) then - Check_Synchronized_Overriding (S, Homonym (S), Overridden_Subp); + Check_Synchronized_Overriding (S, Overridden_Subp); Check_Overriding_Indicator (S, Overridden_Subp, Is_Primitive => Is_Primitive_Subp); end if; @@ -6605,7 +6903,7 @@ package body Sem_Ch6 is goto Add_New_Entity; end if; - Check_Synchronized_Overriding (S, E, Overridden_Subp); + Check_Synchronized_Overriding (S, Overridden_Subp); -- Loop through E and its homonyms to determine if any of them is -- the candidate for overriding by S. diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index c03f11ab0af..d8067915838 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -388,18 +388,17 @@ package body Sem_Eval is (N : Node_Id; R : out Node_Id; V : out Uint); - -- This procedure decomposes the node N into an expression node - -- and a signed offset, so that the value of N is equal to the - -- value of R plus the value V (which may be negative). If no - -- such decomposition is possible, then on return R is a copy - -- of N, and V is set to zero. + -- This procedure decomposes the node N into an expression node and a + -- signed offset, so that the value of N is equal to the value of R plus + -- the value V (which may be negative). If no such decomposition is + -- possible, then on return R is a copy of N, and V is set to zero. function Compare_Fixup (N : Node_Id) return Node_Id; - -- This function deals with replacing 'Last and 'First references - -- with their corresponding type bounds, which we then can compare. - -- The argument is the original node, the result is the identity, - -- unless we have a 'Last/'First reference in which case the value - -- returned is the appropriate type bound. + -- This function deals with replacing 'Last and 'First references with + -- their corresponding type bounds, which we then can compare. The + -- argument is the original node, the result is the identity, unless we + -- have a 'Last/'First reference in which case the value returned is the + -- appropriate type bound. function Is_Same_Value (L, R : Node_Id) return Boolean; -- Returns True iff L and R represent expressions that definitely @@ -432,7 +431,6 @@ package body Sem_Eval is return; elsif Nkind (N) = N_Attribute_Reference then - if Attribute_Name (N) = Name_Succ then R := First (Expressions (N)); V := Uint_1; @@ -570,13 +568,15 @@ package body Sem_Eval is -- Start of processing for Is_Same_Value begin - -- Values are the same if they are the same identifier and the - -- identifier refers to a constant object (E_Constant). This - -- does not however apply to Float types, since we may have two - -- NaN values and they should never compare equal. + -- Values are the same if they refer to the same entity and the + -- entity is a constant object (E_Constant). This does not however + -- apply to Float types, since we may have two NaN values and they + -- should never compare equal. - if Nkind (Lf) = N_Identifier and then Nkind (Rf) = N_Identifier + if Nkind_In (Lf, N_Identifier, N_Expanded_Name) + and then Nkind_In (Rf, N_Identifier, N_Expanded_Name) and then Entity (Lf) = Entity (Rf) + and then Present (Entity (Lf)) and then not Is_Floating_Point_Type (Etype (L)) and then Is_Constant_Object (Entity (Lf)) then @@ -591,24 +591,53 @@ package body Sem_Eval is then return True; - -- Or if they are both 'First or 'Last values applying to the - -- same entity (first and last don't change even if value does) + -- False if Nkind of the two nodes is different for remaining cases + + elsif Nkind (Lf) /= Nkind (Rf) then + return False; + + -- True if both 'First or 'Last values applying to the same entity + -- (first and last don't change even if value does). Note that we + -- need this even with the calls to Compare_Fixup, to handle the + -- case of unconstrained array attributes where Compare_Fixup + -- cannot find useful bounds. elsif Nkind (Lf) = N_Attribute_Reference - and then - Nkind (Rf) = N_Attribute_Reference and then Attribute_Name (Lf) = Attribute_Name (Rf) and then (Attribute_Name (Lf) = Name_First or else Attribute_Name (Lf) = Name_Last) - and then Is_Entity_Name (Prefix (Lf)) - and then Is_Entity_Name (Prefix (Rf)) + and then Nkind_In (Prefix (Lf), N_Identifier, N_Expanded_Name) + and then Nkind_In (Prefix (Rf), N_Identifier, N_Expanded_Name) and then Entity (Prefix (Lf)) = Entity (Prefix (Rf)) and then Is_Same_Subscript (Expressions (Lf), Expressions (Rf)) then return True; - -- All other cases, we can't tell + -- True if the same selected component from the same record + + elsif Nkind (Lf) = N_Selected_Component + and then Selector_Name (Lf) = Selector_Name (Rf) + and then Is_Same_Value (Prefix (Lf), Prefix (Rf)) + then + return True; + + -- True if the same unary operator applied to the same operand + + elsif Nkind (Lf) in N_Unary_Op + and then Is_Same_Value (Right_Opnd (Lf), Right_Opnd (Rf)) + then + return True; + + -- True if the same binary operator applied to the same operands + + elsif Nkind (Lf) in N_Binary_Op + and then Is_Same_Value (Left_Opnd (Lf), Left_Opnd (Rf)) + and then Is_Same_Value (Right_Opnd (Lf), Right_Opnd (Rf)) + then + return True; + + -- All other cases, we can't tell, so return False else return False; @@ -3388,7 +3417,7 @@ package body Sem_Eval is Rewrite (N, Make_Real_Literal (Loc, Realval => Val)); - -- Set link to original named number, for ASIS use. + -- Set link to original named number, for ASIS use Set_Original_Entity (N, Ent); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 15f4e181f7a..3feba8002d9 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3194,6 +3194,11 @@ package body Sem_Prag is if Chars (Choice) = Chars (Formal) then Set_Mechanism_Value (Formal, Expression (Massoc)); + + -- Set entity on identifier for ASIS + + Set_Entity (Choice, Formal); + exit; end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index f59e6415962..80010871910 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5146,6 +5146,15 @@ package body Sem_Res is Check_Intrinsic_Call (N); end if; + -- Check for violation of restriction No_Specific_Termination_Handlers + + if Is_RTE (Nam, RE_Set_Specific_Handler) + or else + Is_RTE (Nam, RE_Specific_Handler) + then + Check_Restriction (No_Specific_Termination_Handlers, N); + end if; + -- All done, evaluate call and deal with elaboration issues Eval_Call (N); @@ -9425,15 +9434,18 @@ package body Sem_Res is end if; end; - -- Subprogram access types + -- Access to subprogram types. If the operand is an access parameter, + -- the type has a deeper accessibility that any master, and cannot + -- be assigned. elsif (Ekind (Target_Type) = E_Access_Subprogram_Type or else Ekind (Target_Type) = E_Anonymous_Access_Subprogram_Type) and then No (Corresponding_Remote_Type (Opnd_Type)) then - if - Ekind (Base_Type (Opnd_Type)) = E_Anonymous_Access_Subprogram_Type + 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 then Error_Msg_N ("illegal attempt to store anonymous access to subprogram", @@ -9443,13 +9455,9 @@ package body Sem_Res is "(RM 3.10.2 (13))", Operand); - if Is_Entity_Name (Operand) - and then Ekind (Entity (Operand)) = E_In_Parameter - then - Error_Msg_NE - ("\use named access type for& instead of access parameter", - Operand, Entity (Operand)); - end if; + Error_Msg_NE + ("\use named access type for& instead of access parameter", + Operand, Entity (Operand)); end if; -- Check that the designated types are subtype conformant diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 895491e302b..e8823b6164f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -44,7 +44,6 @@ with Scans; use Scans; with Scn; use Scn; with Sem; use Sem; with Sem_Attr; use Sem_Attr; -with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; @@ -100,6 +99,10 @@ package body Sem_Util is Nod := Parent (Base_Type (Typ)); + if Nkind (Nod) = N_Full_Type_Declaration then + return Empty_List; + end if; + elsif Ekind (Typ) = E_Record_Type_With_Private then if Nkind (Parent (Typ)) = N_Full_Type_Declaration then Nod := Type_Definition (Parent (Typ)); @@ -2901,311 +2904,6 @@ package body Sem_Util is return Empty; end Find_Overlaid_Object; - -------------------------------------------- - -- Find_Overridden_Synchronized_Primitive -- - -------------------------------------------- - - function Find_Overridden_Synchronized_Primitive - (Def_Id : Entity_Id; - First_Hom : Entity_Id; - Ifaces_List : Elist_Id; - In_Scope : Boolean) return Entity_Id - is - Candidate : Entity_Id := Empty; - Hom : Entity_Id := Empty; - Iface_Typ : Entity_Id; - Subp : Entity_Id := Empty; - Tag_Typ : Entity_Id; - - function Has_Correct_Formal_Mode (Subp : Entity_Id) return Boolean; - -- For an overridden subprogram Subp, check whether the mode of its - -- first parameter is correct depending on the kind of Tag_Typ. - - function Matches_Prefixed_View_Profile - (Prim_Params : List_Id; - Iface_Params : List_Id) return Boolean; - -- Determine whether a subprogram's parameter profile Prim_Params - -- matches that of a potentially overridden interface subprogram - -- Iface_Params. Also determine if the type of first parameter of - -- Iface_Params is an implemented interface. - - ----------------------------- - -- Has_Correct_Formal_Mode -- - ----------------------------- - - function Has_Correct_Formal_Mode (Subp : Entity_Id) return Boolean is - Param : Node_Id; - - begin - Param := First_Formal (Subp); - - -- In order for an entry or a protected procedure to override, the - -- first parameter of the overridden routine must be of mode "out", - -- "in out" or access-to-variable. - - if (Ekind (Subp) = E_Entry - or else Ekind (Subp) = E_Procedure) - and then Is_Protected_Type (Tag_Typ) - and then Ekind (Param) /= E_In_Out_Parameter - and then Ekind (Param) /= E_Out_Parameter - and then Nkind (Parameter_Type (Parent (Param))) /= - N_Access_Definition - then - return False; - end if; - - -- All other cases are OK since a task entry or routine does not - -- have a restriction on the mode of the first parameter of the - -- overridden interface routine. - - return True; - end Has_Correct_Formal_Mode; - - ----------------------------------- - -- Matches_Prefixed_View_Profile -- - ----------------------------------- - - function Matches_Prefixed_View_Profile - (Prim_Params : List_Id; - Iface_Params : List_Id) return Boolean - is - Iface_Id : Entity_Id; - Iface_Param : Node_Id; - Iface_Typ : Entity_Id; - Prim_Id : Entity_Id; - Prim_Param : Node_Id; - Prim_Typ : Entity_Id; - - function Is_Implemented (Iface : Entity_Id) return Boolean; - -- Determine if Iface is implemented by the current task or - -- protected type. - - -------------------- - -- Is_Implemented -- - -------------------- - - function Is_Implemented (Iface : Entity_Id) return Boolean is - Iface_Elmt : Elmt_Id; - - begin - Iface_Elmt := First_Elmt (Ifaces_List); - while Present (Iface_Elmt) loop - if Node (Iface_Elmt) = Iface then - return True; - end if; - - Next_Elmt (Iface_Elmt); - end loop; - - return False; - end Is_Implemented; - - -- Start of processing for Matches_Prefixed_View_Profile - - begin - Iface_Param := First (Iface_Params); - - if Nkind (Parameter_Type (Iface_Param)) = N_Access_Definition then - Iface_Typ := - Designated_Type (Etype (Defining_Identifier (Iface_Param))); - else - Iface_Typ := Etype (Defining_Identifier (Iface_Param)); - end if; - - Prim_Param := First (Prim_Params); - - -- The first parameter of the potentially overridden subprogram - -- must be an interface implemented by Prim. - - if not Is_Interface (Iface_Typ) - or else not Is_Implemented (Iface_Typ) - then - return False; - end if; - - -- The checks on the object parameters are done, move onto the rest - -- of the parameters. - - if not In_Scope then - Prim_Param := Next (Prim_Param); - end if; - - Iface_Param := Next (Iface_Param); - while Present (Iface_Param) and then Present (Prim_Param) loop - Iface_Id := Defining_Identifier (Iface_Param); - Iface_Typ := Find_Parameter_Type (Iface_Param); - Prim_Id := Defining_Identifier (Prim_Param); - Prim_Typ := Find_Parameter_Type (Prim_Param); - - -- Case of multiple interface types inside a parameter profile - - -- (Obj_Param : in out Iface; ...; Param : Iface) - - -- If the interface type is implemented, then the matching type - -- in the primitive should be the implementing record type. - - if Ekind (Iface_Typ) = E_Record_Type - and then Is_Interface (Iface_Typ) - and then Is_Implemented (Iface_Typ) - then - if Prim_Typ /= Tag_Typ then - return False; - end if; - - -- The two parameters must be both mode and subtype conformant - - elsif Ekind (Iface_Id) /= Ekind (Prim_Id) - or else - not Conforming_Types (Iface_Typ, Prim_Typ, Subtype_Conformant) - then - return False; - end if; - - Next (Iface_Param); - Next (Prim_Param); - end loop; - - -- One of the two lists contains more parameters than the other - - if Present (Iface_Param) or else Present (Prim_Param) then - return False; - end if; - - return True; - end Matches_Prefixed_View_Profile; - - -- Start of processing for Find_Overridden_Synchronized_Primitive - - begin - -- At this point the caller should have collected the interfaces - -- implemented by the synchronized type. - - pragma Assert (Present (Ifaces_List)); - - -- Find the tagged type to which subprogram Def_Id is primitive. If the - -- subprogram was declared within a protected or a task type, the type - -- is the scope itself, otherwise it is the type of the first parameter. - - if In_Scope then - Tag_Typ := Scope (Def_Id); - - elsif Present (First_Formal (Def_Id)) then - Tag_Typ := Find_Parameter_Type (Parent (First_Formal (Def_Id))); - - -- A parameterless subprogram which is declared outside a synchronized - -- type cannot act as a primitive, thus it cannot override anything. - - else - return Empty; - end if; - - -- Traverse the homonym chain, looking at a potentially overridden - -- subprogram that belongs to an implemented interface. - - Hom := First_Hom; - while Present (Hom) loop - Subp := Hom; - - -- Entries can override abstract or null interface procedures - - if Ekind (Def_Id) = E_Entry - and then Ekind (Subp) = E_Procedure - and then Nkind (Parent (Subp)) = N_Procedure_Specification - and then (Is_Abstract_Subprogram (Subp) - or else Null_Present (Parent (Subp))) - then - while Present (Alias (Subp)) loop - Subp := Alias (Subp); - end loop; - - if Matches_Prefixed_View_Profile - (Parameter_Specifications (Parent (Def_Id)), - Parameter_Specifications (Parent (Subp))) - then - Candidate := Subp; - - -- Absolute match - - if Has_Correct_Formal_Mode (Candidate) then - return Candidate; - end if; - end if; - - -- Procedures can override abstract or null interface procedures - - elsif Ekind (Def_Id) = E_Procedure - and then Ekind (Subp) = E_Procedure - and then Nkind (Parent (Subp)) = N_Procedure_Specification - and then (Is_Abstract_Subprogram (Subp) - or else Null_Present (Parent (Subp))) - and then Matches_Prefixed_View_Profile - (Parameter_Specifications (Parent (Def_Id)), - Parameter_Specifications (Parent (Subp))) - then - Candidate := Subp; - - -- Absolute match - - if Has_Correct_Formal_Mode (Candidate) then - return Candidate; - end if; - - -- Functions can override abstract interface functions - - elsif Ekind (Def_Id) = E_Function - and then Ekind (Subp) = E_Function - and then Nkind (Parent (Subp)) = N_Function_Specification - and then Is_Abstract_Subprogram (Subp) - and then Matches_Prefixed_View_Profile - (Parameter_Specifications (Parent (Def_Id)), - Parameter_Specifications (Parent (Subp))) - and then Etype (Result_Definition (Parent (Def_Id))) = - Etype (Result_Definition (Parent (Subp))) - then - return Subp; - end if; - - Hom := Homonym (Hom); - end loop; - - -- After examining all candidates for overriding, we are left with - -- the best match which is a mode incompatible interface routine. - -- Do not emit an error if the Expander is active since this error - -- will be detected later on after all concurrent types are expanded - -- and all wrappers are built. This check is meant for spec-only - -- compilations. - - if Present (Candidate) - and then not Expander_Active - then - Iface_Typ := Find_Parameter_Type (Parent (First_Formal (Candidate))); - - -- Def_Id is primitive of a protected type, declared inside the type, - -- and the candidate is primitive of a limited or synchronized - -- interface. - - if In_Scope - and then Is_Protected_Type (Tag_Typ) - and then - (Is_Limited_Interface (Iface_Typ) - or else Is_Protected_Interface (Iface_Typ) - or else Is_Synchronized_Interface (Iface_Typ) - or else Is_Task_Interface (Iface_Typ)) - then - -- Must reword this message, comma before to in -gnatj mode ??? - - Error_Msg_NE - ("first formal of & must be of mode `OUT`, `IN OUT` or " & - "access-to-variable", Tag_Typ, Candidate); - Error_Msg_N - ("\to be overridden by protected procedure or entry " & - "(RM 9.4(11.9/2))", Tag_Typ); - end if; - end if; - - return Candidate; - end Find_Overridden_Synchronized_Primitive; - ------------------------- -- Find_Parameter_Type -- ------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index aeedc7d0a81..bbd4c864a3e 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -327,18 +327,6 @@ package Sem_Util is -- not an address representation clause, or if it is not possible to -- determine that the address is of this form, then Empty is returned. - function Find_Overridden_Synchronized_Primitive - (Def_Id : Entity_Id; - First_Hom : Entity_Id; - Ifaces_List : Elist_Id; - In_Scope : Boolean) return Entity_Id; - -- Determine whether entry or subprogram Def_Id overrides a primitive - -- operation that belongs to one of the interfaces in Ifaces_List. A - -- specific homonym chain can be specified by setting First_Hom. Flag - -- In_Scope is used to designate whether the entry or subprogram was - -- declared inside the scope of the synchronized type or after. Return - -- the overridden entity or Empty. - function Find_Parameter_Type (Param : Node_Id) return Entity_Id; -- Return the type of formal parameter Param as determined by its -- specification. diff --git a/gcc/ada/sinput-p.adb b/gcc/ada/sinput-p.adb index 9719d1b646c..b57c73bf957 100644 --- a/gcc/ada/sinput-p.adb +++ b/gcc/ada/sinput-p.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- -- @@ -95,6 +95,11 @@ package body Sinput.P is begin Prj.Err.Scanner.Initialize_Scanner (X); + -- No error for special characters that are used for preprocessing + + Prj.Err.Scanner.Set_Special_Character ('#'); + Prj.Err.Scanner.Set_Special_Character ('$'); + -- We scan past junk to the first interesting compilation unit -- token, to see if it is SEPARATE. We ignore WITH keywords during -- this and also PRIVATE. The reason for ignoring PRIVATE is that @@ -108,6 +113,8 @@ package body Sinput.P is Prj.Err.Scanner.Scan; end loop; + Prj.Err.Scanner.Reset_Special_Characters; + return Token = Tok_Separate; end Source_File_Is_Subunit; diff --git a/gcc/ada/sinput-p.ads b/gcc/ada/sinput-p.ads index 54171fb3298..2eb3e376802 100644 --- a/gcc/ada/sinput-p.ads +++ b/gcc/ada/sinput-p.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -32,8 +32,8 @@ with Scans; use Scans; package Sinput.P is function Load_Project_File (Path : String) return Source_File_Index; - -- Load into memory the source of a project source file. - -- Initialize the Scans state. + -- Load the source of a project source file into memory and initialize the + -- Scans state. procedure Reset_First; -- Indicate that the next project loaded should be considered as the first @@ -41,13 +41,13 @@ package Sinput.P is -- is to get the correct number of lines when error finalization is called. function Source_File_Is_Subunit (X : Source_File_Index) return Boolean; - -- This function determines if a source file represents a subunit. It - -- works by scanning for the first compilation unit token, and returning - -- True if it is the token SEPARATE. It will return False otherwise, - -- meaning that the file cannot possibly be a legal subunit. This - -- function does NOT do a complete parse of the file, or build a - -- tree. It is used in gnatmake to decide if a body without a spec - -- in a project file needs to be compiled or not. + -- This function determines if a source file represents a subunit. It works + -- by scanning for the first compilation unit token, and returning True if + -- it is the token SEPARATE. It will return False otherwise, meaning that + -- the file cannot possibly be a legal subunit. This function does NOT do a + -- complete parse of the file, or build a tree. It is used in gnatmake and + -- gprbuild to decide if a body without a spec in a project file needs to + -- be compiled or not. type Saved_Project_Scan_State is limited private; -- Used to save project scan state in following two routines @@ -55,14 +55,14 @@ package Sinput.P is procedure Save_Project_Scan_State (Saved_State : out Saved_Project_Scan_State); pragma Inline (Save_Project_Scan_State); - -- Save the Scans state, as well as the values of - -- Source and Current_Source_File. + -- Save the Scans state, as well as the values of Source and + -- Current_Source_File. procedure Restore_Project_Scan_State (Saved_State : Saved_Project_Scan_State); pragma Inline (Restore_Project_Scan_State); - -- Restore the Scans state and the values of - -- Source and Current_Source_File. + -- Restore the Scans state and the values of Source and + -- Current_Source_File. private diff --git a/gcc/ada/system-lynxos-ppc.ads b/gcc/ada/system-lynxos-ppc.ads index c508d140d6c..44a0405e2ee 100644 --- a/gcc/ada/system-lynxos-ppc.ads +++ b/gcc/ada/system-lynxos-ppc.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (LynxOS PPC Version) -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- 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 -- @@ -152,7 +152,7 @@ private Support_Composite_Assign : constant Boolean := True; Support_Composite_Compare : constant Boolean := True; Support_Long_Shifts : constant Boolean := True; - Always_Compatible_Rep : 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 := False; diff --git a/gcc/ada/system-lynxos-x86.ads b/gcc/ada/system-lynxos-x86.ads index c93c6d77d1c..e40bec84bdb 100644 --- a/gcc/ada/system-lynxos-x86.ads +++ b/gcc/ada/system-lynxos-x86.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (LynxOS x86 Version) -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- 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 -- @@ -152,7 +152,7 @@ private Support_Composite_Assign : constant Boolean := True; Support_Composite_Compare : constant Boolean := True; Support_Long_Shifts : constant Boolean := True; - Always_Compatible_Rep : 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 := False; diff --git a/gcc/basic-block.h b/gcc/basic-block.h index 53e8a8b5685..17ec338a7a4 100644 --- a/gcc/basic-block.h +++ b/gcc/basic-block.h @@ -827,6 +827,7 @@ extern void compute_available (sbitmap *, sbitmap *, sbitmap *, sbitmap *); /* In predict.c */ extern bool maybe_hot_bb_p (const_basic_block); +extern bool maybe_hot_edge_p (edge); extern bool probably_cold_bb_p (const_basic_block); extern bool probably_never_executed_bb_p (const_basic_block); extern bool tree_predicted_by_p (const_basic_block, enum br_predictor); diff --git a/gcc/builtins.c b/gcc/builtins.c index 695567cfbfc..05eb6bbdd98 100644 --- a/gcc/builtins.c +++ b/gcc/builtins.c @@ -708,11 +708,11 @@ expand_builtin_setjmp_receiver (rtx receiver_label ATTRIBUTE_UNUSED) { /* Clobber the FP when we get here, so we have to make sure it's marked as used by this function. */ - emit_insn (gen_rtx_USE (VOIDmode, hard_frame_pointer_rtx)); + emit_use (hard_frame_pointer_rtx); /* Mark the static chain as clobbered here so life information doesn't get messed up for it. */ - emit_insn (gen_rtx_CLOBBER (VOIDmode, static_chain_rtx)); + emit_clobber (static_chain_rtx); /* Now put in the code to restore the frame pointer, and argument pointer, if needed. */ @@ -723,7 +723,7 @@ expand_builtin_setjmp_receiver (rtx receiver_label ATTRIBUTE_UNUSED) emit_move_insn (virtual_stack_vars_rtx, hard_frame_pointer_rtx); /* This might change the hard frame pointer in ways that aren't apparent to early optimization passes, so force a clobber. */ - emit_insn (gen_rtx_CLOBBER (VOIDmode, hard_frame_pointer_rtx)); + emit_clobber (hard_frame_pointer_rtx); } #if ARG_POINTER_REGNUM != HARD_FRAME_POINTER_REGNUM @@ -822,18 +822,14 @@ expand_builtin_longjmp (rtx buf_addr, rtx value) { lab = copy_to_reg (lab); - emit_insn (gen_rtx_CLOBBER (VOIDmode, - gen_rtx_MEM (BLKmode, - gen_rtx_SCRATCH (VOIDmode)))); - emit_insn (gen_rtx_CLOBBER (VOIDmode, - gen_rtx_MEM (BLKmode, - hard_frame_pointer_rtx))); + emit_clobber (gen_rtx_MEM (BLKmode, gen_rtx_SCRATCH (VOIDmode))); + emit_clobber (gen_rtx_MEM (BLKmode, hard_frame_pointer_rtx)); emit_move_insn (hard_frame_pointer_rtx, fp); emit_stack_restore (SAVE_NONLOCAL, stack, NULL_RTX); - emit_insn (gen_rtx_USE (VOIDmode, hard_frame_pointer_rtx)); - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); + emit_use (hard_frame_pointer_rtx); + emit_use (stack_pointer_rtx); emit_indirect_jump (lab); } } @@ -892,13 +888,8 @@ expand_builtin_nonlocal_goto (tree exp) { r_label = copy_to_reg (r_label); - emit_insn (gen_rtx_CLOBBER (VOIDmode, - gen_rtx_MEM (BLKmode, - gen_rtx_SCRATCH (VOIDmode)))); - - emit_insn (gen_rtx_CLOBBER (VOIDmode, - gen_rtx_MEM (BLKmode, - hard_frame_pointer_rtx))); + emit_clobber (gen_rtx_MEM (BLKmode, gen_rtx_SCRATCH (VOIDmode))); + emit_clobber (gen_rtx_MEM (BLKmode, hard_frame_pointer_rtx)); /* Restore frame pointer for containing function. This sets the actual hard register used for the frame pointer @@ -910,8 +901,8 @@ expand_builtin_nonlocal_goto (tree exp) /* USE of hard_frame_pointer_rtx added for consistency; not clear if really needed. */ - emit_insn (gen_rtx_USE (VOIDmode, hard_frame_pointer_rtx)); - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); + emit_use (hard_frame_pointer_rtx); + emit_use (stack_pointer_rtx); /* If the architecture is using a GP register, we must conservatively assume that the target function makes use of it. @@ -924,7 +915,7 @@ expand_builtin_nonlocal_goto (tree exp) a no-op if the GP register is a global invariant.) */ if ((unsigned) PIC_OFFSET_TABLE_REGNUM != INVALID_REGNUM && fixed_regs[PIC_OFFSET_TABLE_REGNUM]) - emit_insn (gen_rtx_USE (VOIDmode, pic_offset_table_rtx)); + emit_use (pic_offset_table_rtx); emit_indirect_jump (r_label); } @@ -1602,7 +1593,7 @@ expand_builtin_return (rtx result) emit_move_insn (reg, adjust_address (result, mode, size)); push_to_sequence (call_fusage); - emit_insn (gen_rtx_USE (VOIDmode, reg)); + emit_use (reg); call_fusage = get_insns (); end_sequence (); size += GET_MODE_SIZE (mode); @@ -5249,18 +5240,17 @@ build_string_literal (int len, const char *str) t = build_string (len, str); elem = build_type_variant (char_type_node, 1, 0); - index = build_index_type (build_int_cst (NULL_TREE, len - 1)); + index = build_index_type (size_int (len - 1)); type = build_array_type (elem, index); TREE_TYPE (t) = type; TREE_CONSTANT (t) = 1; TREE_READONLY (t) = 1; TREE_STATIC (t) = 1; - type = build_pointer_type (type); - t = build1 (ADDR_EXPR, type, t); - type = build_pointer_type (elem); - t = build1 (NOP_EXPR, type, t); + t = build1 (ADDR_EXPR, type, + build4 (ARRAY_REF, elem, + t, integer_zero_node, NULL_TREE, NULL_TREE)); return t; } diff --git a/gcc/c.opt b/gcc/c.opt index 18ce852dc86..9669f2ca6ba 100644 --- a/gcc/c.opt +++ b/gcc/c.opt @@ -195,6 +195,10 @@ Wendif-labels C ObjC C++ ObjC++ Warning Warn about stray tokens after #elif and #endif +Wenum-compare +C++ ObjC++ Var(warn_enum_compare) Init(1) Warning +Warn about comparison of different enum types + Werror C ObjC C++ ObjC++ ; Documented in common.opt diff --git a/gcc/cfgbuild.c b/gcc/cfgbuild.c index b4e3baad820..3b9c6faef8e 100644 --- a/gcc/cfgbuild.c +++ b/gcc/cfgbuild.c @@ -170,7 +170,7 @@ count_basic_blocks (const_rtx f) check for the edge case of do-nothing functions with no basic blocks. */ if (count == NUM_FIXED_BLOCKS) { - emit_insn (gen_rtx_USE (VOIDmode, const0_rtx)); + emit_use (const0_rtx); count = NUM_FIXED_BLOCKS + 1; } diff --git a/gcc/cfgrtl.c b/gcc/cfgrtl.c index 994fb16fc47..8ce39006cf3 100644 --- a/gcc/cfgrtl.c +++ b/gcc/cfgrtl.c @@ -2809,7 +2809,7 @@ rtl_flow_call_edges_add (sbitmap blocks) e = find_edge (bb, EXIT_BLOCK_PTR); if (e) { - insert_insn_on_edge (gen_rtx_USE (VOIDmode, const0_rtx), e); + insert_insn_on_edge (gen_use (const0_rtx), e); commit_edge_insertions (); } } diff --git a/gcc/config.gcc b/gcc/config.gcc index c35d52aa48b..806728794f1 100644 --- a/gcc/config.gcc +++ b/gcc/config.gcc @@ -120,6 +120,9 @@ # cxx_target_objs List of extra target-dependent objects that be # linked into the C++ compiler only. # +# fortran_target_objs List of extra target-dependent objects that be +# linked into the fortran compiler only. +# # target_gtfiles List of extra source files with type information. # # xm_defines List of macros to define when compiling for the @@ -173,6 +176,7 @@ extra_gcc_objs= extra_options= c_target_objs= cxx_target_objs= +fortran_target_objs= tm_defines= xm_defines= # Set this to force installation and use of collect2. @@ -433,6 +437,7 @@ case ${target} in extra_options="${extra_options} darwin.opt" c_target_objs="darwin-c.o" cxx_target_objs="darwin-c.o" + fortran_target_objs="darwin-f.o" extra_objs="darwin.o" extra_gcc_objs="darwin-driver.o" default_use_cxa_atexit=yes @@ -3182,7 +3187,7 @@ case "${target}" in for which in arch tune; do eval "val=\$with_$which" case ${val} in - "" | g5 | g6 | z900 | z990 | z9-109 | z9-ec) + "" | g5 | g6 | z900 | z990 | z9-109 | z9-ec | z10) # OK ;; *) diff --git a/gcc/config.in b/gcc/config.in index 3c02951378a..ec2c468d402 100644 --- a/gcc/config.in +++ b/gcc/config.in @@ -1,6 +1,6 @@ /* config.in. Generated from configure.ac by autoheader. */ -/* Define as the number of bits in a byte, if \`limits.h' doesn't. */ +/* Define as the number of bits in a byte, if `limits.h' doesn't. */ #ifndef USED_FOR_TARGET #undef CHAR_BIT #endif @@ -729,6 +729,12 @@ #endif +/* Define to 1 if you have the <dlfcn.h> header file. */ +#ifndef USED_FOR_TARGET +#undef HAVE_DLFCN_H +#endif + + /* Define to 1 if you have the <fcntl.h> header file. */ #ifndef USED_FOR_TARGET #undef HAVE_FCNTL_H @@ -1315,6 +1321,13 @@ #endif +/* Define to the sub-directory in which libtool stores uninstalled libraries. + */ +#ifndef USED_FOR_TARGET +#undef LT_OBJDIR +#endif + + /* Define if host mkdir takes a single argument. */ #ifndef USED_FOR_TARGET #undef MKDIR_TAKES_ONE_ARG @@ -1523,7 +1536,7 @@ #endif -/* Define to \`long' if <sys/resource.h> doesn't define. */ +/* Define to `long' if <sys/resource.h> doesn't define. */ #ifndef USED_FOR_TARGET #undef rlim_t #endif diff --git a/gcc/config/alpha/alpha.md b/gcc/config/alpha/alpha.md index 768ff38b8bb..fed9efee89e 100644 --- a/gcc/config/alpha/alpha.md +++ b/gcc/config/alpha/alpha.md @@ -6948,8 +6948,8 @@ emit_move_insn (hard_frame_pointer_rtx, fp); emit_move_insn (pv, lab); emit_stack_restore (SAVE_NONLOCAL, stack, NULL_RTX); - emit_insn (gen_rtx_USE (VOIDmode, hard_frame_pointer_rtx)); - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); + emit_use (hard_frame_pointer_rtx); + emit_use (stack_pointer_rtx); /* Load the label we are jumping through into $27 so that we know where to look for it when we get back to setjmp's function for diff --git a/gcc/config/arc/arc.md b/gcc/config/arc/arc.md index 64f1c449ca1..da435941427 100644 --- a/gcc/config/arc/arc.md +++ b/gcc/config/arc/arc.md @@ -313,7 +313,7 @@ ;{ ; /* Flow doesn't understand that this is effectively a DFmode move. ; It doesn't know that all of `operands[0]' is set. */ -; emit_insn (gen_rtx_CLOBBER (VOIDmode, operands[0])); +; emit_clobber (operands[0]); ; ; /* Emit insns that movsi_insn can handle. */ ; emit_insn (gen_movsi (operand_subword (operands[0], 0, 0, DImode), @@ -406,7 +406,7 @@ ;{ ; /* Flow doesn't understand that this is effectively a DFmode move. ; It doesn't know that all of `operands[0]' is set. */ -; emit_insn (gen_rtx_CLOBBER (VOIDmode, operands[0])); +; emit_clobber (operands[0]); ; ; /* Emit insns that movsi_insn can handle. */ ; emit_insn (gen_movsi (operand_subword (operands[0], 0, 0, DFmode), diff --git a/gcc/config/arm/arm.c b/gcc/config/arm/arm.c index 38d4a2d9d9f..e1ec23b3862 100644 --- a/gcc/config/arm/arm.c +++ b/gcc/config/arm/arm.c @@ -3693,7 +3693,7 @@ arm_load_pic_register (unsigned long saved_regs ATTRIBUTE_UNUSED) /* Need to emit this whether or not we obey regdecls, since setjmp/longjmp can cause life info to screw up. */ - emit_insn (gen_rtx_USE (VOIDmode, pic_reg)); + emit_use (pic_reg); } @@ -17064,10 +17064,10 @@ thumb1_expand_epilogue (void) so that flow2 will get register lifetimes correct. */ for (regno = 0; regno < 13; regno++) if (df_regs_ever_live_p (regno) && !call_used_regs[regno]) - emit_insn (gen_rtx_CLOBBER (VOIDmode, gen_rtx_REG (SImode, regno))); + emit_clobber (gen_rtx_REG (SImode, regno)); if (! df_regs_ever_live_p (LR_REGNUM)) - emit_insn (gen_rtx_USE (VOIDmode, gen_rtx_REG (SImode, LR_REGNUM))); + emit_use (gen_rtx_REG (SImode, LR_REGNUM)); } static void @@ -18329,7 +18329,7 @@ thumb_set_return_address (rtx source, rtx scratch) rtx addr; unsigned long mask; - emit_insn (gen_rtx_USE (VOIDmode, source)); + emit_use (source); offsets = arm_get_frame_offsets (); mask = offsets->saved_regs_mask; diff --git a/gcc/config/arm/arm.md b/gcc/config/arm/arm.md index c66ea74d2af..9cd6e7262a2 100644 --- a/gcc/config/arm/arm.md +++ b/gcc/config/arm/arm.md @@ -8785,8 +8785,7 @@ /* Emit USE insns before the return. */ for (i = 0; i < XVECLEN (operands[1], 0); i++) - emit_insn (gen_rtx_USE (VOIDmode, - SET_DEST (XVECEXP (operands[1], 0, i)))); + emit_use (SET_DEST (XVECEXP (operands[1], 0, i))); /* Construct the return. */ expand_naked_return (); diff --git a/gcc/config/arm/linux-elf.h b/gcc/config/arm/linux-elf.h index ca56f7bb669..7036e71f8b3 100644 --- a/gcc/config/arm/linux-elf.h +++ b/gcc/config/arm/linux-elf.h @@ -111,7 +111,7 @@ /* The GNU/Linux profiler clobbers the link register. Make sure the prologue knows to save it. */ #define PROFILE_HOOK(X) \ - emit_insn (gen_rtx_CLOBBER (VOIDmode, gen_rtx_REG (SImode, LR_REGNUM))) + emit_clobber (gen_rtx_REG (SImode, LR_REGNUM)) /* The GNU/Linux profiler needs a frame pointer. */ #define SUBTARGET_FRAME_POINTER_REQUIRED crtl->profile diff --git a/gcc/config/avr/avr.c b/gcc/config/avr/avr.c index d2cc33a0293..405f42f7632 100644 --- a/gcc/config/avr/avr.c +++ b/gcc/config/avr/avr.c @@ -83,6 +83,8 @@ static bool avr_rtx_costs (rtx, int, int, int *); static int avr_address_cost (rtx); static bool avr_return_in_memory (const_tree, const_tree); static struct machine_function * avr_init_machine_status (void); +static rtx avr_builtin_setjmp_frame_value (void); + /* Allocate registers from r25 to r8 for parameters for function calls. */ #define FIRST_CUM_REG 26 @@ -323,6 +325,9 @@ int avr_case_values_threshold = 30000; #undef TARGET_STRICT_ARGUMENT_NAMING #define TARGET_STRICT_ARGUMENT_NAMING hook_bool_CUMULATIVE_ARGS_true +#undef TARGET_BUILTIN_SETJMP_FRAME_VALUE +#define TARGET_BUILTIN_SETJMP_FRAME_VALUE avr_builtin_setjmp_frame_value + struct gcc_target targetm = TARGET_INITIALIZER; void @@ -523,6 +528,17 @@ initial_elimination_offset (int from, int to) } } +/* Actual start of frame is virtual_stack_vars_rtx this is offset from + frame pointer by +STARTING_FRAME_OFFSET. + Using saved frame = virtual_stack_vars_rtx - STARTING_FRAME_OFFSET + avoids creating add/sub of offset in nonlocal goto and setjmp. */ + +rtx avr_builtin_setjmp_frame_value (void) +{ + return gen_rtx_MINUS (Pmode, virtual_stack_vars_rtx, + gen_int_mode (STARTING_FRAME_OFFSET, Pmode)); +} + /* Return 1 if the function epilogue is just a single "ret". */ int @@ -680,7 +696,7 @@ expand_prologue (void) RTX_FRAME_RELATED_P (insn) = 1; /* Prevent any attempt to delete the setting of ZERO_REG! */ - emit_insn (gen_rtx_USE (VOIDmode, zero_reg_rtx)); + emit_use (zero_reg_rtx); } if (minimize && (frame_pointer_needed || (AVR_2_BYTE_PC && live_seq > 6) @@ -763,8 +779,32 @@ expand_prologue (void) GET_MODE(myfp)))); RTX_FRAME_RELATED_P (insn) = 1; - insn = emit_move_insn (stack_pointer_rtx, frame_pointer_rtx); - RTX_FRAME_RELATED_P (insn) = 1; + /* Copy to stack pointer. */ + if (TARGET_TINY_STACK) + { + insn = emit_move_insn (stack_pointer_rtx, frame_pointer_rtx); + RTX_FRAME_RELATED_P (insn) = 1; + } + else if (TARGET_NO_INTERRUPTS + || cfun->machine->is_signal + || cfun->machine->is_OS_main) + { + insn = + emit_insn (gen_movhi_sp_r_irq_off (stack_pointer_rtx, + frame_pointer_rtx)); + RTX_FRAME_RELATED_P (insn) = 1; + } + else if (cfun->machine->is_interrupt) + { + insn = emit_insn (gen_movhi_sp_r_irq_on (stack_pointer_rtx, + frame_pointer_rtx)); + RTX_FRAME_RELATED_P (insn) = 1; + } + else + { + insn = emit_move_insn (stack_pointer_rtx, frame_pointer_rtx); + RTX_FRAME_RELATED_P (insn) = 1; + } fp_plus_insns = get_insns (); end_sequence (); @@ -915,7 +955,25 @@ expand_epilogue (void) GET_MODE(myfp)))); /* Copy to stack pointer. */ - emit_move_insn (stack_pointer_rtx, frame_pointer_rtx); + if (TARGET_TINY_STACK) + { + emit_move_insn (stack_pointer_rtx, frame_pointer_rtx); + } + else if (TARGET_NO_INTERRUPTS + || cfun->machine->is_signal) + { + emit_insn (gen_movhi_sp_r_irq_off (stack_pointer_rtx, + frame_pointer_rtx)); + } + else if (cfun->machine->is_interrupt) + { + emit_insn (gen_movhi_sp_r_irq_on (stack_pointer_rtx, + frame_pointer_rtx)); + } + else + { + emit_move_insn (stack_pointer_rtx, frame_pointer_rtx); + } fp_plus_insns = get_insns (); end_sequence (); @@ -1708,32 +1766,12 @@ output_movhi (rtx insn, rtx operands[], int *l) if (test_hard_reg_class (STACK_REG, dest)) { if (TARGET_TINY_STACK) - { - *l = 1; - return AS2 (out,__SP_L__,%A1); - } - /* Use simple load of stack pointer if no interrupts are used - or inside main or signal function prologue where they disabled. */ - else if (TARGET_NO_INTERRUPTS - || (reload_completed - && cfun->machine->is_signal - && prologue_epilogue_contains (insn))) - { - *l = 2; - return (AS2 (out,__SP_H__,%B1) CR_TAB - AS2 (out,__SP_L__,%A1)); - } - /* In interrupt prolog we know interrupts are enabled. */ - else if (reload_completed - && cfun->machine->is_interrupt - && prologue_epilogue_contains (insn)) - { - *l = 4; - return ("cli" CR_TAB - AS2 (out,__SP_H__,%B1) CR_TAB - "sei" CR_TAB - AS2 (out,__SP_L__,%A1)); - } + return *l = 1, AS2 (out,__SP_L__,%A1); + /* Use simple load of stack pointer if no interrupts are + used. */ + else if (TARGET_NO_INTERRUPTS) + return *l = 2, (AS2 (out,__SP_H__,%B1) CR_TAB + AS2 (out,__SP_L__,%A1)); *l = 5; return (AS2 (in,__tmp_reg__,__SREG__) CR_TAB "cli" CR_TAB diff --git a/gcc/config/avr/avr.md b/gcc/config/avr/avr.md index ffbbefa74ef..0fd371282cc 100644 --- a/gcc/config/avr/avr.md +++ b/gcc/config/avr/avr.md @@ -56,7 +56,10 @@ (UNSPEC_CLI 3) (UNSPECV_PROLOGUE_SAVES 0) - (UNSPECV_EPILOGUE_RESTORES 1)]) + (UNSPECV_EPILOGUE_RESTORES 1) + (UNSPECV_WRITE_SP_IRQ_ON 2) + (UNSPECV_WRITE_SP_IRQ_OFF 3) + (UNSPECV_GOTO_RECEIVER 4)]) (include "predicates.md") (include "constraints.md") @@ -113,6 +116,63 @@ (const_int 2))] (const_int 2))) +;;======================================================================== +;; The following is used by nonlocal_goto and setjmp. +;; The receiver pattern will create no instructions since internally +;; virtual_stack_vars = hard_frame_pointer + 1 so the RTL become R28=R28 +;; This avoids creating add/sub offsets in frame_pointer save/resore. +;; The 'null' receiver also avoids problems with optimisation +;; not recognising incoming jmp and removing code that resets frame_pointer. +;; The code derived from builtins.c. + +(define_expand "nonlocal_goto_receiver" + [(set (reg:HI REG_Y) + (unspec_volatile:HI [(const_int 0)] UNSPECV_GOTO_RECEIVER))] + "" + { + emit_move_insn (virtual_stack_vars_rtx, + gen_rtx_PLUS (Pmode, hard_frame_pointer_rtx, + gen_int_mode (STARTING_FRAME_OFFSET, + Pmode))); + /* This might change the hard frame pointer in ways that aren't + apparent to early optimization passes, so force a clobber. */ + emit_clobber (hard_frame_pointer_rtx); + DONE; + }) + + +;; Defining nonlocal_goto_receiver means we must also define this. +;; even though its function is identical to that in builtins.c + +(define_expand "nonlocal_goto" + [ + (use (match_operand 0 "general_operand")) + (use (match_operand 1 "general_operand")) + (use (match_operand 2 "general_operand")) + (use (match_operand 3 "general_operand")) + ] + "" +{ + rtx r_label = copy_to_reg (operands[1]); + rtx r_fp = operands[3]; + rtx r_sp = operands[2]; + + emit_clobber (gen_rtx_MEM (BLKmode, gen_rtx_SCRATCH (VOIDmode))); + + emit_clobber (gen_rtx_MEM (BLKmode, hard_frame_pointer_rtx)); + + emit_move_insn (hard_frame_pointer_rtx, r_fp); + emit_stack_restore (SAVE_NONLOCAL, r_sp, NULL_RTX); + + emit_use (hard_frame_pointer_rtx); + emit_use (stack_pointer_rtx); + + emit_indirect_jump (r_label); + + DONE; +}) + + (define_insn "*pushqi" [(set (mem:QI (post_dec (reg:HI REG_SP))) (match_operand:QI 0 "reg_or_0_operand" "r,L"))] @@ -230,6 +290,28 @@ [(set_attr "length" "5,2") (set_attr "cc" "none,none")]) +(define_insn "movhi_sp_r_irq_off" + [(set (match_operand:HI 0 "stack_register_operand" "=q") + (unspec_volatile:HI [(match_operand:HI 1 "register_operand" "r")] + UNSPECV_WRITE_SP_IRQ_OFF))] + "" + "out __SP_H__, %B1 + out __SP_L__, %A1" + [(set_attr "length" "2") + (set_attr "cc" "none")]) + +(define_insn "movhi_sp_r_irq_on" + [(set (match_operand:HI 0 "stack_register_operand" "=q") + (unspec_volatile:HI [(match_operand:HI 1 "register_operand" "r")] + UNSPECV_WRITE_SP_IRQ_ON))] + "" + "cli + out __SP_H__, %B1 + sei + out __SP_L__, %A1" + [(set_attr "length" "4") + (set_attr "cc" "none")]) + (define_peephole2 [(match_scratch:QI 2 "d") (set (match_operand:HI 0 "l_register_operand" "") diff --git a/gcc/config/bfin/bfin.c b/gcc/config/bfin/bfin.c index d6506b6e09b..a7600cf80e2 100644 --- a/gcc/config/bfin/bfin.c +++ b/gcc/config/bfin/bfin.c @@ -1009,12 +1009,12 @@ do_unlink (rtx spreg, HOST_WIDE_INT frame_size, bool all, int epilogue_p) { rtx fpreg = gen_rtx_REG (Pmode, REG_FP); emit_move_insn (fpreg, postinc); - emit_insn (gen_rtx_USE (VOIDmode, fpreg)); + emit_use (fpreg); } if (! current_function_is_leaf) { emit_move_insn (bfin_rets_rtx, postinc); - emit_insn (gen_rtx_USE (VOIDmode, bfin_rets_rtx)); + emit_use (bfin_rets_rtx); } } } diff --git a/gcc/config/bfin/bfin.h b/gcc/config/bfin/bfin.h index 042528a554d..8efcb5ea189 100644 --- a/gcc/config/bfin/bfin.h +++ b/gcc/config/bfin/bfin.h @@ -133,6 +133,8 @@ extern int target_flags; builtin_define ("__WORKAROUND_SPECULATIVE_LOADS"); \ if (ENABLE_WA_SPECULATIVE_SYNCS) \ builtin_define ("__WORKAROUND_SPECULATIVE_SYNCS"); \ + if (ENABLE_WA_RETS) \ + builtin_define ("__WORKAROUND_RETS"); \ \ if (TARGET_FDPIC) \ { \ diff --git a/gcc/config/bfin/bfin.md b/gcc/config/bfin/bfin.md index 6b1c1e8e981..1388266400b 100644 --- a/gcc/config/bfin/bfin.md +++ b/gcc/config/bfin/bfin.md @@ -904,7 +904,7 @@ enum insn_code icode = CODE_FOR_<optab>si3; if (!reg_overlap_mentioned_p (operands[0], operands[1]) && !reg_overlap_mentioned_p (operands[0], operands[2])) - emit_insn (gen_rtx_CLOBBER (VOIDmode, operands[0])); + emit_clobber (operands[0]); split_di (operands, 3, lo_half, hi_half); if (!(*insn_data[icode].operand[2].predicate) (lo_half[2], SImode)) lo_half[2] = force_reg (SImode, lo_half[2]); @@ -1022,7 +1022,7 @@ xops[4] = force_reg (SImode, xops[4]); if (!reg_overlap_mentioned_p (operands[0], operands[1]) && !reg_overlap_mentioned_p (operands[0], operands[2])) - emit_insn (gen_rtx_CLOBBER (VOIDmode, operands[0])); + emit_clobber (operands[0]); emit_insn (gen_add_with_carry (xops[0], xops[2], xops[4], xops[7])); emit_insn (gen_movbisi (xops[6], xops[7])); if (!register_operand (xops[5], SImode) @@ -1055,7 +1055,7 @@ xops[7] = gen_rtx_REG (BImode, REG_CC); if (!reg_overlap_mentioned_p (operands[0], operands[1]) && !reg_overlap_mentioned_p (operands[0], operands[2])) - emit_insn (gen_rtx_CLOBBER (VOIDmode, operands[0])); + emit_clobber (operands[0]); emit_insn (gen_sub_with_carry (xops[0], xops[2], xops[4], xops[7])); emit_insn (gen_notbi (xops[7], xops[7])); emit_insn (gen_movbisi (xops[6], xops[7])); diff --git a/gcc/config/cris/cris.c b/gcc/config/cris/cris.c index b197956b774..810366f5681 100644 --- a/gcc/config/cris/cris.c +++ b/gcc/config/cris/cris.c @@ -3002,7 +3002,7 @@ cris_expand_prologue (void) the GOT register load as maybe-dead. To see this, remove the line below and try libsupc++/vec.cc or a trivial "static void y (); void x () {try {y ();} catch (...) {}}". */ - emit_insn (gen_rtx_USE (VOIDmode, pic_offset_table_rtx)); + emit_use (pic_offset_table_rtx); } if (cris_max_stackframe && framesize > cris_max_stackframe) diff --git a/gcc/config/darwin-f.c b/gcc/config/darwin-f.c new file mode 100644 index 00000000000..24ed674d708 --- /dev/null +++ b/gcc/config/darwin-f.c @@ -0,0 +1,60 @@ +/* Darwin support needed only by Fortran frontends. + Copyright (C) 2008 Free Software Foundation, Inc. + Contributed by Daniel Franke. + +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/>. */ + + +/* Provide stubs for the hooks defined by darwin.h + TARGET_EXTRA_PRE_INCLUDES, TARGET_EXTRA_INCLUDES + + As both, gcc and gfortran link in incpath.o, we can not + conditionally undefine said hooks if fortran is build. + However, we can define do-nothing stubs of said hooks as + we are not interested in objc include files in Fortran. + + The hooks original purpose (see also darwin-c.c): + * darwin_register_objc_includes + Register the GNU objective-C runtime include path if STDINC. + + * darwin_register_frameworks + Register all the system framework paths if STDINC is true and setup + the missing_header callback for subframework searching if any + frameworks had been registered. */ + + +#include "ansidecl.h" + +/* Prototypes for functions below to avoid a lengthy list of includes + to achieve the same. */ +void darwin_register_objc_includes (const char *, const char *, int); +void darwin_register_frameworks (const char *, const char *, int); + + +void +darwin_register_objc_includes (const char *sysroot ATTRIBUTE_UNUSED, + const char *iprefix ATTRIBUTE_UNUSED, + int stdinc ATTRIBUTE_UNUSED) +{ +} + +void +darwin_register_frameworks (const char *sysroot ATTRIBUTE_UNUSED, + const char *iprefix ATTRIBUTE_UNUSED, + int stdinc ATTRIBUTE_UNUSED) +{ +} diff --git a/gcc/config/darwin.c b/gcc/config/darwin.c index 38899833341..5461fe083e0 100644 --- a/gcc/config/darwin.c +++ b/gcc/config/darwin.c @@ -555,7 +555,7 @@ machopic_indirect_data_reference (rtx orig, rtx reg) emit_insn (gen_rtx_SET (VOIDmode, reg, gen_rtx_LO_SUM (Pmode, reg, copy_rtx (offset)))); - emit_insn (gen_rtx_USE (VOIDmode, pic_offset_table_rtx)); + emit_use (pic_offset_table_rtx); orig = gen_rtx_PLUS (Pmode, pic_offset_table_rtx, reg); #endif @@ -756,9 +756,7 @@ machopic_legitimize_pic_address (rtx orig, enum machine_mode mode, rtx reg) pic_ref = reg; #else - emit_insn (gen_rtx_USE (VOIDmode, - gen_rtx_REG (Pmode, - PIC_OFFSET_TABLE_REGNUM))); + emit_use (gen_rtx_REG (Pmode, PIC_OFFSET_TABLE_REGNUM)); emit_insn (gen_rtx_SET (VOIDmode, reg, gen_rtx_HIGH (Pmode, @@ -782,9 +780,7 @@ machopic_legitimize_pic_address (rtx orig, enum machine_mode mode, rtx reg) pic = reg; } #if 0 - emit_insn (gen_rtx_USE (VOIDmode, - gen_rtx_REG (Pmode, - PIC_OFFSET_TABLE_REGNUM))); + emit_use (gen_rtx_REG (Pmode, PIC_OFFSET_TABLE_REGNUM)); #endif if (reload_in_progress) @@ -857,8 +853,7 @@ machopic_legitimize_pic_address (rtx orig, enum machine_mode mode, rtx reg) pic = reg; } #if 0 - emit_insn (gen_rtx_USE (VOIDmode, - pic_offset_table_rtx)); + emit_use (pic_offset_table_rtx); #endif if (reload_in_progress) df_set_regs_ever_live (REGNO (pic), true); diff --git a/gcc/config/frv/frv.c b/gcc/config/frv/frv.c index ef9aa51b9c5..93648ccf39d 100644 --- a/gcc/config/frv/frv.c +++ b/gcc/config/frv/frv.c @@ -1682,7 +1682,7 @@ frv_frame_access (frv_frame_accessor_t *accessor, rtx reg, int stack_offset) } else emit_insn (gen_rtx_SET (VOIDmode, reg, mem)); - emit_insn (gen_rtx_USE (VOIDmode, reg)); + emit_use (reg); } else { @@ -1946,7 +1946,7 @@ frv_expand_epilogue (bool emit_return) if (frame_pointer_needed) { emit_insn (gen_rtx_SET (VOIDmode, fp, gen_rtx_MEM (Pmode, fp))); - emit_insn (gen_rtx_USE (VOIDmode, fp)); + emit_use (fp); } /* Deallocate the stack frame. */ @@ -1972,7 +1972,7 @@ frv_expand_epilogue (bool emit_return) emit_move_insn (lr, return_addr); } - emit_insn (gen_rtx_USE (VOIDmode, lr)); + emit_use (lr); } } @@ -5999,7 +5999,7 @@ frv_ifcvt_modify_insn (ce_if_block_t *ce_info, goto fail; } - frv_ifcvt_add_insn (gen_rtx_USE (VOIDmode, dest), insn, FALSE); + frv_ifcvt_add_insn (gen_use (dest), insn, FALSE); } /* If we are just loading a constant created for a nested conditional @@ -9099,8 +9099,8 @@ frv_expand_mdpackh_builtin (tree call, rtx target) /* The high half of each word is not explicitly initialized, so indicate that the input operands are not live before this point. */ - emit_insn (gen_rtx_CLOBBER (DImode, op0)); - emit_insn (gen_rtx_CLOBBER (DImode, op1)); + emit_clobber (op0); + emit_clobber (op1); /* Move each argument into the low half of its associated input word. */ emit_move_insn (simplify_gen_subreg (HImode, op0, DImode, 2), arg1); diff --git a/gcc/config/i386/cygming.h b/gcc/config/i386/cygming.h index bf46cab15f7..1070c85e71d 100644 --- a/gcc/config/i386/cygming.h +++ b/gcc/config/i386/cygming.h @@ -34,7 +34,10 @@ along with GCC; see the file COPYING3. If not see #endif #undef TARGET_64BIT_MS_ABI -#define TARGET_64BIT_MS_ABI TARGET_64BIT +#define TARGET_64BIT_MS_ABI (!cfun ? DEFAULT_ABI == MS_ABI : TARGET_64BIT && cfun->machine->call_abi == MS_ABI) + +#undef DEFAULT_ABI +#define DEFAULT_ABI (TARGET_64BIT ? MS_ABI : SYSV_ABI) #undef DBX_REGISTER_NUMBER #define DBX_REGISTER_NUMBER(n) \ @@ -123,18 +126,6 @@ along with GCC; see the file COPYING3. If not see #undef LONG_TYPE_SIZE #define LONG_TYPE_SIZE 32 -#undef REG_PARM_STACK_SPACE -#define REG_PARM_STACK_SPACE(FNDECL) (TARGET_64BIT_MS_ABI ? 32 : 0) - -#undef OUTGOING_REG_PARM_STACK_SPACE -#define OUTGOING_REG_PARM_STACK_SPACE(FNTYPE) (TARGET_64BIT_MS_ABI ? 1 : 0) - -#undef REGPARM_MAX -#define REGPARM_MAX (TARGET_64BIT_MS_ABI ? 4 : 3) - -#undef SSE_REGPARM_MAX -#define SSE_REGPARM_MAX (TARGET_64BIT_MS_ABI ? 4 : TARGET_SSE ? 3 : 0) - /* Enable parsing of #pragma pack(push,<n>) and #pragma pack(pop). */ #define HANDLE_PRAGMA_PACK_PUSH_POP 1 /* Enable push_macro & pop_macro */ @@ -214,7 +205,7 @@ do { \ #define CHECK_STACK_LIMIT 4000 #undef STACK_BOUNDARY -#define STACK_BOUNDARY (TARGET_64BIT_MS_ABI ? 128 : BITS_PER_WORD) +#define STACK_BOUNDARY (DEFAULT_ABI == MS_ABI ? 128 : BITS_PER_WORD) /* By default, target has a 80387, uses IEEE compatible arithmetic, returns float values in the 387 and needs stack probes. diff --git a/gcc/config/i386/i386-protos.h b/gcc/config/i386/i386-protos.h index 6fdea06c518..a92272bdb38 100644 --- a/gcc/config/i386/i386-protos.h +++ b/gcc/config/i386/i386-protos.h @@ -137,6 +137,11 @@ extern int ix86_function_arg_boundary (enum machine_mode, tree); extern bool ix86_sol10_return_in_memory (const_tree,const_tree); extern rtx ix86_force_to_memory (enum machine_mode, rtx); extern void ix86_free_from_memory (enum machine_mode); +extern int ix86_cfun_abi (void); +extern int ix86_function_abi (const_tree); +extern int ix86_function_type_abi (const_tree); +extern void ix86_call_abi_override (const_tree); + extern void ix86_split_fp_branch (enum rtx_code code, rtx, rtx, rtx, rtx, rtx, rtx); extern bool ix86_hard_regno_mode_ok (int, enum machine_mode); diff --git a/gcc/config/i386/i386.c b/gcc/config/i386/i386.c index 6cac18ae8aa..b159ce42928 100644 --- a/gcc/config/i386/i386.c +++ b/gcc/config/i386/i386.c @@ -1619,7 +1619,7 @@ rtx ix86_compare_op1 = NULL_RTX; rtx ix86_compare_emitted = NULL_RTX; /* Size of the register save area. */ -#define X86_64_VARARGS_SIZE (REGPARM_MAX * UNITS_PER_WORD + SSE_REGPARM_MAX * 16) +#define X86_64_VARARGS_SIZE (X86_64_REGPARM_MAX * UNITS_PER_WORD + X86_64_SSE_REGPARM_MAX * 16) /* Define the structure for the machine field in struct function. */ @@ -2306,11 +2306,11 @@ override_options (void) } else { - /* For TARGET_64BIT_MS_ABI, force pic on, in order to enable the + /* For TARGET_64BIT and MS_ABI, force pic on, in order to enable the use of rip-relative addressing. This eliminates fixups that would otherwise be needed if this object is to be placed in a DLL, and is essentially just as efficient as direct addressing. */ - if (TARGET_64BIT_MS_ABI) + if (TARGET_64BIT && DEFAULT_ABI == MS_ABI) ix86_cmodel = CM_SMALL_PIC, flag_pic = 1; else if (TARGET_64BIT) ix86_cmodel = flag_pic ? CM_SMALL_PIC : CM_SMALL; @@ -2761,8 +2761,9 @@ override_options (void) set_param_value ("l2-cache-size", ix86_cost->l2_cache_size); /* If using typedef char *va_list, signal that __builtin_va_start (&ap, 0) - can be optimized to ap = __builtin_next_arg (0). */ - if (!TARGET_64BIT || TARGET_64BIT_MS_ABI) + can be optimized to ap = __builtin_next_arg (0). + For abi switching it should be corrected. */ + if (!TARGET_64BIT || DEFAULT_ABI == MS_ABI) targetm.expand_builtin_va_start = NULL; #ifdef USE_IX86_CLD @@ -3166,7 +3167,7 @@ ix86_handle_cconv_attribute (tree *node, tree name, if (TARGET_64BIT) { /* Do not warn when emulating the MS ABI. */ - if (!TARGET_64BIT_MS_ABI) + if (TREE_CODE (*node) != FUNCTION_TYPE || !ix86_function_type_abi (*node)) warning (OPT_Wattributes, "%qs attribute ignored", IDENTIFIER_POINTER (name)); *no_add_attrs = true; @@ -3269,7 +3270,11 @@ ix86_function_regparm (const_tree type, const_tree decl) static bool error_issued; if (TARGET_64BIT) - return regparm; + { + if (ix86_function_type_abi (type) == DEFAULT_ABI) + return regparm; + return DEFAULT_ABI != SYSV_ABI ? X86_64_REGPARM_MAX : X64_REGPARM_MAX; + } attr = lookup_attribute ("regparm", TYPE_ATTRIBUTES (type)); if (attr) @@ -3500,15 +3505,20 @@ ix86_function_arg_regno_p (int regno) return true; } + /* TODO: The function should depend on current function ABI but + builtins.c would need updating then. Therefore we use the + default ABI. */ + /* RAX is used as hidden argument to va_arg functions. */ - if (!TARGET_64BIT_MS_ABI && regno == AX_REG) + if (DEFAULT_ABI == SYSV_ABI && regno == AX_REG) return true; - if (TARGET_64BIT_MS_ABI) + if (DEFAULT_ABI == MS_ABI) parm_regs = x86_64_ms_abi_int_parameter_registers; else parm_regs = x86_64_int_parameter_registers; - for (i = 0; i < REGPARM_MAX; i++) + for (i = 0; i < (DEFAULT_ABI == MS_ABI ? X64_REGPARM_MAX + : X86_64_REGPARM_MAX); i++) if (regno == parm_regs[i]) return true; return false; @@ -3529,6 +3539,98 @@ ix86_must_pass_in_stack (enum machine_mode mode, const_tree type) && type && TREE_CODE (type) != VECTOR_TYPE); } +/* It returns the size, in bytes, of the area reserved for arguments passed + in registers for the function represented by fndecl dependent to the used + abi format. */ +unsigned int +ix86_reg_parm_stack_space (const_tree fndecl) +{ + int call_abi = 0; + /* For libcalls it is possible that there is no fndecl at hand. + Therefore assume for this case the default abi of the target. */ + if (!fndecl) + call_abi = DEFAULT_ABI; + else + call_abi = ix86_function_abi (fndecl); + if (call_abi == 1) + return 32; + return 0; +} + +/* Returns value SYSV_ABI, MS_ABI dependent on fntype, specifying the + call abi used. */ +int +ix86_function_type_abi (const_tree fntype) +{ + if (TARGET_64BIT && fntype != NULL) + { + int abi; + if (DEFAULT_ABI == SYSV_ABI) + abi = lookup_attribute ("ms_abi", TYPE_ATTRIBUTES (fntype)) ? MS_ABI : SYSV_ABI; + else + abi = lookup_attribute ("sysv_abi", TYPE_ATTRIBUTES (fntype)) ? SYSV_ABI : MS_ABI; + + if (DEFAULT_ABI == MS_ABI && abi == SYSV_ABI) + sorry ("using sysv calling convention on target w64 is not supported"); + + return abi; + } + return DEFAULT_ABI; +} + +int +ix86_function_abi (const_tree fndecl) +{ + if (! fndecl) + return DEFAULT_ABI; + return ix86_function_type_abi (TREE_TYPE (fndecl)); +} + +/* Returns value SYSV_ABI, MS_ABI dependent on cfun, specifying the + call abi used. */ +int +ix86_cfun_abi (void) +{ + if (! cfun || ! TARGET_64BIT) + return DEFAULT_ABI; + return cfun->machine->call_abi; +} + +/* regclass.c */ +extern void init_regs (void); + +/* Implementation of call abi switching target hook. Specific to FNDECL + the specific call register sets are set. See also CONDITIONAL_REGISTER_USAGE + for more details. + To prevent redudant calls of costy function init_regs (), it checks not to + reset register usage for default abi. */ +void +ix86_call_abi_override (const_tree fndecl) +{ + if (fndecl == NULL_TREE) + cfun->machine->call_abi = DEFAULT_ABI; + else + cfun->machine->call_abi = ix86_function_type_abi (TREE_TYPE (fndecl)); + if (TARGET_64BIT && cfun->machine->call_abi == MS_ABI && call_used_regs) + { + if (call_used_regs[4 /*RSI*/] != 0 || call_used_regs[5 /*RDI*/] != 0) + { + call_used_regs[4 /*RSI*/] = 0; + call_used_regs[5 /*RDI*/] = 0; + init_regs (); + } + } + else if (TARGET_64BIT && call_used_regs) + { + if (call_used_regs[4 /*RSI*/] != 1 || call_used_regs[5 /*RDI*/] != 1) + { + call_used_regs[4 /*RSI*/] = 1; + call_used_regs[5 /*RDI*/] = 1; + init_regs (); + } + } +} + /* Initialize a variable CUM of type CUMULATIVE_ARGS for a call to a function whose data type is FNTYPE. For a library call, FNTYPE is 0. */ @@ -3542,10 +3644,25 @@ init_cumulative_args (CUMULATIVE_ARGS *cum, /* Argument info to initialize */ struct cgraph_local_info *i = fndecl ? cgraph_local_info (fndecl) : NULL; memset (cum, 0, sizeof (*cum)); + cum->call_abi = ix86_function_type_abi (fntype); /* Set up the number of registers to use for passing arguments. */ cum->nregs = ix86_regparm; + if (TARGET_64BIT) + { + if (cum->call_abi != DEFAULT_ABI) + cum->nregs = DEFAULT_ABI != SYSV_ABI ? X86_64_REGPARM_MAX + : X64_REGPARM_MAX; + } if (TARGET_SSE) - cum->sse_nregs = SSE_REGPARM_MAX; + { + cum->sse_nregs = SSE_REGPARM_MAX; + if (TARGET_64BIT) + { + if (cum->call_abi != DEFAULT_ABI) + cum->sse_nregs = DEFAULT_ABI != SYSV_ABI ? X86_64_SSE_REGPARM_MAX + : X64_SSE_REGPARM_MAX; + } + } if (TARGET_MMX) cum->mmx_nregs = MMX_REGPARM_MAX; cum->warn_sse = true; @@ -4331,7 +4448,7 @@ function_arg_advance (CUMULATIVE_ARGS *cum, enum machine_mode mode, if (type) mode = type_natural_mode (type); - if (TARGET_64BIT_MS_ABI) + if (TARGET_64BIT && (cum ? cum->call_abi : DEFAULT_ABI) == MS_ABI) function_arg_advance_ms_64 (cum, bytes, words); else if (TARGET_64BIT) function_arg_advance_64 (cum, mode, type, words); @@ -4458,8 +4575,11 @@ function_arg_64 (CUMULATIVE_ARGS *cum, enum machine_mode mode, if (mode == VOIDmode) return GEN_INT (cum->maybe_vaarg ? (cum->sse_nregs < 0 - ? SSE_REGPARM_MAX - : cum->sse_regno) + ? (cum->call_abi == DEFAULT_ABI + ? SSE_REGPARM_MAX + : (DEFAULT_ABI != SYSV_ABI ? X86_64_SSE_REGPARM_MAX + : X64_SSE_REGPARM_MAX)) + : cum->sse_regno) : -1); return construct_container (mode, orig_mode, type, 0, cum->nregs, @@ -4533,7 +4653,7 @@ function_arg (CUMULATIVE_ARGS *cum, enum machine_mode omode, if (type && TREE_CODE (type) == VECTOR_TYPE) mode = type_natural_mode (type); - if (TARGET_64BIT_MS_ABI) + if (TARGET_64BIT && (cum ? cum->call_abi : DEFAULT_ABI) == MS_ABI) return function_arg_ms_64 (cum, mode, omode, named, bytes); else if (TARGET_64BIT) return function_arg_64 (cum, mode, omode, type); @@ -4553,7 +4673,7 @@ ix86_pass_by_reference (CUMULATIVE_ARGS *cum ATTRIBUTE_UNUSED, const_tree type, bool named ATTRIBUTE_UNUSED) { /* See Windows x64 Software Convention. */ - if (TARGET_64BIT_MS_ABI) + if (TARGET_64BIT && (cum ? cum->call_abi : DEFAULT_ABI) == MS_ABI) { int msize = (int) GET_MODE_SIZE (mode); if (type) @@ -4638,7 +4758,13 @@ ix86_function_arg_boundary (enum machine_mode mode, tree type) { int align; if (type) - align = TYPE_ALIGN (type); + { + /* Since canonical type is used for call, we convert it to + canonical type if needed. */ + if (!TYPE_STRUCTURAL_EQUALITY_P (type)) + type = TYPE_CANONICAL (type); + align = TYPE_ALIGN (type); + } else align = GET_MODE_ALIGNMENT (mode); if (align < PARM_BOUNDARY) @@ -4680,7 +4806,10 @@ ix86_function_value_regno_p (int regno) return true; case FIRST_FLOAT_REG: - if (TARGET_64BIT_MS_ABI) + /* TODO: The function should depend on current function ABI but + builtins.c would need updating then. Therefore we use the + default ABI. */ + if (TARGET_64BIT && DEFAULT_ABI == MS_ABI) return false; return TARGET_FLOAT_RETURNS_IN_80387; @@ -4771,7 +4900,7 @@ function_value_64 (enum machine_mode orig_mode, enum machine_mode mode, } ret = construct_container (mode, orig_mode, valtype, 1, - REGPARM_MAX, SSE_REGPARM_MAX, + X86_64_REGPARM_MAX, X86_64_SSE_REGPARM_MAX, x86_64_int_return_registers, 0); /* For zero sized structures, construct_container returns NULL, but we @@ -4819,7 +4948,7 @@ ix86_function_value_1 (const_tree valtype, const_tree fntype_or_decl, fn = fntype_or_decl; fntype = fn ? TREE_TYPE (fn) : fntype_or_decl; - if (TARGET_64BIT_MS_ABI) + if (TARGET_64BIT && ix86_function_type_abi (fntype) == MS_ABI) return function_value_ms_64 (orig_mode, mode); else if (TARGET_64BIT) return function_value_64 (orig_mode, mode, valtype); @@ -5016,7 +5145,7 @@ ix86_build_builtin_va_list (void) tree f_gpr, f_fpr, f_ovf, f_sav, record, type_decl; /* For i386 we use plain pointer to argument area. */ - if (!TARGET_64BIT || TARGET_64BIT_MS_ABI) + if (!TARGET_64BIT || ix86_cfun_abi () == MS_ABI) return build_pointer_type (char_type_node); record = (*lang_hooks.types.make_type) (RECORD_TYPE); @@ -5064,6 +5193,10 @@ setup_incoming_varargs_64 (CUMULATIVE_ARGS *cum) rtx nsse_reg; alias_set_type set; int i; + int regparm = ix86_regparm; + + if((cum ? cum->call_abi : ix86_cfun_abi ()) != DEFAULT_ABI) + regparm = DEFAULT_ABI != SYSV_ABI ? X86_64_REGPARM_MAX : X64_REGPARM_MAX; if (! cfun->va_list_gpr_size && ! cfun->va_list_fpr_size) return; @@ -5083,7 +5216,7 @@ setup_incoming_varargs_64 (CUMULATIVE_ARGS *cum) set = get_varargs_alias_set (); for (i = cum->regno; - i < ix86_regparm + i < regparm && i < cum->regno + cfun->va_list_gpr_size / UNITS_PER_WORD; i++) { @@ -5130,7 +5263,7 @@ setup_incoming_varargs_64 (CUMULATIVE_ARGS *cum) tmp_reg = gen_reg_rtx (Pmode); emit_insn (gen_rtx_SET (VOIDmode, tmp_reg, plus_constant (save_area, - 8 * REGPARM_MAX + 127))); + 8 * X86_64_REGPARM_MAX + 127))); mem = gen_rtx_MEM (BLKmode, plus_constant (tmp_reg, -127)); MEM_NOTRAP_P (mem) = 1; set_mem_alias_set (mem, set); @@ -5148,7 +5281,7 @@ setup_incoming_varargs_ms_64 (CUMULATIVE_ARGS *cum) alias_set_type set = get_varargs_alias_set (); int i; - for (i = cum->regno; i < REGPARM_MAX; i++) + for (i = cum->regno; i < X64_REGPARM_MAX; i++) { rtx reg, mem; @@ -5186,7 +5319,7 @@ ix86_setup_incoming_varargs (CUMULATIVE_ARGS *cum, enum machine_mode mode, if (stdarg_p (fntype)) function_arg_advance (&next_cum, mode, type, 1); - if (TARGET_64BIT_MS_ABI) + if ((cum ? cum->call_abi : DEFAULT_ABI) == MS_ABI) setup_incoming_varargs_ms_64 (&next_cum); else setup_incoming_varargs_64 (&next_cum); @@ -5203,7 +5336,7 @@ ix86_va_start (tree valist, rtx nextarg) tree type; /* Only 64bit target needs something special. */ - if (!TARGET_64BIT || TARGET_64BIT_MS_ABI) + if (!TARGET_64BIT || cfun->machine->call_abi == MS_ABI) { std_expand_builtin_va_start (valist, nextarg); return; @@ -5238,7 +5371,7 @@ ix86_va_start (tree valist, rtx nextarg) { type = TREE_TYPE (fpr); t = build2 (GIMPLE_MODIFY_STMT, type, fpr, - build_int_cst (type, n_fpr * 16 + 8*REGPARM_MAX)); + build_int_cst (type, n_fpr * 16 + 8*X86_64_REGPARM_MAX)); TREE_SIDE_EFFECTS (t) = 1; expand_expr (t, const0_rtx, VOIDmode, EXPAND_NORMAL); } @@ -5282,7 +5415,7 @@ ix86_gimplify_va_arg (tree valist, tree type, tree *pre_p, tree *post_p) enum machine_mode nat_mode; /* Only 64bit target needs something special. */ - if (!TARGET_64BIT || TARGET_64BIT_MS_ABI) + if (!TARGET_64BIT || cfun->machine->call_abi == MS_ABI) return std_gimplify_va_arg_expr (valist, type, pre_p, post_p); f_gpr = TYPE_FIELDS (TREE_TYPE (va_list_type_node)); @@ -5304,7 +5437,8 @@ ix86_gimplify_va_arg (tree valist, tree type, tree *pre_p, tree *post_p) nat_mode = type_natural_mode (type); container = construct_container (nat_mode, TYPE_MODE (type), type, 0, - REGPARM_MAX, SSE_REGPARM_MAX, intreg, 0); + X86_64_REGPARM_MAX, X86_64_SSE_REGPARM_MAX, + intreg, 0); /* Pull the value out of the saved registers. */ @@ -5373,7 +5507,7 @@ ix86_gimplify_va_arg (tree valist, tree type, tree *pre_p, tree *post_p) if (needed_intregs) { t = build_int_cst (TREE_TYPE (gpr), - (REGPARM_MAX - needed_intregs + 1) * 8); + (X86_64_REGPARM_MAX - needed_intregs + 1) * 8); t = build2 (GE_EXPR, boolean_type_node, gpr, t); t2 = build1 (GOTO_EXPR, void_type_node, lab_false); t = build3 (COND_EXPR, void_type_node, t, t2, NULL_TREE); @@ -5382,8 +5516,8 @@ ix86_gimplify_va_arg (tree valist, tree type, tree *pre_p, tree *post_p) if (needed_sseregs) { t = build_int_cst (TREE_TYPE (fpr), - (SSE_REGPARM_MAX - needed_sseregs + 1) * 16 - + REGPARM_MAX * 8); + (X86_64_SSE_REGPARM_MAX - needed_sseregs + 1) * 16 + + X86_64_REGPARM_MAX * 8); t = build2 (GE_EXPR, boolean_type_node, fpr, t); t2 = build1 (GOTO_EXPR, void_type_node, lab_false); t = build3 (COND_EXPR, void_type_node, t, t2, NULL_TREE); @@ -6509,9 +6643,9 @@ ix86_expand_prologue (void) bool eax_live; rtx t; - gcc_assert (!TARGET_64BIT || TARGET_64BIT_MS_ABI); + gcc_assert (!TARGET_64BIT || cfun->machine->call_abi == MS_ABI); - if (TARGET_64BIT_MS_ABI) + if (cfun->machine->call_abi == MS_ABI) eax_live = false; else eax_live = ix86_eax_live_at_start_p (); @@ -8325,7 +8459,7 @@ output_pic_addr_const (FILE *file, rtx x, int code) #endif assemble_name (file, name); } - if (!TARGET_MACHO && !TARGET_64BIT_MS_ABI + if (!TARGET_MACHO && !(TARGET_64BIT && DEFAULT_ABI == MS_ABI) && code == 'P' && ! SYMBOL_REF_LOCAL_P (x)) fputs ("@PLT", file); break; @@ -10408,12 +10542,10 @@ ix86_expand_vector_move (enum machine_mode mode, rtx operands[]) && standard_sse_constant_p (op1) <= 0) op1 = validize_mem (force_const_mem (mode, op1)); - /* TDmode values are passed as TImode on the stack. TImode values - are moved via xmm registers, and moving them to stack can result in - unaligned memory access. Use ix86_expand_vector_move_misalign() - if memory operand is not aligned correctly. */ + /* We need to check memory alignment for SSE mode since attribute + can make operands unaligned. */ if (can_create_pseudo_p () - && (mode == TImode) && !TARGET_64BIT + && SSE_REG_MODE_P (mode) && ((MEM_P (op0) && (MEM_ALIGN (op0) < align)) || (MEM_P (op1) && (MEM_ALIGN (op1) < align)))) { @@ -10545,7 +10677,7 @@ ix86_expand_vector_move_misalign (enum machine_mode mode, rtx operands[]) writing to the top half twice. */ if (TARGET_SSE_SPLIT_REGS) { - emit_insn (gen_rtx_CLOBBER (VOIDmode, op0)); + emit_clobber (op0); zero = op0; } else @@ -10579,7 +10711,7 @@ ix86_expand_vector_move_misalign (enum machine_mode mode, rtx operands[]) if (TARGET_SSE_PARTIAL_REG_DEPENDENCY) emit_move_insn (op0, CONST0_RTX (mode)); else - emit_insn (gen_rtx_CLOBBER (VOIDmode, op0)); + emit_clobber (op0); if (mode != V4SFmode) op0 = gen_lowpart (V4SFmode, op0); @@ -10972,7 +11104,7 @@ ix86_expand_convert_uns_didf_sse (rtx target, rtx input) emit_insn (gen_movdi_to_sse (int_xmm, input)); else if (TARGET_SSE_SPLIT_REGS) { - emit_insn (gen_rtx_CLOBBER (VOIDmode, int_xmm)); + emit_clobber (int_xmm); emit_move_insn (gen_lowpart (DImode, int_xmm), input); } else @@ -16418,6 +16550,7 @@ ix86_init_machine_status (void) f = GGC_CNEW (struct machine_function); f->use_fast_prologue_epilogue_nregs = -1; f->tls_descriptor_call_expanded_p = 0; + f->call_abi = DEFAULT_ABI; return f; } @@ -23005,7 +23138,7 @@ x86_this_parameter (tree function) { const int *parm_regs; - if (TARGET_64BIT_MS_ABI) + if (ix86_function_type_abi (type) == MS_ABI) parm_regs = x86_64_ms_abi_int_parameter_registers; else parm_regs = x86_64_int_parameter_registers; @@ -23173,7 +23306,7 @@ x86_output_mi_thunk (FILE *file ATTRIBUTE_UNUSED, output_asm_insn ("jmp\t%P0", xops); /* All thunks should be in the same object as their target, and thus binds_local_p should be true. */ - else if (TARGET_64BIT_MS_ABI) + else if (TARGET_64BIT && cfun->machine->call_abi == MS_ABI) gcc_unreachable (); else { @@ -23255,7 +23388,7 @@ x86_function_profiler (FILE *file, int labelno ATTRIBUTE_UNUSED) fprintf (file, "\tleaq\t%sP%d@(%%rip),%%r11\n", LPREFIX, labelno); #endif - if (!TARGET_64BIT_MS_ABI && flag_pic) + if (DEFAULT_ABI == SYSV_ABI && flag_pic) fprintf (file, "\tcall\t*%s@GOTPCREL(%%rip)\n", MCOUNT_NAME); else fprintf (file, "\tcall\t%s\n", MCOUNT_NAME); @@ -24180,7 +24313,7 @@ ix86_expand_vector_init_general (bool mmx_ok, enum machine_mode mode, else if (n_words == 2) { rtx tmp = gen_reg_rtx (mode); - emit_insn (gen_rtx_CLOBBER (VOIDmode, tmp)); + emit_clobber (tmp); emit_move_insn (gen_lowpart (word_mode, tmp), words[0]); emit_move_insn (gen_highpart (word_mode, tmp), words[1]); emit_move_insn (target, tmp); diff --git a/gcc/config/i386/i386.h b/gcc/config/i386/i386.h index ef8da17af3f..552515fc6c3 100644 --- a/gcc/config/i386/i386.h +++ b/gcc/config/i386/i386.h @@ -446,7 +446,17 @@ extern tree x86_mfence; #define TARGET_MACHO 0 /* Likewise, for the Windows 64-bit ABI. */ -#define TARGET_64BIT_MS_ABI 0 +#define TARGET_64BIT_MS_ABI (TARGET_64BIT && ix86_cfun_abi () == MS_ABI) + +/* Available call abi. */ +enum +{ + SYSV_ABI = 0, + MS_ABI = 1 +}; + +/* The default abi form used by target. */ +#define DEFAULT_ABI SYSV_ABI /* Subtargets may reset this to 1 in order to enable 96-bit long double with the rounding mode forced to 53 bits. */ @@ -804,7 +814,8 @@ enum target_cpu_default #define PARM_BOUNDARY BITS_PER_WORD /* Boundary (in *bits*) on which stack pointer should be aligned. */ -#define STACK_BOUNDARY BITS_PER_WORD +#define STACK_BOUNDARY (TARGET_64BIT && DEFAULT_ABI == MS_ABI ? 128 \ + : BITS_PER_WORD) /* Boundary (in *bits*) on which the stack pointer prefers to be aligned; the compiler cannot rely on having this alignment. */ @@ -1044,6 +1055,8 @@ enum target_cpu_default #define ORDER_REGS_FOR_LOCAL_ALLOC x86_order_regs_for_local_alloc () +#define OVERRIDE_ABI_FORMAT(FNDECL) ix86_call_abi_override (FNDECL) + /* Macro to conditionally modify fixed_regs/call_used_regs. */ #define CONDITIONAL_REGISTER_USAGE \ do { \ @@ -1094,7 +1107,7 @@ do { \ for (i = FIRST_REX_SSE_REG; i <= LAST_REX_SSE_REG; i++) \ reg_names[i] = ""; \ } \ - if (TARGET_64BIT_MS_ABI) \ + if (TARGET_64BIT && DEFAULT_ABI == MS_ABI) \ { \ call_used_regs[4 /*RSI*/] = 0; \ call_used_regs[5 /*RDI*/] = 0; \ @@ -1624,7 +1637,11 @@ enum reg_class This space can be allocated by the caller, or be a part of the machine-dependent stack frame: `OUTGOING_REG_PARM_STACK_SPACE' says which. */ -#define REG_PARM_STACK_SPACE(FNDECL) 0 +#define REG_PARM_STACK_SPACE(FNDECL) ix86_reg_parm_stack_space (FNDECL) + +#define OUTGOING_REG_PARM_STACK_SPACE(FNTYPE) (ix86_function_type_abi (FNTYPE) == MS_ABI ? 1 : 0) + +extern unsigned int ix86_reg_parm_stack_space (const_tree); /* Value is the number of bytes of arguments automatically popped when returning from a subroutine call. @@ -1686,6 +1703,8 @@ typedef struct ix86_args { int maybe_vaarg; /* true for calls to possibly vardic fncts. */ int float_in_sse; /* 1 if in 32-bit mode SFmode (2 for DFmode) should be passed in SSE registers. Otherwise 0. */ + int call_abi; /* Set to SYSV_ABI for sysv abi. Otherwise + MS_ABI for ms abi. */ } CUMULATIVE_ARGS; /* Initialize a variable CUM of type CUMULATIVE_ARGS @@ -1953,9 +1972,22 @@ do { \ is also used as the pic register in ELF. So for now, don't allow more than 3 registers to be passed in registers. */ -#define REGPARM_MAX (TARGET_64BIT ? 6 : 3) +/* Abi specific values for REGPARM_MAX and SSE_REGPARM_MAX */ +#define X86_64_REGPARM_MAX 6 +#define X64_REGPARM_MAX 4 +#define X86_32_REGPARM_MAX 3 + +#define X86_64_SSE_REGPARM_MAX 8 +#define X64_SSE_REGPARM_MAX 4 +#define X86_32_SSE_REGPARM_MAX (TARGET_SSE ? 3 : 0) + +#define REGPARM_MAX (TARGET_64BIT ? (TARGET_64BIT_MS_ABI ? X64_REGPARM_MAX \ + : X86_64_REGPARM_MAX) \ + : X86_32_REGPARM_MAX) -#define SSE_REGPARM_MAX (TARGET_64BIT ? 8 : (TARGET_SSE ? 3 : 0)) +#define SSE_REGPARM_MAX (TARGET_64BIT ? (TARGET_64BIT_MS_ABI ? X64_SSE_REGPARM_MAX \ + : X86_64_SSE_REGPARM_MAX) \ + : X86_32_SSE_REGPARM_MAX) #define MMX_REGPARM_MAX (TARGET_64BIT ? 0 : (TARGET_MMX ? 3 : 0)) @@ -2464,6 +2496,9 @@ struct machine_function GTY(()) ix86_current_function_calls_tls_descriptor macro for a better approximation. */ int tls_descriptor_call_expanded_p; + /* This value is used for amd64 targets and specifies the current abi + to be used. MS_ABI means ms abi. Otherwise SYSV_ABI means sysv abi. */ + int call_abi; }; #define ix86_stack_locals (cfun->machine->stack_locals) diff --git a/gcc/config/i386/i386.md b/gcc/config/i386/i386.md index 885077d02b2..ba438fee50f 100644 --- a/gcc/config/i386/i386.md +++ b/gcc/config/i386/i386.md @@ -1169,7 +1169,7 @@ [(match_operand:X87MODEI12 2 "memory_operand" "m")]))] UNSPEC_FNSTSW))] "X87_FLOAT_MODE_P (GET_MODE (operands[1])) - && TARGET_USE_<MODE>MODE_FIOP + && (TARGET_USE_<MODE>MODE_FIOP || optimize_size) && (GET_MODE (operands [3]) == GET_MODE (operands[1]))" "* return output_fp_compare (insn, operands, 0, 0);" [(set_attr "type" "multi") @@ -1186,7 +1186,7 @@ (clobber (match_operand:HI 0 "register_operand" "=a"))] "X87_FLOAT_MODE_P (GET_MODE (operands[1])) && TARGET_SAHF && !TARGET_CMOVE - && TARGET_USE_<MODE>MODE_FIOP + && (TARGET_USE_<MODE>MODE_FIOP || optimize_size) && (GET_MODE (operands [3]) == GET_MODE (operands[1]))" "#" "&& reload_completed" @@ -14288,7 +14288,7 @@ (clobber (reg:CCFP FLAGS_REG)) (clobber (match_scratch:HI 5 "=a,a"))] "X87_FLOAT_MODE_P (GET_MODE (operands[3])) - && TARGET_USE_<MODE>MODE_FIOP + && (TARGET_USE_<MODE>MODE_FIOP || optimize_size) && GET_MODE (operands[1]) == GET_MODE (operands[3]) && !ix86_use_fcomi_compare (swap_condition (GET_CODE (operands[0]))) && ix86_fp_compare_mode (swap_condition (GET_CODE (operands[0]))) == CCFPmode @@ -14708,7 +14708,10 @@ ix86_expand_call ((TARGET_FLOAT_RETURNS_IN_80387 ? gen_rtx_REG (XCmode, FIRST_FLOAT_REG) : NULL), - operands[0], const0_rtx, GEN_INT (SSE_REGPARM_MAX - 1), + operands[0], const0_rtx, + GEN_INT ((DEFAULT_ABI == SYSV_ABI ? X86_64_SSE_REGPARM_MAX + : X64_SSE_REGPARM_MAX) + - 1), NULL, 0); for (i = 0; i < XVECLEN (operands[2], 0); i++) @@ -15798,80 +15801,80 @@ ;; Gcc is slightly more smart about handling normal two address instructions ;; so use special patterns for add and mull. -(define_insn "*fop_sf_comm_mixed" - [(set (match_operand:SF 0 "register_operand" "=f,x") - (match_operator:SF 3 "binary_fp_operator" - [(match_operand:SF 1 "nonimmediate_operand" "%0,0") - (match_operand:SF 2 "nonimmediate_operand" "fm,xm")]))] - "TARGET_MIX_SSE_I387 +(define_insn "*fop_<mode>_comm_mixed" + [(set (match_operand:MODEF 0 "register_operand" "=f,x") + (match_operator:MODEF 3 "binary_fp_operator" + [(match_operand:MODEF 1 "nonimmediate_operand" "%0,0") + (match_operand:MODEF 2 "nonimmediate_operand" "fm,xm")]))] + "SSE_FLOAT_MODE_P (<MODE>mode) && TARGET_MIX_SSE_I387 && COMMUTATIVE_ARITH_P (operands[3]) && !(MEM_P (operands[1]) && MEM_P (operands[2]))" "* return output_387_binary_op (insn, operands);" [(set (attr "type") (if_then_else (eq_attr "alternative" "1") - (if_then_else (match_operand:SF 3 "mult_operator" "") + (if_then_else (match_operand:MODEF 3 "mult_operator" "") (const_string "ssemul") (const_string "sseadd")) - (if_then_else (match_operand:SF 3 "mult_operator" "") + (if_then_else (match_operand:MODEF 3 "mult_operator" "") (const_string "fmul") (const_string "fop")))) - (set_attr "mode" "SF")]) + (set_attr "mode" "<MODE>")]) -(define_insn "*fop_sf_comm_sse" - [(set (match_operand:SF 0 "register_operand" "=x") - (match_operator:SF 3 "binary_fp_operator" - [(match_operand:SF 1 "nonimmediate_operand" "%0") - (match_operand:SF 2 "nonimmediate_operand" "xm")]))] - "TARGET_SSE_MATH +(define_insn "*fop_<mode>_comm_sse" + [(set (match_operand:MODEF 0 "register_operand" "=x") + (match_operator:MODEF 3 "binary_fp_operator" + [(match_operand:MODEF 1 "nonimmediate_operand" "%0") + (match_operand:MODEF 2 "nonimmediate_operand" "xm")]))] + "SSE_FLOAT_MODE_P (<MODE>mode) && TARGET_SSE_MATH && COMMUTATIVE_ARITH_P (operands[3]) && !(MEM_P (operands[1]) && MEM_P (operands[2]))" "* return output_387_binary_op (insn, operands);" [(set (attr "type") - (if_then_else (match_operand:SF 3 "mult_operator" "") + (if_then_else (match_operand:MODEF 3 "mult_operator" "") (const_string "ssemul") (const_string "sseadd"))) - (set_attr "mode" "SF")]) + (set_attr "mode" "<MODE>")]) -(define_insn "*fop_sf_comm_i387" - [(set (match_operand:SF 0 "register_operand" "=f") - (match_operator:SF 3 "binary_fp_operator" - [(match_operand:SF 1 "nonimmediate_operand" "%0") - (match_operand:SF 2 "nonimmediate_operand" "fm")]))] +(define_insn "*fop_<mode>_comm_i387" + [(set (match_operand:MODEF 0 "register_operand" "=f") + (match_operator:MODEF 3 "binary_fp_operator" + [(match_operand:MODEF 1 "nonimmediate_operand" "%0") + (match_operand:MODEF 2 "nonimmediate_operand" "fm")]))] "TARGET_80387 && COMMUTATIVE_ARITH_P (operands[3]) && !(MEM_P (operands[1]) && MEM_P (operands[2]))" "* return output_387_binary_op (insn, operands);" [(set (attr "type") - (if_then_else (match_operand:SF 3 "mult_operator" "") + (if_then_else (match_operand:MODEF 3 "mult_operator" "") (const_string "fmul") (const_string "fop"))) - (set_attr "mode" "SF")]) + (set_attr "mode" "<MODE>")]) -(define_insn "*fop_sf_1_mixed" - [(set (match_operand:SF 0 "register_operand" "=f,f,x") - (match_operator:SF 3 "binary_fp_operator" - [(match_operand:SF 1 "nonimmediate_operand" "0,fm,0") - (match_operand:SF 2 "nonimmediate_operand" "fm,0,xm")]))] - "TARGET_MIX_SSE_I387 +(define_insn "*fop_<mode>_1_mixed" + [(set (match_operand:MODEF 0 "register_operand" "=f,f,x") + (match_operator:MODEF 3 "binary_fp_operator" + [(match_operand:MODEF 1 "nonimmediate_operand" "0,fm,0") + (match_operand:MODEF 2 "nonimmediate_operand" "fm,0,xm")]))] + "SSE_FLOAT_MODE_P (<MODE>mode) && TARGET_MIX_SSE_I387 && !COMMUTATIVE_ARITH_P (operands[3]) && !(MEM_P (operands[1]) && MEM_P (operands[2]))" "* return output_387_binary_op (insn, operands);" [(set (attr "type") (cond [(and (eq_attr "alternative" "2") - (match_operand:SF 3 "mult_operator" "")) + (match_operand:MODEF 3 "mult_operator" "")) (const_string "ssemul") (and (eq_attr "alternative" "2") - (match_operand:SF 3 "div_operator" "")) + (match_operand:MODEF 3 "div_operator" "")) (const_string "ssediv") (eq_attr "alternative" "2") (const_string "sseadd") - (match_operand:SF 3 "mult_operator" "") + (match_operand:MODEF 3 "mult_operator" "") (const_string "fmul") - (match_operand:SF 3 "div_operator" "") + (match_operand:MODEF 3 "div_operator" "") (const_string "fdiv") ] (const_string "fop"))) - (set_attr "mode" "SF")]) + (set_attr "mode" "<MODE>")]) (define_insn "*rcpsf2_sse" [(set (match_operand:SF 0 "register_operand" "=x") @@ -15882,219 +15885,75 @@ [(set_attr "type" "sse") (set_attr "mode" "SF")]) -(define_insn "*fop_sf_1_sse" - [(set (match_operand:SF 0 "register_operand" "=x") - (match_operator:SF 3 "binary_fp_operator" - [(match_operand:SF 1 "register_operand" "0") - (match_operand:SF 2 "nonimmediate_operand" "xm")]))] - "TARGET_SSE_MATH +(define_insn "*fop_<mode>_1_sse" + [(set (match_operand:MODEF 0 "register_operand" "=x") + (match_operator:MODEF 3 "binary_fp_operator" + [(match_operand:MODEF 1 "register_operand" "0") + (match_operand:MODEF 2 "nonimmediate_operand" "xm")]))] + "SSE_FLOAT_MODE_P (<MODE>mode) && TARGET_SSE_MATH && !COMMUTATIVE_ARITH_P (operands[3])" "* return output_387_binary_op (insn, operands);" [(set (attr "type") - (cond [(match_operand:SF 3 "mult_operator" "") + (cond [(match_operand:MODEF 3 "mult_operator" "") (const_string "ssemul") - (match_operand:SF 3 "div_operator" "") + (match_operand:MODEF 3 "div_operator" "") (const_string "ssediv") ] (const_string "sseadd"))) - (set_attr "mode" "SF")]) + (set_attr "mode" "<MODE>")]) ;; This pattern is not fully shadowed by the pattern above. -(define_insn "*fop_sf_1_i387" - [(set (match_operand:SF 0 "register_operand" "=f,f") - (match_operator:SF 3 "binary_fp_operator" - [(match_operand:SF 1 "nonimmediate_operand" "0,fm") - (match_operand:SF 2 "nonimmediate_operand" "fm,0")]))] +(define_insn "*fop_<mode>_1_i387" + [(set (match_operand:MODEF 0 "register_operand" "=f,f") + (match_operator:MODEF 3 "binary_fp_operator" + [(match_operand:MODEF 1 "nonimmediate_operand" "0,fm") + (match_operand:MODEF 2 "nonimmediate_operand" "fm,0")]))] "TARGET_80387 && !TARGET_SSE_MATH && !COMMUTATIVE_ARITH_P (operands[3]) && !(MEM_P (operands[1]) && MEM_P (operands[2]))" "* return output_387_binary_op (insn, operands);" [(set (attr "type") - (cond [(match_operand:SF 3 "mult_operator" "") + (cond [(match_operand:MODEF 3 "mult_operator" "") (const_string "fmul") - (match_operand:SF 3 "div_operator" "") + (match_operand:MODEF 3 "div_operator" "") (const_string "fdiv") ] (const_string "fop"))) - (set_attr "mode" "SF")]) - -;; ??? Add SSE splitters for these! -(define_insn "*fop_sf_2<mode>_i387" - [(set (match_operand:SF 0 "register_operand" "=f,f") - (match_operator:SF 3 "binary_fp_operator" - [(float:SF (match_operand:X87MODEI12 1 "nonimmediate_operand" "m,?r")) - (match_operand:SF 2 "register_operand" "0,0")]))] - "TARGET_80387 && TARGET_USE_<MODE>MODE_FIOP && !TARGET_SSE_MATH" - "* return which_alternative ? \"#\" : output_387_binary_op (insn, operands);" - [(set (attr "type") - (cond [(match_operand:SF 3 "mult_operator" "") - (const_string "fmul") - (match_operand:SF 3 "div_operator" "") - (const_string "fdiv") - ] - (const_string "fop"))) - (set_attr "fp_int_src" "true") (set_attr "mode" "<MODE>")]) -(define_insn "*fop_sf_3<mode>_i387" - [(set (match_operand:SF 0 "register_operand" "=f,f") - (match_operator:SF 3 "binary_fp_operator" - [(match_operand:SF 1 "register_operand" "0,0") - (float:SF (match_operand:X87MODEI12 2 "nonimmediate_operand" "m,?r"))]))] - "TARGET_80387 && TARGET_USE_<MODE>MODE_FIOP && !TARGET_SSE_MATH" - "* return which_alternative ? \"#\" : output_387_binary_op (insn, operands);" - [(set (attr "type") - (cond [(match_operand:SF 3 "mult_operator" "") - (const_string "fmul") - (match_operand:SF 3 "div_operator" "") - (const_string "fdiv") - ] - (const_string "fop"))) - (set_attr "fp_int_src" "true") - (set_attr "mode" "<MODE>")]) - -(define_insn "*fop_df_comm_mixed" - [(set (match_operand:DF 0 "register_operand" "=f,x") - (match_operator:DF 3 "binary_fp_operator" - [(match_operand:DF 1 "nonimmediate_operand" "%0,0") - (match_operand:DF 2 "nonimmediate_operand" "fm,xm")]))] - "TARGET_SSE2 && TARGET_MIX_SSE_I387 - && COMMUTATIVE_ARITH_P (operands[3]) - && !(MEM_P (operands[1]) && MEM_P (operands[2]))" - "* return output_387_binary_op (insn, operands);" - [(set (attr "type") - (if_then_else (eq_attr "alternative" "1") - (if_then_else (match_operand:DF 3 "mult_operator" "") - (const_string "ssemul") - (const_string "sseadd")) - (if_then_else (match_operand:DF 3 "mult_operator" "") - (const_string "fmul") - (const_string "fop")))) - (set_attr "mode" "DF")]) - -(define_insn "*fop_df_comm_sse" - [(set (match_operand:DF 0 "register_operand" "=x") - (match_operator:DF 3 "binary_fp_operator" - [(match_operand:DF 1 "nonimmediate_operand" "%0") - (match_operand:DF 2 "nonimmediate_operand" "xm")]))] - "TARGET_SSE2 && TARGET_SSE_MATH - && COMMUTATIVE_ARITH_P (operands[3]) - && !(MEM_P (operands[1]) && MEM_P (operands[2]))" - "* return output_387_binary_op (insn, operands);" - [(set (attr "type") - (if_then_else (match_operand:DF 3 "mult_operator" "") - (const_string "ssemul") - (const_string "sseadd"))) - (set_attr "mode" "DF")]) - -(define_insn "*fop_df_comm_i387" - [(set (match_operand:DF 0 "register_operand" "=f") - (match_operator:DF 3 "binary_fp_operator" - [(match_operand:DF 1 "nonimmediate_operand" "%0") - (match_operand:DF 2 "nonimmediate_operand" "fm")]))] - "TARGET_80387 - && COMMUTATIVE_ARITH_P (operands[3]) - && !(MEM_P (operands[1]) && MEM_P (operands[2]))" - "* return output_387_binary_op (insn, operands);" - [(set (attr "type") - (if_then_else (match_operand:DF 3 "mult_operator" "") - (const_string "fmul") - (const_string "fop"))) - (set_attr "mode" "DF")]) - -(define_insn "*fop_df_1_mixed" - [(set (match_operand:DF 0 "register_operand" "=f,f,x") - (match_operator:DF 3 "binary_fp_operator" - [(match_operand:DF 1 "nonimmediate_operand" "0,fm,0") - (match_operand:DF 2 "nonimmediate_operand" "fm,0,xm")]))] - "TARGET_SSE2 && TARGET_SSE_MATH && TARGET_MIX_SSE_I387 - && !COMMUTATIVE_ARITH_P (operands[3]) - && !(MEM_P (operands[1]) && MEM_P (operands[2]))" - "* return output_387_binary_op (insn, operands);" - [(set (attr "type") - (cond [(and (eq_attr "alternative" "2") - (match_operand:DF 3 "mult_operator" "")) - (const_string "ssemul") - (and (eq_attr "alternative" "2") - (match_operand:DF 3 "div_operator" "")) - (const_string "ssediv") - (eq_attr "alternative" "2") - (const_string "sseadd") - (match_operand:DF 3 "mult_operator" "") - (const_string "fmul") - (match_operand:DF 3 "div_operator" "") - (const_string "fdiv") - ] - (const_string "fop"))) - (set_attr "mode" "DF")]) - -(define_insn "*fop_df_1_sse" - [(set (match_operand:DF 0 "register_operand" "=x") - (match_operator:DF 3 "binary_fp_operator" - [(match_operand:DF 1 "register_operand" "0") - (match_operand:DF 2 "nonimmediate_operand" "xm")]))] - "TARGET_SSE2 && TARGET_SSE_MATH - && !COMMUTATIVE_ARITH_P (operands[3])" - "* return output_387_binary_op (insn, operands);" - [(set_attr "mode" "DF") - (set (attr "type") - (cond [(match_operand:DF 3 "mult_operator" "") - (const_string "ssemul") - (match_operand:DF 3 "div_operator" "") - (const_string "ssediv") - ] - (const_string "sseadd")))]) - -;; This pattern is not fully shadowed by the pattern above. -(define_insn "*fop_df_1_i387" - [(set (match_operand:DF 0 "register_operand" "=f,f") - (match_operator:DF 3 "binary_fp_operator" - [(match_operand:DF 1 "nonimmediate_operand" "0,fm") - (match_operand:DF 2 "nonimmediate_operand" "fm,0")]))] - "TARGET_80387 && !(TARGET_SSE2 && TARGET_SSE_MATH) - && !COMMUTATIVE_ARITH_P (operands[3]) - && !(MEM_P (operands[1]) && MEM_P (operands[2]))" - "* return output_387_binary_op (insn, operands);" - [(set (attr "type") - (cond [(match_operand:DF 3 "mult_operator" "") - (const_string "fmul") - (match_operand:DF 3 "div_operator" "") - (const_string "fdiv") - ] - (const_string "fop"))) - (set_attr "mode" "DF")]) - ;; ??? Add SSE splitters for these! -(define_insn "*fop_df_2<mode>_i387" - [(set (match_operand:DF 0 "register_operand" "=f,f") - (match_operator:DF 3 "binary_fp_operator" - [(float:DF (match_operand:X87MODEI12 1 "nonimmediate_operand" "m,?r")) - (match_operand:DF 2 "register_operand" "0,0")]))] - "TARGET_80387 && TARGET_USE_<MODE>MODE_FIOP - && !(TARGET_SSE2 && TARGET_SSE_MATH)" +(define_insn "*fop_<MODEF:mode>_2_i387" + [(set (match_operand:MODEF 0 "register_operand" "=f,f") + (match_operator:MODEF 3 "binary_fp_operator" + [(float:MODEF + (match_operand:X87MODEI12 1 "nonimmediate_operand" "m,?r")) + (match_operand:MODEF 2 "register_operand" "0,0")]))] + "TARGET_80387 && !TARGET_SSE_MATH + && (TARGET_USE_<X87MODEI12:MODE>MODE_FIOP || optimize_size)" "* return which_alternative ? \"#\" : output_387_binary_op (insn, operands);" [(set (attr "type") - (cond [(match_operand:DF 3 "mult_operator" "") + (cond [(match_operand:MODEF 3 "mult_operator" "") (const_string "fmul") - (match_operand:DF 3 "div_operator" "") + (match_operand:MODEF 3 "div_operator" "") (const_string "fdiv") ] (const_string "fop"))) (set_attr "fp_int_src" "true") - (set_attr "mode" "<MODE>")]) - -(define_insn "*fop_df_3<mode>_i387" - [(set (match_operand:DF 0 "register_operand" "=f,f") - (match_operator:DF 3 "binary_fp_operator" - [(match_operand:DF 1 "register_operand" "0,0") - (float:DF (match_operand:X87MODEI12 2 "nonimmediate_operand" "m,?r"))]))] - "TARGET_80387 && TARGET_USE_<MODE>MODE_FIOP - && !(TARGET_SSE2 && TARGET_SSE_MATH)" + (set_attr "mode" "<X87MODEI12:MODE>")]) + +(define_insn "*fop_<MODEF:mode>_3_i387" + [(set (match_operand:MODEF 0 "register_operand" "=f,f") + (match_operator:MODEF 3 "binary_fp_operator" + [(match_operand:MODEF 1 "register_operand" "0,0") + (float:MODEF + (match_operand:X87MODEI12 2 "nonimmediate_operand" "m,?r"))]))] + "TARGET_80387 && !TARGET_SSE_MATH + && (TARGET_USE_<X87MODEI12:MODE>MODE_FIOP || optimize_size)" "* return which_alternative ? \"#\" : output_387_binary_op (insn, operands);" [(set (attr "type") - (cond [(match_operand:DF 3 "mult_operator" "") + (cond [(match_operand:MODEF 3 "mult_operator" "") (const_string "fmul") - (match_operand:DF 3 "div_operator" "") + (match_operand:MODEF 3 "div_operator" "") (const_string "fdiv") ] (const_string "fop"))) @@ -16104,7 +15963,8 @@ (define_insn "*fop_df_4_i387" [(set (match_operand:DF 0 "register_operand" "=f,f") (match_operator:DF 3 "binary_fp_operator" - [(float_extend:DF (match_operand:SF 1 "nonimmediate_operand" "fm,0")) + [(float_extend:DF + (match_operand:SF 1 "nonimmediate_operand" "fm,0")) (match_operand:DF 2 "register_operand" "0,f")]))] "TARGET_80387 && !(TARGET_SSE2 && TARGET_SSE_MATH) && !(MEM_P (operands[1]) && MEM_P (operands[2]))" @@ -16184,12 +16044,13 @@ (const_string "fop"))) (set_attr "mode" "XF")]) -(define_insn "*fop_xf_2<mode>_i387" +(define_insn "*fop_xf_2_i387" [(set (match_operand:XF 0 "register_operand" "=f,f") (match_operator:XF 3 "binary_fp_operator" - [(float:XF (match_operand:X87MODEI12 1 "nonimmediate_operand" "m,?r")) - (match_operand:XF 2 "register_operand" "0,0")]))] - "TARGET_80387 && TARGET_USE_<MODE>MODE_FIOP" + [(float:XF + (match_operand:X87MODEI12 1 "nonimmediate_operand" "m,?r")) + (match_operand:XF 2 "register_operand" "0,0")]))] + "TARGET_80387 && (TARGET_USE_<MODE>MODE_FIOP || optimize_size)" "* return which_alternative ? \"#\" : output_387_binary_op (insn, operands);" [(set (attr "type") (cond [(match_operand:XF 3 "mult_operator" "") @@ -16201,12 +16062,13 @@ (set_attr "fp_int_src" "true") (set_attr "mode" "<MODE>")]) -(define_insn "*fop_xf_3<mode>_i387" +(define_insn "*fop_xf_3_i387" [(set (match_operand:XF 0 "register_operand" "=f,f") (match_operator:XF 3 "binary_fp_operator" [(match_operand:XF 1 "register_operand" "0,0") - (float:XF (match_operand:X87MODEI12 2 "nonimmediate_operand" "m,?r"))]))] - "TARGET_80387 && TARGET_USE_<MODE>MODE_FIOP" + (float:XF + (match_operand:X87MODEI12 2 "nonimmediate_operand" "m,?r"))]))] + "TARGET_80387 && (TARGET_USE_<MODE>MODE_FIOP || optimize_size)" "* return which_alternative ? \"#\" : output_387_binary_op (insn, operands);" [(set (attr "type") (cond [(match_operand:XF 3 "mult_operator" "") @@ -16233,7 +16095,7 @@ (const_string "fdiv") ] (const_string "fop"))) - (set_attr "mode" "SF")]) + (set_attr "mode" "<MODE>")]) (define_insn "*fop_xf_5_i387" [(set (match_operand:XF 0 "register_operand" "=f,f") @@ -16250,7 +16112,7 @@ (const_string "fdiv") ] (const_string "fop"))) - (set_attr "mode" "SF")]) + (set_attr "mode" "<MODE>")]) (define_insn "*fop_xf_6_i387" [(set (match_operand:XF 0 "register_operand" "=f,f") @@ -16268,7 +16130,7 @@ (const_string "fdiv") ] (const_string "fop"))) - (set_attr "mode" "SF")]) + (set_attr "mode" "<MODE>")]) (define_split [(set (match_operand 0 "register_operand" "") @@ -20987,14 +20849,14 @@ (use (match_operand:DI 2 "const_int_operand" "i")) (use (label_ref:DI (match_operand 3 "" "X")))] "TARGET_64BIT - && INTVAL (operands[4]) + SSE_REGPARM_MAX * 16 - 16 < 128 + && INTVAL (operands[4]) + X86_64_SSE_REGPARM_MAX * 16 - 16 < 128 && INTVAL (operands[4]) + INTVAL (operands[2]) * 16 >= -128" { int i; operands[0] = gen_rtx_MEM (Pmode, gen_rtx_PLUS (Pmode, operands[0], operands[4])); output_asm_insn ("jmp\t%A1", operands); - for (i = SSE_REGPARM_MAX - 1; i >= INTVAL (operands[2]); i--) + for (i = X86_64_SSE_REGPARM_MAX - 1; i >= INTVAL (operands[2]); i--) { operands[4] = adjust_address (operands[0], DImode, i*16); operands[5] = gen_rtx_REG (TImode, SSE_REGNO (i)); diff --git a/gcc/config/i386/mingw32.h b/gcc/config/i386/mingw32.h index 3a3b74cf8be..7628896bc6a 100644 --- a/gcc/config/i386/mingw32.h +++ b/gcc/config/i386/mingw32.h @@ -38,7 +38,7 @@ along with GCC; see the file COPYING3. If not see builtin_define_std ("WINNT"); \ builtin_define_with_int_value ("_INTEGRAL_MAX_BITS", \ TYPE_PRECISION (intmax_type_node));\ - if (TARGET_64BIT_MS_ABI) \ + if (TARGET_64BIT && DEFAULT_ABI == MS_ABI) \ { \ builtin_define ("__MINGW64__"); \ builtin_define_std ("WIN64"); \ diff --git a/gcc/config/ia64/ia64.md b/gcc/config/ia64/ia64.md index 7135bf4da58..cf746f52b68 100644 --- a/gcc/config/ia64/ia64.md +++ b/gcc/config/ia64/ia64.md @@ -6332,8 +6332,8 @@ emit_move_insn (sp, operands[2]); operands[2] = sp; } - emit_insn (gen_rtx_USE (VOIDmode, sp)); - emit_insn (gen_rtx_USE (VOIDmode, bsp)); + emit_use (sp); + emit_use (bsp); cfun->machine->ia64_eh_epilogue_sp = sp; cfun->machine->ia64_eh_epilogue_bsp = bsp; diff --git a/gcc/config/iq2000/iq2000.c b/gcc/config/iq2000/iq2000.c index 7ee5eda9407..2d20a4ba4c2 100644 --- a/gcc/config/iq2000/iq2000.c +++ b/gcc/config/iq2000/iq2000.c @@ -2085,8 +2085,7 @@ iq2000_expand_epilogue (void) /* Perform the additional bump for __throw. */ emit_move_insn (gen_rtx_REG (Pmode, HARD_FRAME_POINTER_REGNUM), stack_pointer_rtx); - emit_insn (gen_rtx_USE (VOIDmode, gen_rtx_REG (Pmode, - HARD_FRAME_POINTER_REGNUM))); + emit_use (gen_rtx_REG (Pmode, HARD_FRAME_POINTER_REGNUM)); emit_jump_insn (gen_eh_return_internal ()); } else diff --git a/gcc/config/m32c/m32c.c b/gcc/config/m32c/m32c.c index 697e42a7948..b0733dd8364 100644 --- a/gcc/config/m32c/m32c.c +++ b/gcc/config/m32c/m32c.c @@ -4079,7 +4079,7 @@ m32c_emit_eh_epilogue (rtx ret_addr) (fudged), and return (fudged). This is actually easier to do in assembler, so punt to libgcc. */ emit_jump_insn (gen_eh_epilogue (ret_addr, cfun->machine->eh_stack_adjust)); - /* emit_insn (gen_rtx_CLOBBER (HImode, gen_rtx_REG (HImode, R0L_REGNO))); */ + /* emit_clobber (gen_rtx_REG (HImode, R0L_REGNO)); */ emit_barrier (); } diff --git a/gcc/config/m32r/m32r.c b/gcc/config/m32r/m32r.c index 64b7e5f63ab..23e7851b160 100644 --- a/gcc/config/m32r/m32r.c +++ b/gcc/config/m32r/m32r.c @@ -1349,7 +1349,7 @@ m32r_reload_lr (rtx sp, int size) emit_insn (gen_movsi (lr, gen_frame_mem (Pmode, tmp))); } - emit_insn (gen_rtx_USE (VOIDmode, lr)); + emit_use (lr); } void @@ -1361,7 +1361,7 @@ m32r_load_pic_register (void) /* Need to emit this whether or not we obey regdecls, since setjmp/longjmp can cause life info to screw up. */ - emit_insn (gen_rtx_USE (VOIDmode, pic_offset_table_rtx)); + emit_use (pic_offset_table_rtx); } /* Expand the m32r prologue as a series of insns. */ diff --git a/gcc/config/mips/mips-protos.h b/gcc/config/mips/mips-protos.h index db65aab93c9..1bf0ee9865d 100644 --- a/gcc/config/mips/mips-protos.h +++ b/gcc/config/mips/mips-protos.h @@ -257,6 +257,7 @@ extern HOST_WIDE_INT mips_initial_elimination_offset (int, int); extern rtx mips_return_addr (int, rtx); extern enum mips_loadgp_style mips_current_loadgp_style (void); extern void mips_expand_prologue (void); +extern void mips_expand_before_return (void); extern void mips_expand_epilogue (bool); extern bool mips_can_use_return_insn (void); extern rtx mips_function_value (const_tree, enum machine_mode); diff --git a/gcc/config/mips/mips.c b/gcc/config/mips/mips.c index 6cb0d293dda..41fc6d03009 100644 --- a/gcc/config/mips/mips.c +++ b/gcc/config/mips/mips.c @@ -584,6 +584,9 @@ static const struct mips_cpu_info mips_cpu_info_table[] = { { "r4600", PROCESSOR_R4600, 3, 0 }, { "orion", PROCESSOR_R4600, 3, 0 }, { "r4650", PROCESSOR_R4650, 3, 0 }, + /* ST Loongson 2E/2F processors. */ + { "loongson2e", PROCESSOR_LOONGSON_2E, 3, PTF_AVOID_BRANCHLIKELY }, + { "loongson2f", PROCESSOR_LOONGSON_2F, 3, PTF_AVOID_BRANCHLIKELY }, /* MIPS IV processors. */ { "r8000", PROCESSOR_R8000, 4, 0 }, @@ -832,6 +835,12 @@ static const struct mips_rtx_cost_data mips_rtx_cost_data[PROCESSOR_MAX] = { 1, /* branch_cost */ 4 /* memory_latency */ }, + { /* Loongson-2E */ + DEFAULT_COSTS + }, + { /* Loongson-2F */ + DEFAULT_COSTS + }, { /* M4k */ DEFAULT_COSTS }, @@ -1800,6 +1809,51 @@ mips_valid_base_register_p (rtx x, enum machine_mode mode, bool strict_p) && mips_regno_mode_ok_for_base_p (REGNO (x), mode, strict_p)); } +/* Return true if, for every base register BASE_REG, (plus BASE_REG X) + can address a value of mode MODE. */ + +static bool +mips_valid_offset_p (rtx x, enum machine_mode mode) +{ + /* Check that X is a signed 16-bit number. */ + if (!const_arith_operand (x, Pmode)) + return false; + + /* We may need to split multiword moves, so make sure that every word + is accessible. */ + if (GET_MODE_SIZE (mode) > UNITS_PER_WORD + && !SMALL_OPERAND (INTVAL (x) + GET_MODE_SIZE (mode) - UNITS_PER_WORD)) + return false; + + return true; +} + +/* Return true if a LO_SUM can address a value of mode MODE when the + LO_SUM symbol has type SYMBOL_TYPE. */ + +static bool +mips_valid_lo_sum_p (enum mips_symbol_type symbol_type, enum machine_mode mode) +{ + /* Check that symbols of type SYMBOL_TYPE can be used to access values + of mode MODE. */ + if (mips_symbol_insns (symbol_type, mode) == 0) + return false; + + /* Check that there is a known low-part relocation. */ + if (mips_lo_relocs[symbol_type] == NULL) + return false; + + /* We may need to split multiword moves, so make sure that each word + can be accessed without inducing a carry. This is mainly needed + for o64, which has historically only guaranteed 64-bit alignment + for 128-bit types. */ + if (GET_MODE_SIZE (mode) > UNITS_PER_WORD + && GET_MODE_BITSIZE (mode) > GET_MODE_ALIGNMENT (mode)) + return false; + + return true; +} + /* Return true if X is a valid address for machine mode MODE. If it is, fill in INFO appropriately. STRICT_P is true if REG_OK_STRICT is in effect. */ @@ -1822,7 +1876,7 @@ mips_classify_address (struct mips_address_info *info, rtx x, info->reg = XEXP (x, 0); info->offset = XEXP (x, 1); return (mips_valid_base_register_p (info->reg, mode, strict_p) - && const_arith_operand (info->offset, VOIDmode)); + && mips_valid_offset_p (info->offset, mode)); case LO_SUM: info->type = ADDRESS_LO_SUM; @@ -1840,8 +1894,7 @@ mips_classify_address (struct mips_address_info *info, rtx x, info->symbol_type = mips_classify_symbolic_expression (info->offset, SYMBOL_CONTEXT_MEM); return (mips_valid_base_register_p (info->reg, mode, strict_p) - && mips_symbol_insns (info->symbol_type, mode) > 0 - && mips_lo_relocs[info->symbol_type] != 0); + && mips_valid_lo_sum_p (info->symbol_type, mode)); case CONST_INT: /* Small-integer addresses don't occur very often, but they @@ -2464,6 +2517,16 @@ mips_legitimize_tls_address (rtx loc) return dest; } +/* If X is not a valid address for mode MODE, force it into a register. */ + +static rtx +mips_force_address (rtx x, enum machine_mode mode) +{ + if (!mips_legitimate_address_p (mode, x, false)) + x = force_reg (Pmode, x); + return x; +} + /* This function is used to implement LEGITIMIZE_ADDRESS. If *XLOC can be legitimized in a way that the generic machinery might not expect, put the new address in *XLOC and return true. MODE is the mode of @@ -2472,7 +2535,7 @@ mips_legitimize_tls_address (rtx loc) bool mips_legitimize_address (rtx *xloc, enum machine_mode mode) { - rtx base; + rtx base, addr; HOST_WIDE_INT offset; if (mips_tls_symbol_p (*xloc)) @@ -2482,8 +2545,11 @@ mips_legitimize_address (rtx *xloc, enum machine_mode mode) } /* See if the address can split into a high part and a LO_SUM. */ - if (mips_split_symbol (NULL, *xloc, mode, xloc)) - return true; + if (mips_split_symbol (NULL, *xloc, mode, &addr)) + { + *xloc = mips_force_address (addr, mode); + return true; + } /* Handle BASE + OFFSET using mips_add_offset. */ mips_split_plus (*xloc, &base, &offset); @@ -2491,7 +2557,8 @@ mips_legitimize_address (rtx *xloc, enum machine_mode mode) { if (!mips_valid_base_register_p (base, mode, false)) base = copy_to_mode_reg (Pmode, base); - *xloc = mips_add_offset (NULL, base, offset); + addr = mips_add_offset (NULL, base, offset); + *xloc = mips_force_address (addr, mode); return true; } return false; @@ -8449,8 +8516,6 @@ mips_emit_loadgp (void) emit_insn (Pmode == SImode ? gen_loadgp_newabi_si (pic_reg, offset, incoming_address) : gen_loadgp_newabi_di (pic_reg, offset, incoming_address)); - if (!TARGET_EXPLICIT_RELOCS) - emit_insn (gen_loadgp_blockage ()); break; case LOADGP_RTP: @@ -8459,13 +8524,16 @@ mips_emit_loadgp (void) emit_insn (Pmode == SImode ? gen_loadgp_rtp_si (pic_reg, base, index) : gen_loadgp_rtp_di (pic_reg, base, index)); - if (!TARGET_EXPLICIT_RELOCS) - emit_insn (gen_loadgp_blockage ()); break; default: - break; + return; } + /* Emit a blockage if there are implicit uses of the GP register. + This includes profiled functions, because FUNCTION_PROFILE uses + a jal macro. */ + if (!TARGET_EXPLICIT_RELOCS || crtl->profile) + emit_insn (gen_loadgp_blockage ()); } /* Expand the "prologue" pattern. */ @@ -8624,6 +8692,24 @@ mips_restore_reg (rtx reg, rtx mem) mips_emit_move (reg, mem); } +/* Emit any instructions needed before a return. */ + +void +mips_expand_before_return (void) +{ + /* When using a call-clobbered gp, we start out with unified call + insns that include instructions to restore the gp. We then split + these unified calls after reload. These split calls explicitly + clobber gp, so there is no need to define + PIC_OFFSET_TABLE_REG_CALL_CLOBBERED. + + For consistency, we should also insert an explicit clobber of $28 + before return insns, so that the post-reload optimizers know that + the register is not live on exit. */ + if (TARGET_CALL_CLOBBERED_GP) + emit_clobber (pic_offset_table_rtx); +} + /* Expand an "epilogue" or "sibcall_epilogue" pattern; SIBCALL_P says which. */ @@ -8766,6 +8852,7 @@ mips_expand_epilogue (bool sibcall_p) regno = GP_REG_FIRST + 7; else regno = GP_REG_FIRST + 31; + mips_expand_before_return (); emit_jump_insn (gen_return_internal (gen_rtx_REG (Pmode, regno))); } } diff --git a/gcc/config/mips/mips.h b/gcc/config/mips/mips.h index 6d3c18feb46..402cd579c5c 100644 --- a/gcc/config/mips/mips.h +++ b/gcc/config/mips/mips.h @@ -47,6 +47,8 @@ enum processor_type { PROCESSOR_74KF2_1, PROCESSOR_74KF1_1, PROCESSOR_74KF3_2, + PROCESSOR_LOONGSON_2E, + PROCESSOR_LOONGSON_2F, PROCESSOR_M4K, PROCESSOR_R3900, PROCESSOR_R6000, @@ -237,6 +239,9 @@ enum mips_code_readable_setting { #define TARGET_SB1 (mips_arch == PROCESSOR_SB1 \ || mips_arch == PROCESSOR_SB1A) #define TARGET_SR71K (mips_arch == PROCESSOR_SR71000) +#define TARGET_LOONGSON_2E (mips_arch == PROCESSOR_LOONGSON_2E) +#define TARGET_LOONGSON_2F (mips_arch == PROCESSOR_LOONGSON_2F) +#define TARGET_LOONGSON_2EF (TARGET_LOONGSON_2E || TARGET_LOONGSON_2F) /* Scheduling target defines. */ #define TUNE_MIPS3000 (mips_tune == PROCESSOR_R3000) @@ -646,7 +651,7 @@ enum mips_code_readable_setting { "%{" MIPS_ISA_LEVEL_OPTION_SPEC ":;: \ %{march=mips1|march=r2000|march=r3000|march=r3900:-mips1} \ %{march=mips2|march=r6000:-mips2} \ - %{march=mips3|march=r4*|march=vr4*|march=orion:-mips3} \ + %{march=mips3|march=r4*|march=vr4*|march=orion|march=loongson2*:-mips3} \ %{march=mips4|march=r8000|march=vr5*|march=rm7000|march=rm9000:-mips4} \ %{march=mips32|march=4kc|march=4km|march=4kp|march=4ksc:-mips32} \ %{march=mips32r2|march=m4k|march=4ke*|march=4ksd|march=24k* \ diff --git a/gcc/config/mips/mips.md b/gcc/config/mips/mips.md index 2b789eef8b6..29b8e703890 100644 --- a/gcc/config/mips/mips.md +++ b/gcc/config/mips/mips.md @@ -415,7 +415,7 @@ ;; Attribute describing the processor. This attribute must match exactly ;; with the processor_type enumeration in mips.h. (define_attr "cpu" - "r3000,4kc,4kp,5kc,5kf,20kc,24kc,24kf2_1,24kf1_1,74kc,74kf2_1,74kf1_1,74kf3_2,m4k,r3900,r6000,r4000,r4100,r4111,r4120,r4130,r4300,r4600,r4650,r5000,r5400,r5500,r7000,r8000,r9000,sb1,sb1a,sr71000" + "r3000,4kc,4kp,5kc,5kf,20kc,24kc,24kf2_1,24kf1_1,74kc,74kf2_1,74kf1_1,74kf3_2,loongson2e,loongson2f,m4k,r3900,r6000,r4000,r4100,r4111,r4120,r4130,r4300,r4600,r4650,r5000,r5400,r5500,r7000,r8000,r9000,sb1,sb1a,sr71000" (const (symbol_ref "mips_tune"))) ;; The type of hardware hazard associated with this instruction. @@ -496,6 +496,9 @@ (define_mode_iterator MOVE64 [DI DF (V2SF "TARGET_HARD_FLOAT && TARGET_PAIRED_SINGLE_FLOAT")]) +;; 128-bit modes for which we provide move patterns on 64-bit targets. +(define_mode_iterator MOVE128 [TF]) + ;; This mode iterator allows the QI and HI extension patterns to be ;; defined from the same template. (define_mode_iterator SHORT [QI HI]) @@ -2912,7 +2915,7 @@ /* Allow REG_NOTES to be set on last insn (labels don't have enough fields, and can't be used for REG_NOTES anyway). */ - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); + emit_use (stack_pointer_rtx); DONE; } }) @@ -2955,7 +2958,7 @@ /* Allow REG_NOTES to be set on last insn (labels don't have enough fields, and can't be used for REG_NOTES anyway). */ - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); + emit_use (stack_pointer_rtx); DONE; }) @@ -2997,7 +3000,7 @@ /* Allow REG_NOTES to be set on last insn (labels don't have enough fields, and can't be used for REG_NOTES anyway). */ - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); + emit_use (stack_pointer_rtx); DONE; }) @@ -3039,7 +3042,7 @@ /* Allow REG_NOTES to be set on last insn (labels don't have enough fields, and can't be used for REG_NOTES anyway). */ - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); + emit_use (stack_pointer_rtx); DONE; }) @@ -4064,28 +4067,36 @@ ;; 128-bit floating point moves (define_expand "movtf" - [(set (match_operand:TF 0 "") - (match_operand:TF 1 ""))] - "" + [(set (match_operand:TF 0) + (match_operand:TF 1))] + "TARGET_64BIT" { if (mips_legitimize_move (TFmode, operands[0], operands[1])) DONE; }) ;; This pattern handles both hard- and soft-float cases. -(define_insn_and_split "*movtf_internal" - [(set (match_operand:TF 0 "nonimmediate_operand" "=d,R,f,dR") - (match_operand:TF 1 "move_operand" "dGR,dG,dGR,f"))] - "" +(define_insn "*movtf" + [(set (match_operand:TF 0 "nonimmediate_operand" "=d,d,m,f,d,f,m") + (match_operand:TF 1 "move_operand" "dG,m,dG,dG,f,m,f"))] + "TARGET_64BIT + && !TARGET_MIPS16 + && (register_operand (operands[0], TFmode) + || reg_or_0_operand (operands[1], TFmode))" "#" - "&& reload_completed" - [(const_int 0)] -{ - mips_split_doubleword_move (operands[0], operands[1]); - DONE; -} - [(set_attr "type" "multi") - (set_attr "length" "16")]) + [(set_attr "type" "multi,load,store,multi,multi,fpload,fpstore") + (set_attr "length" "8,*,*,8,8,*,*")]) + +(define_insn "*movtf_mips16" + [(set (match_operand:TF 0 "nonimmediate_operand" "=d,y,d,d,m") + (match_operand:TF 1 "move_operand" "d,d,y,m,d"))] + "TARGET_64BIT + && TARGET_MIPS16 + && (register_operand (operands[0], TFmode) + || register_operand (operands[1], TFmode))" + "#" + [(set_attr "type" "multi,multi,multi,load,store") + (set_attr "length" "8,8,8,*,*")]) (define_split [(set (match_operand:MOVE64 0 "nonimmediate_operand") @@ -4098,6 +4109,16 @@ DONE; }) +(define_split + [(set (match_operand:MOVE128 0 "nonimmediate_operand") + (match_operand:MOVE128 1 "move_operand"))] + "TARGET_64BIT && reload_completed" + [(const_int 0)] +{ + mips_split_doubleword_move (operands[0], operands[1]); + DONE; +}) + ;; When generating mips16 code, split moves of negative constants into ;; a positive "li" followed by a negation. (define_split @@ -4329,12 +4350,11 @@ } [(set_attr "length" "8")]) -;; The use of gp is hidden when not using explicit relocations. ;; This blockage instruction prevents the gp load from being ;; scheduled after an implicit use of gp. It also prevents ;; the load from being deleted as dead. (define_insn "loadgp_blockage" - [(unspec_volatile [(reg:DI 28)] UNSPEC_BLOCKAGE)] + [(unspec_volatile [(reg:SI 28)] UNSPEC_BLOCKAGE)] "" "" [(set_attr "type" "ghost") @@ -5685,9 +5705,9 @@ mips_emit_move (pv, lab); emit_stack_restore (SAVE_NONLOCAL, stack, NULL_RTX); mips_emit_move (gp, gpv); - emit_insn (gen_rtx_USE (VOIDmode, hard_frame_pointer_rtx)); - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); - emit_insn (gen_rtx_USE (VOIDmode, gp)); + emit_use (hard_frame_pointer_rtx); + emit_use (stack_pointer_rtx); + emit_use (gp); emit_indirect_jump (pv); DONE; }) @@ -5739,7 +5759,12 @@ ;; Trivial return. Make it look like a normal return insn as that ;; allows jump optimizations to work better. -(define_insn "return" +(define_expand "return" + [(return)] + "mips_can_use_return_insn ()" + { mips_expand_before_return (); }) + +(define_insn "*return" [(return)] "mips_can_use_return_insn ()" "%*j\t$31%/" diff --git a/gcc/config/mn10300/mn10300.md b/gcc/config/mn10300/mn10300.md index 57c51625b22..73043e99b1a 100644 --- a/gcc/config/mn10300/mn10300.md +++ b/gcc/config/mn10300/mn10300.md @@ -1807,7 +1807,7 @@ shared library support for AM30 either, so we just assume the linker is going to adjust all @PLT relocs to the actual symbols. */ - emit_insn (gen_rtx_USE (VOIDmode, pic_offset_table_rtx)); + emit_use (pic_offset_table_rtx); XEXP (operands[0], 0) = gen_sym2PLT (XEXP (operands[0], 0)); } else @@ -1852,7 +1852,7 @@ shared library support for AM30 either, so we just assume the linker is going to adjust all @PLT relocs to the actual symbols. */ - emit_insn (gen_rtx_USE (VOIDmode, pic_offset_table_rtx)); + emit_use (pic_offset_table_rtx); XEXP (operands[1], 0) = gen_sym2PLT (XEXP (operands[1], 0)); } else diff --git a/gcc/config/pa/pa.md b/gcc/config/pa/pa.md index 5f1d73893fd..c3d686db5c4 100644 --- a/gcc/config/pa/pa.md +++ b/gcc/config/pa/pa.md @@ -7432,12 +7432,8 @@ lab = copy_to_reg (lab); - emit_insn (gen_rtx_CLOBBER (VOIDmode, - gen_rtx_MEM (BLKmode, - gen_rtx_SCRATCH (VOIDmode)))); - emit_insn (gen_rtx_CLOBBER (VOIDmode, - gen_rtx_MEM (BLKmode, - hard_frame_pointer_rtx))); + emit_clobber (gen_rtx_MEM (BLKmode, gen_rtx_SCRATCH (VOIDmode))); + emit_clobber (gen_rtx_MEM (BLKmode, hard_frame_pointer_rtx)); /* Restore the frame pointer. The virtual_stack_vars_rtx is saved instead of the hard_frame_pointer_rtx in the save area. As a @@ -7449,8 +7445,8 @@ emit_stack_restore (SAVE_NONLOCAL, stack, NULL_RTX); - emit_insn (gen_rtx_USE (VOIDmode, hard_frame_pointer_rtx)); - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); + emit_use (hard_frame_pointer_rtx); + emit_use (stack_pointer_rtx); /* Nonlocal goto jumps are only used between functions in the same translation unit. Thus, we can avoid the extra overhead of an @@ -8892,12 +8888,8 @@ add,l %2,%3,%3\;bv,n %%r0(%3)" (POINTER_SIZE * 2) / BITS_PER_UNIT)); rtx pv = gen_rtx_REG (Pmode, 1); - emit_insn (gen_rtx_CLOBBER (VOIDmode, - gen_rtx_MEM (BLKmode, - gen_rtx_SCRATCH (VOIDmode)))); - emit_insn (gen_rtx_CLOBBER (VOIDmode, - gen_rtx_MEM (BLKmode, - hard_frame_pointer_rtx))); + emit_clobber (gen_rtx_MEM (BLKmode, gen_rtx_SCRATCH (VOIDmode))); + emit_clobber (gen_rtx_MEM (BLKmode, hard_frame_pointer_rtx)); /* Restore the frame pointer. The virtual_stack_vars_rtx is saved instead of the hard_frame_pointer_rtx in the save area. We need @@ -8913,8 +8905,8 @@ add,l %2,%3,%3\;bv,n %%r0(%3)" /* This bit is the same as expand_builtin_longjmp. */ emit_stack_restore (SAVE_NONLOCAL, stack, NULL_RTX); - emit_insn (gen_rtx_USE (VOIDmode, hard_frame_pointer_rtx)); - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); + emit_use (hard_frame_pointer_rtx); + emit_use (stack_pointer_rtx); /* Load the label we are jumping through into r1 so that we know where to look for it when we get back to setjmp's function for @@ -9673,8 +9665,7 @@ add,l %2,%3,%3\;bv,n %%r0(%3)" "" "* { - extern int frame_pointer_needed; - + /* We need two different versions depending on whether or not we need a frame pointer. Also note that we return to the instruction immediately after the branch rather than two instructions after the @@ -9726,7 +9717,6 @@ add,l %2,%3,%3\;bv,n %%r0(%3)" "" "* { - extern int frame_pointer_needed; /* We need two different versions depending on whether or not we need a frame pointer. Also note that we return to the instruction diff --git a/gcc/config/pdp11/pdp11.md b/gcc/config/pdp11/pdp11.md index 385c11c5aa3..32b3e92e9c9 100644 --- a/gcc/config/pdp11/pdp11.md +++ b/gcc/config/pdp11/pdp11.md @@ -1593,7 +1593,7 @@ ; ; /* allow REG_NOTES to be set on last insn (labels don't have enough ; fields, and can't be used for REG_NOTES anyway). */ -; emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); +; emit_use (stack_pointer_rtx); ; DONE; ;}") diff --git a/gcc/config/rs6000/rs6000.c b/gcc/config/rs6000/rs6000.c index 1eafc999fde..19734767797 100644 --- a/gcc/config/rs6000/rs6000.c +++ b/gcc/config/rs6000/rs6000.c @@ -3746,6 +3746,7 @@ rs6000_legitimize_address (rtx x, rtx oldx ATTRIBUTE_UNUSED, return gen_rtx_LO_SUM (Pmode, reg, x); } else if (TARGET_TOC + && GET_CODE (x) == SYMBOL_REF && constant_pool_expr_p (x) && ASM_OUTPUT_SPECIAL_POOL_ENTRY_P (get_pool_constant (x), Pmode)) { @@ -3889,7 +3890,6 @@ rs6000_legitimize_tls_address (rtx addr, enum tls_model model) emit_insn (gen_addsi3 (tmp3, tmp1, tmp2)); last = emit_move_insn (got, tmp3); set_unique_reg_note (last, REG_EQUAL, gsym); - maybe_encapsulate_block (first, last, gsym); } } } @@ -4191,6 +4191,7 @@ rs6000_legitimize_reload_address (rtx x, enum machine_mode mode, } if (TARGET_TOC + && GET_CODE (x) == SYMBOL_REF && constant_pool_expr_p (x) && ASM_OUTPUT_SPECIAL_POOL_ENTRY_P (get_pool_constant (x), mode)) { @@ -4999,7 +5000,7 @@ rs6000_emit_move (rtx dest, rtx source, enum machine_mode mode) This should not be done for operands that contain LABEL_REFs. For now, we just handle the obvious case. */ if (GET_CODE (operands[1]) != LABEL_REF) - emit_insn (gen_rtx_USE (VOIDmode, operands[1])); + emit_use (operands[1]); #if TARGET_MACHO /* Darwin uses a special PIC legitimizer. */ @@ -5041,6 +5042,7 @@ rs6000_emit_move (rtx dest, rtx source, enum machine_mode mode) operands[1] = force_const_mem (mode, operands[1]); if (TARGET_TOC + && GET_CODE (XEXP (operands[1], 0)) == SYMBOL_REF && constant_pool_expr_p (XEXP (operands[1], 0)) && ASM_OUTPUT_SPECIAL_POOL_ENTRY_P ( get_pool_constant (XEXP (operands[1], 0)), @@ -12359,6 +12361,7 @@ print_operand_address (FILE *file, rtx x) minus = XEXP (contains_minus, 0); symref = XEXP (minus, 0); + gcc_assert (GET_CODE (XEXP (minus, 1)) == SYMBOL_REF); XEXP (contains_minus, 0) = symref; if (TARGET_ELF) { diff --git a/gcc/config/s390/constraints.md b/gcc/config/s390/constraints.md index 92fd3254ca5..ad953080ff1 100644 --- a/gcc/config/s390/constraints.md +++ b/gcc/config/s390/constraints.md @@ -1,5 +1,5 @@ ;; Constraints definitions belonging to the gcc backend for IBM S/390. -;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. ;; Written by Wolfgang Gellerich, using code and information found in ;; files s390.md, s390.h, and s390.c. ;; @@ -24,10 +24,14 @@ ;; Special constraints for s/390 machine description: ;; ;; a -- Any address register from 1 to 15. +;; b -- Memory operand whose address is a symbol reference or a symbol +;; reference + constant which can be proven to be naturally aligned. ;; c -- Condition code register 33. ;; d -- Any register from 0 to 15. ;; f -- Floating point registers. ;; t -- Access registers 36 and 37. +;; C -- A signed 8-bit constant (-128..127) +;; D -- An unsigned 16-bit constant (0..65535) ;; G -- Const double zero operand ;; I -- An 8-bit constant (0..255). ;; J -- A 12-bit constant (0..4095). @@ -102,6 +106,19 @@ ;; General constraints for constants. ;; +(define_constraint "C" + "@internal + An 8-bit signed immediate constant (-128..127)" + (and (match_code "const_int") + (match_test "ival >= -128 && ival <= 127"))) + + +(define_constraint "D" + "An unsigned 16-bit constant (0..65535)" + (and (match_code "const_int") + (match_test "ival >= 0 && ival <= 65535"))) + + (define_constraint "G" "@internal Const double zero operand" @@ -127,7 +144,6 @@ (match_test "ival >= -32768 && ival <= 32767"))) - (define_constraint "L" "Value appropriate as displacement. (0..4095) for short displacement @@ -355,7 +371,6 @@ (match_test "s390_mem_constraint (\"Q\", op)")) - (define_memory_constraint "R" "Memory reference with index register and short displacement" (match_test "s390_mem_constraint (\"R\", op)")) @@ -371,6 +386,27 @@ (match_test "s390_mem_constraint (\"T\", op)")) +(define_memory_constraint "b" + "Memory reference whose address is a naturally aligned symbol reference." + (match_test "MEM_P (op) + && s390_check_symref_alignment (XEXP (op, 0), + GET_MODE_SIZE (GET_MODE (op)))")) + +(define_memory_constraint "e" + "Matches all memory references available on the current architecture +level. This constraint will never be used and using it in an inline +assembly is *always* a bug since there is no instruction accepting all +those addresses. It just serves as a placeholder for a generic memory +constraint." + (match_test "legitimate_address_p (GET_MODE (op), op, 1)")) + +; This defines 'm' as normal memory constraint. This is only possible +; since the standard memory constraint is re-defined in s390.h using +; the TARGET_MEM_CONSTRAINT macro. +(define_memory_constraint "m" + "Matches the most general memory address for pre-z10 machines." + (match_test "s390_mem_constraint (\"R\", op) + || s390_mem_constraint (\"T\", op)")) (define_memory_constraint "AQ" "@internal @@ -425,7 +461,6 @@ (match_test "s390_mem_constraint (\"BT\", op)")) - (define_address_constraint "U" "Pointer with short displacement" (match_test "s390_mem_constraint (\"U\", op)")) diff --git a/gcc/config/s390/predicates.md b/gcc/config/s390/predicates.md index 50bf0c1eda9..ca5d17556a5 100644 --- a/gcc/config/s390/predicates.md +++ b/gcc/config/s390/predicates.md @@ -1,5 +1,5 @@ ;; Predicate definitions for S/390 and zSeries. -;; Copyright (C) 2005, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2005, 2007, 2008 Free Software Foundation, Inc. ;; Contributed by Hartmut Penner (hpenner@de.ibm.com) and ;; Ulrich Weigand (uweigand@de.ibm.com). ;; @@ -110,7 +110,7 @@ if (GET_CODE (op) == LABEL_REF) return true; if (GET_CODE (op) == SYMBOL_REF) - return ((SYMBOL_REF_FLAGS (op) & SYMBOL_FLAG_ALIGN1) == 0 + return (!SYMBOL_REF_ALIGN1_P (op) && SYMBOL_REF_TLS_MODEL (op) == 0 && (!flag_pic || SYMBOL_REF_LOCAL_P (op))); @@ -172,6 +172,18 @@ return (s390_branch_condition_mask (op) >= 0); }) +(define_predicate "s390_signed_integer_comparison" + (match_code "eq, ne, lt, gt, le, ge") +{ + return (s390_compare_and_branch_condition_mask (op) >= 0); +}) + +(define_predicate "s390_unsigned_integer_comparison" + (match_code "eq, ne, ltu, gtu, leu, geu") +{ + return (s390_compare_and_branch_condition_mask (op) >= 0); +}) + ;; Return nonzero if OP is a valid comparison operator ;; for an ALC condition. diff --git a/gcc/config/s390/s390-protos.h b/gcc/config/s390/s390-protos.h index 7e329f2a565..76f73f9dd2c 100644 --- a/gcc/config/s390/s390-protos.h +++ b/gcc/config/s390/s390-protos.h @@ -1,5 +1,7 @@ /* Definitions of target machine for GNU compiler, for IBM S/390. - Copyright (C) 2000, 2002, 2003, 2004, 2005, 2007 Free Software Foundation, Inc. + Copyright (C) 2000, 2002, 2003, 2004, 2005, 2007, 2008 Free + Software Foundation, Inc. + Contributed by Hartmut Penner (hpenner@de.ibm.com) This file is part of GCC. @@ -27,7 +29,7 @@ extern int s390_mem_constraint (const char *str, rtx op); extern int s390_O_constraint_str (const char c, HOST_WIDE_INT value); extern int s390_N_constraint_str (const char *str, HOST_WIDE_INT value); extern int s390_float_const_zero_p (rtx value); - +extern bool s390_check_symref_alignment (rtx addr, HOST_WIDE_INT alignment); /* Declare functions in s390.c. */ @@ -51,6 +53,7 @@ extern int s390_const_ok_for_constraint_p (HOST_WIDE_INT, int, const char *); extern int s390_const_double_ok_for_constraint_p (rtx, int, const char *); extern int s390_single_part (rtx, enum machine_mode, enum machine_mode, int); extern unsigned HOST_WIDE_INT s390_extract_part (rtx, enum machine_mode, int); +extern bool s390_contiguous_bitmask_p (unsigned HOST_WIDE_INT, int, int *, int *); extern bool s390_split_ok_p (rtx, rtx, enum machine_mode, int); extern bool s390_overlap_p (rtx, rtx, HOST_WIDE_INT); extern bool s390_offset_p (rtx, rtx, rtx); @@ -80,6 +83,8 @@ extern enum reg_class s390_secondary_input_reload_class (enum reg_class, extern enum reg_class s390_secondary_output_reload_class (enum reg_class, enum machine_mode, rtx); +extern void s390_reload_larl_operand (rtx , rtx , rtx); +extern void s390_reload_symref_address (rtx , rtx , rtx , bool); extern void s390_expand_plus_operand (rtx, rtx, rtx); extern void emit_symbolic_move (rtx *); extern void s390_load_address (rtx, rtx); @@ -113,6 +118,7 @@ extern void s390_emit_tpf_eh_return (rtx); extern bool s390_legitimate_address_without_index_p (rtx); extern bool s390_decompose_shift_count (rtx, rtx *, HOST_WIDE_INT *); extern int s390_branch_condition_mask (rtx); +extern int s390_compare_and_branch_condition_mask (rtx); #endif /* RTX_CODE */ diff --git a/gcc/config/s390/s390.c b/gcc/config/s390/s390.c index 95fee4d63c4..ff2edecb223 100644 --- a/gcc/config/s390/s390.c +++ b/gcc/config/s390/s390.c @@ -1,8 +1,9 @@ /* Subroutines used for code generation on IBM S/390 and zSeries Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, - 2007 Free Software Foundation, Inc. + 2007, 2008 Free Software Foundation, Inc. Contributed by Hartmut Penner (hpenner@de.ibm.com) and - Ulrich Weigand (uweigand@de.ibm.com). + Ulrich Weigand (uweigand@de.ibm.com) and + Andreas Krebbel (Andreas.Krebbel@de.ibm.com). This file is part of GCC. @@ -188,6 +189,38 @@ struct processor_costs z9_109_cost = COSTS_N_INSNS (24), /* DSGR */ }; +static const +struct processor_costs z10_cost = +{ + COSTS_N_INSNS (4), /* M */ + COSTS_N_INSNS (2), /* MGHI */ + COSTS_N_INSNS (2), /* MH */ + COSTS_N_INSNS (2), /* MHI */ + COSTS_N_INSNS (4), /* ML */ + COSTS_N_INSNS (4), /* MR */ + COSTS_N_INSNS (5), /* MS */ + COSTS_N_INSNS (6), /* MSG */ + COSTS_N_INSNS (4), /* MSGF */ + COSTS_N_INSNS (4), /* MSGFR */ + COSTS_N_INSNS (4), /* MSGR */ + COSTS_N_INSNS (4), /* MSR */ + COSTS_N_INSNS (1), /* multiplication in DFmode */ + COSTS_N_INSNS (28), /* MXBR */ + COSTS_N_INSNS (130), /* SQXBR */ + COSTS_N_INSNS (66), /* SQDBR */ + COSTS_N_INSNS (38), /* SQEBR */ + COSTS_N_INSNS (1), /* MADBR */ + COSTS_N_INSNS (1), /* MAEBR */ + COSTS_N_INSNS (60), /* DXBR */ + COSTS_N_INSNS (40), /* DDBR */ + COSTS_N_INSNS (26), /* DEBR */ + COSTS_N_INSNS (30), /* DLGR */ + COSTS_N_INSNS (23), /* DLR */ + COSTS_N_INSNS (23), /* DR */ + COSTS_N_INSNS (24), /* DSGFR */ + COSTS_N_INSNS (24), /* DSGR */ +}; + extern int reload_completed; /* Save information from a "cmpxx" operation until the branch or scc is @@ -1029,6 +1062,41 @@ s390_branch_condition_mask (rtx code) } } + +/* Return branch condition mask to implement a compare and branch + specified by CODE. Return -1 for invalid comparisons. */ + +int +s390_compare_and_branch_condition_mask (rtx code) +{ + const int CC0 = 1 << 3; + const int CC1 = 1 << 2; + const int CC2 = 1 << 1; + + switch (GET_CODE (code)) + { + case EQ: + return CC0; + case NE: + return CC1 | CC2; + case LT: + case LTU: + return CC1; + case GT: + case GTU: + return CC2; + case LE: + case LEU: + return CC0 | CC1; + case GE: + case GEU: + return CC0 | CC2; + default: + gcc_unreachable (); + } + return -1; +} + /* If INV is false, return assembler mnemonic string to implement a branch specified by CODE. If INV is true, return mnemonic for the corresponding inverted branch. */ @@ -1036,6 +1104,8 @@ s390_branch_condition_mask (rtx code) static const char * s390_branch_condition_mnemonic (rtx code, int inv) { + int mask; + static const char *const mnemonic[16] = { NULL, "o", "h", "nle", @@ -1044,7 +1114,13 @@ s390_branch_condition_mnemonic (rtx code, int inv) "le", "nh", "no", NULL }; - int mask = s390_branch_condition_mask (code); + if (GET_CODE (XEXP (code, 0)) == REG + && REGNO (XEXP (code, 0)) == CC_REGNUM + && XEXP (code, 1) == const0_rtx) + mask = s390_branch_condition_mask (code); + else + mask = s390_compare_and_branch_condition_mask (code); + gcc_assert (mask >= 0); if (inv) @@ -1121,6 +1197,67 @@ s390_single_part (rtx op, return part == -1 ? -1 : n_parts - 1 - part; } +/* Return true if IN contains a contiguous bitfield in the lower SIZE + bits and no other bits are set in IN. POS and LENGTH can be used + to obtain the start position and the length of the bitfield. + + POS gives the position of the first bit of the bitfield counting + from the lowest order bit starting with zero. In order to use this + value for S/390 instructions this has to be converted to "bits big + endian" style. */ + +bool +s390_contiguous_bitmask_p (unsigned HOST_WIDE_INT in, int size, + int *pos, int *length) +{ + int tmp_pos = 0; + int tmp_length = 0; + int i; + unsigned HOST_WIDE_INT mask = 1ULL; + bool contiguous = false; + + for (i = 0; i < size; mask <<= 1, i++) + { + if (contiguous) + { + if (mask & in) + tmp_length++; + else + break; + } + else + { + if (mask & in) + { + contiguous = true; + tmp_length++; + } + else + tmp_pos++; + } + } + + if (!tmp_length) + return false; + + /* Calculate a mask for all bits beyond the contiguous bits. */ + mask = (-1LL & ~(((1ULL << (tmp_length + tmp_pos - 1)) << 1) - 1)); + + if (mask & in) + return false; + + if (tmp_length + tmp_pos - 1 > size) + return false; + + if (length) + *length = tmp_length; + + if (pos) + *pos = tmp_pos; + + return true; +} + /* Check whether we can (and want to) split a double-word move in mode MODE from SRC to DST into two single-word moves, moving the subword FIRST_SUBWORD first. */ @@ -1365,6 +1502,8 @@ s390_handle_arch_option (const char *arg, | PF_LONG_DISPLACEMENT | PF_EXTIMM}, {"z9-ec", PROCESSOR_2094_Z9_109, PF_IEEE_FLOAT | PF_ZARCH | PF_LONG_DISPLACEMENT | PF_EXTIMM | PF_DFP }, + {"z10", PROCESSOR_2097_Z10, PF_IEEE_FLOAT | PF_ZARCH + | PF_LONG_DISPLACEMENT | PF_EXTIMM | PF_DFP | PF_Z10}, }; size_t i; @@ -1472,13 +1611,21 @@ override_options (void) } /* Set processor cost function. */ - if (s390_tune == PROCESSOR_2094_Z9_109) - s390_cost = &z9_109_cost; - else if (s390_tune == PROCESSOR_2084_Z990) - s390_cost = &z990_cost; - else - s390_cost = &z900_cost; - + switch (s390_tune) + { + case PROCESSOR_2084_Z990: + s390_cost = &z990_cost; + break; + case PROCESSOR_2094_Z9_109: + s390_cost = &z9_109_cost; + break; + case PROCESSOR_2097_Z10: + s390_cost = &z10_cost; + break; + default: + s390_cost = &z900_cost; + } + if (TARGET_BACKCHAIN && TARGET_PACKED_STACK && TARGET_HARD_FLOAT) error ("-mbackchain -mpacked-stack -mhard-float are not supported " "in combination"); @@ -1992,10 +2139,9 @@ s390_mem_constraint (const char *str, rtx op) return 0; if (GET_CODE (op) != MEM) return 0; - /* Any invalid address here will be fixed up by reload, - so accept it for the most generic constraint. */ - if (s390_decompose_address (XEXP (op, 0), &addr) - && s390_short_displacement (addr.disp)) + if (!s390_decompose_address (XEXP (op, 0), &addr)) + return 0; + if (s390_short_displacement (addr.disp)) return 0; break; @@ -2012,10 +2158,9 @@ s390_mem_constraint (const char *str, rtx op) case 'W': if (!TARGET_LONG_DISPLACEMENT) return 0; - /* Any invalid address here will be fixed up by reload, - so accept it for the most generic constraint. */ - if (s390_decompose_address (op, &addr) - && s390_short_displacement (addr.disp)) + if (!s390_decompose_address (op, &addr)) + return 0; + if (s390_short_displacement (addr.disp)) return 0; break; @@ -2651,6 +2796,132 @@ s390_preferred_reload_class (rtx op, enum reg_class class) return class; } +/* Return true if ADDR is of kind symbol_ref or symbol_ref + const_int + and return these parts in SYMREF and ADDEND. You can pass NULL in + SYMREF and/or ADDEND if you are not interested in these values. */ + +static bool +s390_symref_operand_p (rtx addr, rtx *symref, HOST_WIDE_INT *addend) +{ + HOST_WIDE_INT tmpaddend = 0; + + if (GET_CODE (addr) == CONST) + addr = XEXP (addr, 0); + + if (GET_CODE (addr) == PLUS) + { + if (GET_CODE (XEXP (addr, 0)) == SYMBOL_REF + && CONST_INT_P (XEXP (addr, 1))) + { + tmpaddend = INTVAL (XEXP (addr, 1)); + addr = XEXP (addr, 0); + } + else + return false; + } + else + if (GET_CODE (addr) != SYMBOL_REF) + return false; + + if (symref) + *symref = addr; + if (addend) + *addend = tmpaddend; + + return true; +} + +/* Return true if ADDR is SYMBOL_REF + addend with addend being a + multiple of ALIGNMENT and the SYMBOL_REF being naturally + aligned. */ + +bool +s390_check_symref_alignment (rtx addr, HOST_WIDE_INT alignment) +{ + HOST_WIDE_INT addend; + rtx symref; + + if (!s390_symref_operand_p (addr, &symref, &addend)) + return false; + + return (!SYMBOL_REF_NOT_NATURALLY_ALIGNED_P (symref) + && !(addend & (alignment - 1))); +} + +/* ADDR is moved into REG using larl. If ADDR isn't a valid larl + operand SCRATCH is used to reload the even part of the address and + adding one. */ + +void +s390_reload_larl_operand (rtx reg, rtx addr, rtx scratch) +{ + HOST_WIDE_INT addend; + rtx symref; + + if (!s390_symref_operand_p (addr, &symref, &addend)) + gcc_unreachable (); + + if (!(addend & 1)) + /* Easy case. The addend is even so larl will do fine. */ + emit_move_insn (reg, addr); + else + { + /* We can leave the scratch register untouched if the target + register is a valid base register. */ + if (REGNO (reg) < FIRST_PSEUDO_REGISTER + && REGNO_REG_CLASS (REGNO (reg)) == ADDR_REGS) + scratch = reg; + + gcc_assert (REGNO (scratch) < FIRST_PSEUDO_REGISTER); + gcc_assert (REGNO_REG_CLASS (REGNO (scratch)) == ADDR_REGS); + + if (addend != 1) + emit_move_insn (scratch, + gen_rtx_CONST (Pmode, + gen_rtx_PLUS (Pmode, symref, + GEN_INT (addend - 1)))); + else + emit_move_insn (scratch, symref); + + /* Increment the address using la in order to avoid clobbering cc. */ + emit_move_insn (reg, gen_rtx_PLUS (Pmode, scratch, const1_rtx)); + } +} + +/* Generate what is necessary to move between REG and MEM using + SCRATCH. The direction is given by TOMEM. */ + +void +s390_reload_symref_address (rtx reg, rtx mem, rtx scratch, bool tomem) +{ + /* Reload might have pulled a constant out of the literal pool. + Force it back in. */ + if (CONST_INT_P (mem) || GET_CODE (mem) == CONST_DOUBLE + || GET_CODE (mem) == CONST) + mem = force_const_mem (GET_MODE (reg), mem); + + gcc_assert (MEM_P (mem)); + + /* For a load from memory we can leave the scratch register + untouched if the target register is a valid base register. */ + if (!tomem + && REGNO (reg) < FIRST_PSEUDO_REGISTER + && REGNO_REG_CLASS (REGNO (reg)) == ADDR_REGS + && GET_MODE (reg) == GET_MODE (scratch)) + scratch = reg; + + /* Load address into scratch register. Since we can't have a + secondary reload for a secondary reload we have to cover the case + where larl would need a secondary reload here as well. */ + s390_reload_larl_operand (scratch, XEXP (mem, 0), scratch); + + /* Now we can use a standard load/store to do the move. */ + if (tomem) + emit_move_insn (replace_equiv_address (mem, scratch), reg); + else + emit_move_insn (reg, replace_equiv_address (mem, scratch)); +} + /* Inform reload about cases where moving X with a mode MODE to a register in CLASS requires an extra scratch or immediate register. Return the class needed for the immediate register. */ @@ -2663,6 +2934,60 @@ s390_secondary_reload (bool in_p, rtx x, enum reg_class class, if (reg_classes_intersect_p (CC_REGS, class)) return GENERAL_REGS; + if (TARGET_Z10) + { + /* On z10 several optimizer steps may generate larl operands with + an odd addend. */ + if (in_p + && s390_symref_operand_p (x, NULL, NULL) + && mode == Pmode + && !s390_check_symref_alignment (x, 2)) + sri->icode = ((mode == DImode) ? CODE_FOR_reloaddi_larl_odd_addend_z10 + : CODE_FOR_reloadsi_larl_odd_addend_z10); + + /* On z10 we need a scratch register when moving QI, TI or floating + point mode values from or to a memory location with a SYMBOL_REF + or if the symref addend of a SI or DI move is not aligned to the + width of the access. */ + if (MEM_P (x) + && s390_symref_operand_p (XEXP (x, 0), NULL, NULL) + && (mode == QImode || mode == TImode || FLOAT_MODE_P (mode) + || (!TARGET_64BIT && mode == DImode) + || ((mode == HImode || mode == SImode || mode == DImode) + && (!s390_check_symref_alignment (XEXP (x, 0), + GET_MODE_SIZE (mode)))))) + { +#define __SECONDARY_RELOAD_CASE(M,m) \ + case M##mode: \ + if (TARGET_64BIT) \ + sri->icode = in_p ? CODE_FOR_reload##m##di_toreg_z10 : \ + CODE_FOR_reload##m##di_tomem_z10; \ + else \ + sri->icode = in_p ? CODE_FOR_reload##m##si_toreg_z10 : \ + CODE_FOR_reload##m##si_tomem_z10; \ + break; + + switch (GET_MODE (x)) + { + __SECONDARY_RELOAD_CASE (QI, qi); + __SECONDARY_RELOAD_CASE (HI, hi); + __SECONDARY_RELOAD_CASE (SI, si); + __SECONDARY_RELOAD_CASE (DI, di); + __SECONDARY_RELOAD_CASE (TI, ti); + __SECONDARY_RELOAD_CASE (SF, sf); + __SECONDARY_RELOAD_CASE (DF, df); + __SECONDARY_RELOAD_CASE (TF, tf); + __SECONDARY_RELOAD_CASE (SD, sd); + __SECONDARY_RELOAD_CASE (DD, dd); + __SECONDARY_RELOAD_CASE (TD, td); + + default: + gcc_unreachable (); + } +#undef __SECONDARY_RELOAD_CASE + } + } + /* We need a scratch register when loading a PLUS expression which is not a legitimate operand of the LOAD ADDRESS instruction. */ if (in_p && s390_plus_operand (x, mode)) @@ -2769,10 +3094,16 @@ s390_expand_plus_operand (rtx target, rtx src, STRICT specifies whether strict register checking applies. */ bool -legitimate_address_p (enum machine_mode mode ATTRIBUTE_UNUSED, - rtx addr, int strict) +legitimate_address_p (enum machine_mode mode, rtx addr, int strict) { struct s390_address ad; + + if (TARGET_Z10 + && larl_operand (addr, VOIDmode) + && (mode == VOIDmode + || s390_check_symref_alignment (addr, GET_MODE_SIZE (mode)))) + return true; + if (!s390_decompose_address (addr, &ad)) return false; @@ -4010,14 +4341,31 @@ s390_expand_addcc (enum rtx_code cmp_code, rtx cmp_op0, rtx cmp_op1, return false; } -/* Expand code for the insv template. Return true if successful, false else. */ +/* Expand code for the insv template. Return true if successful. */ -bool +bool s390_expand_insv (rtx dest, rtx op1, rtx op2, rtx src) { int bitsize = INTVAL (op1); int bitpos = INTVAL (op2); + /* On z10 we can use the risbg instruction to implement insv. */ + if (TARGET_Z10 + && ((GET_MODE (dest) == DImode && GET_MODE (src) == DImode) + || (GET_MODE (dest) == SImode && GET_MODE (src) == SImode))) + { + rtx op; + rtx clobber; + + op = gen_rtx_SET (GET_MODE(src), + gen_rtx_ZERO_EXTRACT (GET_MODE (dest), dest, op1, op2), + src); + clobber = gen_rtx_CLOBBER (VOIDmode, gen_rtx_REG (CCmode, CC_REGNUM)); + emit_insn (gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2, op, clobber))); + + return true; + } + /* We need byte alignment. */ if (bitsize % BITS_PER_UNIT) return false; @@ -4554,6 +4902,13 @@ print_operand_address (FILE *file, rtx addr) { struct s390_address ad; + if (s390_symref_operand_p (addr, NULL, NULL)) + { + gcc_assert (TARGET_Z10); + output_addr_const (file, addr); + return; + } + if (!s390_decompose_address (addr, &ad) || (ad.base && !REGNO_OK_FOR_BASE_P (REGNO (ad.base))) || (ad.indx && !REGNO_OK_FOR_INDEX_P (REGNO (ad.indx)))) @@ -4587,6 +4942,7 @@ print_operand_address (FILE *file, rtx addr) 'Y': print shift count operand. 'b': print integer X as if it's an unsigned byte. + 'c': print integer X as if it's an signed byte. 'x': print integer X as if it's an unsigned halfword. 'h': print integer X as if it's a signed halfword. 'i': print the first nonzero HImode part of X. @@ -4732,6 +5088,8 @@ print_operand (FILE *file, rtx x, int code) case CONST_INT: if (code == 'b') fprintf (file, HOST_WIDE_INT_PRINT_DEC, INTVAL (x) & 0xff); + else if (code == 'c') + fprintf (file, HOST_WIDE_INT_PRINT_DEC, ((INTVAL (x) & 0xff) ^ 0x80) - 0x80); else if (code == 'x') fprintf (file, HOST_WIDE_INT_PRINT_DEC, INTVAL (x) & 0xffff); else if (code == 'h') @@ -4930,10 +5288,16 @@ s390_adjust_priority (rtx insn ATTRIBUTE_UNUSED, int priority) static int s390_issue_rate (void) { - if (s390_tune == PROCESSOR_2084_Z990 - || s390_tune == PROCESSOR_2094_Z9_109) - return 3; - return 1; + switch (s390_tune) + { + case PROCESSOR_2084_Z990: + case PROCESSOR_2094_Z9_109: + return 3; + case PROCESSOR_2097_Z10: + return 2; + default: + return 1; + } } static int @@ -7433,7 +7797,7 @@ s390_emit_prologue (void) if (TARGET_BACKCHAIN && flag_non_call_exceptions) { addr = gen_rtx_MEM (BLKmode, gen_rtx_SCRATCH (VOIDmode)); - emit_insn (gen_rtx_CLOBBER (VOIDmode, addr)); + emit_clobber (addr); } } @@ -8515,11 +8879,30 @@ s390_encode_section_info (tree decl, rtx rtl, int first) { default_encode_section_info (decl, rtl, first); - /* If a variable has a forced alignment to < 2 bytes, mark it with - SYMBOL_FLAG_ALIGN1 to prevent it from being used as LARL operand. */ - if (TREE_CODE (decl) == VAR_DECL - && DECL_USER_ALIGN (decl) && DECL_ALIGN (decl) < 16) - SYMBOL_REF_FLAGS (XEXP (rtl, 0)) |= SYMBOL_FLAG_ALIGN1; + if (TREE_CODE (decl) == VAR_DECL) + { + /* If a variable has a forced alignment to < 2 bytes, mark it + with SYMBOL_FLAG_ALIGN1 to prevent it from being used as LARL + operand. */ + if (DECL_USER_ALIGN (decl) && DECL_ALIGN (decl) < 16) + SYMBOL_REF_FLAGS (XEXP (rtl, 0)) |= SYMBOL_FLAG_ALIGN1; + if (!DECL_SIZE (decl) + || !DECL_ALIGN (decl) + || !host_integerp (DECL_SIZE (decl), 0) + || (DECL_ALIGN (decl) <= 64 + && DECL_ALIGN (decl) != tree_low_cst (DECL_SIZE (decl), 0))) + SYMBOL_REF_FLAGS (XEXP (rtl, 0)) |= SYMBOL_FLAG_NOT_NATURALLY_ALIGNED; + } + + /* Literal pool references don't have a decl so they are handled + differently here. We rely on the information in the MEM_ALIGN + entry to decide upon natural alignment. */ + if (MEM_P (rtl) + && GET_CODE (XEXP (rtl, 0)) == SYMBOL_REF + && TREE_CONSTANT_POOL_ADDRESS_P (XEXP (rtl, 0)) + && (MEM_ALIGN (rtl) == 0 + || MEM_ALIGN (rtl) < GET_MODE_BITSIZE (GET_MODE (rtl)))) + SYMBOL_REF_FLAGS (XEXP (rtl, 0)) |= SYMBOL_FLAG_NOT_NATURALLY_ALIGNED; } /* Output thunk to FILE that implements a C++ virtual function call (with diff --git a/gcc/config/s390/s390.h b/gcc/config/s390/s390.h index bec01200677..79286d5a9bc 100644 --- a/gcc/config/s390/s390.h +++ b/gcc/config/s390/s390.h @@ -1,8 +1,9 @@ /* Definitions of target machine for GNU compiler, for IBM S/390 Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, - 2007 Free Software Foundation, Inc. + 2007, 2008 Free Software Foundation, Inc. Contributed by Hartmut Penner (hpenner@de.ibm.com) and Ulrich Weigand (uweigand@de.ibm.com). + Andreas Krebbel (Andreas.Krebbel@de.ibm.com) This file is part of GCC. @@ -40,6 +41,7 @@ enum processor_type PROCESSOR_2064_Z900, PROCESSOR_2084_Z990, PROCESSOR_2094_Z9_109, + PROCESSOR_2097_Z10, PROCESSOR_max }; @@ -51,7 +53,8 @@ enum processor_flags PF_ZARCH = 2, PF_LONG_DISPLACEMENT = 4, PF_EXTIMM = 8, - PF_DFP = 16 + PF_DFP = 16, + PF_Z10 = 32 }; extern enum processor_type s390_tune; @@ -60,6 +63,10 @@ extern enum processor_flags s390_tune_flags; extern enum processor_type s390_arch; extern enum processor_flags s390_arch_flags; +/* These flags indicate that the generated code should run on a cpu + providing the respective hardware facility regardless of the + current cpu mode (ESA or z/Architecture). */ + #define TARGET_CPU_IEEE_FLOAT \ (s390_arch_flags & PF_IEEE_FLOAT) #define TARGET_CPU_ZARCH \ @@ -70,6 +77,12 @@ extern enum processor_flags s390_arch_flags; (s390_arch_flags & PF_EXTIMM) #define TARGET_CPU_DFP \ (s390_arch_flags & PF_DFP) +#define TARGET_CPU_Z10 \ + (s390_arch_flags & PF_Z10) + +/* These flags indicate that the generated code should run on a cpu + providing the respective hardware facility when run in + z/Architecture mode. */ #define TARGET_LONG_DISPLACEMENT \ (TARGET_ZARCH && TARGET_CPU_LONG_DISPLACEMENT) @@ -77,6 +90,8 @@ extern enum processor_flags s390_arch_flags; (TARGET_ZARCH && TARGET_CPU_EXTIMM) #define TARGET_DFP \ (TARGET_ZARCH && TARGET_CPU_DFP) +#define TARGET_Z10 \ + (TARGET_ZARCH && TARGET_CPU_Z10) /* Run-time target specification. */ @@ -485,11 +500,14 @@ extern const enum reg_class regclass_map[FIRST_PSEUDO_REGISTER]; #define PREFERRED_RELOAD_CLASS(X, CLASS) \ s390_preferred_reload_class ((X), (CLASS)) -/* We need secondary memory to move data between GPRs and FPRs. */ +/* We need secondary memory to move data between GPRs and FPRs. With + DFP the ldgr lgdr instructions are available. But these + instructions do not handle GPR pairs so it is not possible for 31 + bit. */ #define SECONDARY_MEMORY_NEEDED(CLASS1, CLASS2, MODE) \ ((CLASS1) != (CLASS2) \ && ((CLASS1) == FP_REGS || (CLASS2) == FP_REGS) \ - && (!TARGET_DFP || GET_MODE_SIZE (MODE) != 8)) + && (!TARGET_DFP || !TARGET_64BIT || GET_MODE_SIZE (MODE) != 8)) /* Get_secondary_mem widens its argument to BITS_PER_WORD which loses on 64bit because the movsi and movsf patterns don't handle r/f moves. */ @@ -687,6 +705,13 @@ CUMULATIVE_ARGS; /* Maximum number of registers that can appear in a valid memory address. */ #define MAX_REGS_PER_ADDRESS 2 +/* This definition replaces the formerly used 'm' constraint with a +different constraint letter in order to avoid changing semantics of +the 'm' constraint when accepting new address formats in +legitimate_address_p. The constraint letter defined here must not be +used in insn definitions or inline assemblies. */ +#define TARGET_MEM_CONSTRAINT 'e' + /* S/390 has no mode dependent addresses. */ #define GO_IF_MODE_DEPENDENT_ADDRESS(ADDR, LABEL) @@ -953,7 +978,12 @@ do { \ #define CLZ_DEFINED_VALUE_AT_ZERO(MODE, VALUE) ((VALUE) = 64, 1) /* Machine-specific symbol_ref flags. */ -#define SYMBOL_FLAG_ALIGN1 (SYMBOL_FLAG_MACH_DEP << 0) +#define SYMBOL_FLAG_ALIGN1 (SYMBOL_FLAG_MACH_DEP << 0) +#define SYMBOL_REF_ALIGN1_P(X) \ + ((SYMBOL_REF_FLAGS (X) & SYMBOL_FLAG_ALIGN1)) +#define SYMBOL_FLAG_NOT_NATURALLY_ALIGNED (SYMBOL_FLAG_MACH_DEP << 1) +#define SYMBOL_REF_NOT_NATURALLY_ALIGNED_P(X) \ + ((SYMBOL_REF_FLAGS (X) & SYMBOL_FLAG_NOT_NATURALLY_ALIGNED)) /* Check whether integer displacement is in range. */ #define DISP_IN_RANGE(d) \ diff --git a/gcc/config/s390/s390.md b/gcc/config/s390/s390.md index 03ebfcde5b8..d33cc5c3267 100644 --- a/gcc/config/s390/s390.md +++ b/gcc/config/s390/s390.md @@ -1,8 +1,9 @@ ;;- Machine description for GNU compiler -- S/390 / zSeries version. -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 ;; Free Software Foundation, Inc. ;; Contributed by Hartmut Penner (hpenner@de.ibm.com) and -;; Ulrich Weigand (uweigand@de.ibm.com). +;; Ulrich Weigand (uweigand@de.ibm.com) and +;; Andreas Krebbel (Andreas.Krebbel@de.ibm.com) ;; This file is part of GCC. @@ -38,6 +39,7 @@ ;; %Y: print shift count operand. ;; ;; %b: print integer X as if it's an unsigned byte. +;; %c: print integer X as if it's an signed byte. ;; %x: print integer X as if it's an unsigned halfword. ;; %h: print integer X as if it's a signed halfword. ;; %i: print the first nonzero HImode part of X. @@ -189,7 +191,7 @@ ;; Used to determine defaults for length and other attribute values. (define_attr "op_type" - "NN,E,RR,RRE,RX,RS,RSI,RI,SI,S,SS,SSE,RXE,RSE,RIL,RIE,RXY,RSY,SIY,RRF,RRR" + "NN,E,RR,RRE,RX,RS,RSI,RI,SI,S,SS,SSE,RXE,RSE,RIL,RIE,RXY,RSY,SIY,RRF,RRR,SIL,RRS,RIS" (const_string "NN")) ;; Instruction type attribute used for scheduling. @@ -218,8 +220,8 @@ ;; Length in bytes. (define_attr "length" "" - (cond [(eq_attr "op_type" "E,RR") (const_int 2) - (eq_attr "op_type" "RX,RI,RRE,RS,RSI,S,SI") (const_int 4)] + (cond [(eq_attr "op_type" "E,RR") (const_int 2) + (eq_attr "op_type" "RX,RI,RRE,RS,RSI,S,SI,RRF,RRR") (const_int 4)] (const_int 6))) @@ -228,10 +230,10 @@ ;; distinguish between g5 and g6, but there are differences between the two ;; CPUs could in theory be modeled. -(define_attr "cpu" "g5,g6,z900,z990,z9_109" +(define_attr "cpu" "g5,g6,z900,z990,z9_109,z10" (const (symbol_ref "s390_tune"))) -(define_attr "cpu_facility" "standard,ieee,zarch,longdisp,extimm,dfp" +(define_attr "cpu_facility" "standard,ieee,zarch,longdisp,extimm,dfp,z10" (const_string "standard")) (define_attr "enabled" "" @@ -256,6 +258,10 @@ (and (eq_attr "cpu_facility" "dfp") (ne (symbol_ref "TARGET_DFP") (const_int 0))) + (const_int 1) + + (and (eq_attr "cpu_facility" "z10") + (ne (symbol_ref "TARGET_Z10") (const_int 0))) (const_int 1)] (const_int 0))) @@ -282,6 +288,7 @@ (define_mode_iterator FP_ALL [TF DF SF (TD "TARGET_HARD_DFP") (DD "TARGET_HARD_DFP") (SD "TARGET_HARD_DFP")]) (define_mode_iterator FP [TF DF SF (TD "TARGET_HARD_DFP") (DD "TARGET_HARD_DFP")]) +(define_mode_iterator FPALL [TF DF SF TD DD SD]) (define_mode_iterator BFP [TF DF SF]) (define_mode_iterator DFP [TD DD]) (define_mode_iterator DFP_ALL [TD DD SD]) @@ -311,6 +318,7 @@ ;; This mode iterator allows the integer patterns to be defined from the ;; same template. (define_mode_iterator INT [(DI "TARGET_64BIT") SI HI QI]) +(define_mode_iterator INTALL [TI DI SI HI QI]) ;; This iterator allows to unify all 'bCOND' expander patterns. (define_code_iterator COMPARE [eq ne gt gtu lt ltu ge geu le leu unordered @@ -453,7 +461,6 @@ ;; Maximum unsigned integer that fits in MODE. (define_mode_attr max_uint [(HI "65535") (QI "255")]) - ;; ;;- Compare instructions. ;; @@ -539,14 +546,19 @@ (define_insn "*tstdi_sign" [(set (reg CC_REGNUM) - (compare (ashiftrt:DI (ashift:DI (subreg:DI (match_operand:SI 0 "register_operand" "d") 0) - (const_int 32)) (const_int 32)) - (match_operand:DI 1 "const0_operand" ""))) - (set (match_operand:DI 2 "register_operand" "=d") + (compare + (ashiftrt:DI + (ashift:DI + (subreg:DI (match_operand:SI 0 "nonimmediate_operand" "d,RT") 0) + (const_int 32)) (const_int 32)) + (match_operand:DI 1 "const0_operand" ""))) + (set (match_operand:DI 2 "register_operand" "=d,d") (sign_extend:DI (match_dup 0)))] "s390_match_ccmode(insn, CCSmode) && TARGET_64BIT" - "ltgfr\t%2,%0" - [(set_attr "op_type" "RRE")]) + "ltgfr\t%2,%0 + ltgf\t%2,%0" + [(set_attr "op_type" "RRE,RXY") + (set_attr "cpu_facility" "*,z10")]) ; ltr, lt, ltgr, ltg (define_insn "*tst<mode>_extimm" @@ -722,90 +734,159 @@ (define_insn "*cmpdi_ccs_sign" [(set (reg CC_REGNUM) - (compare (sign_extend:DI (match_operand:SI 1 "nonimmediate_operand" "d,RT")) - (match_operand:DI 0 "register_operand" "d,d")))] + (compare (sign_extend:DI (match_operand:SI 1 "nonimmediate_operand" + "d,RT,b")) + (match_operand:DI 0 "register_operand" "d, d,d")))] "s390_match_ccmode(insn, CCSRmode) && TARGET_64BIT" "@ cgfr\t%0,%1 - cgf\t%0,%1" - [(set_attr "op_type" "RRE,RXY")]) + cgf\t%0,%1 + cgfrl\t%0,%1" + [(set_attr "op_type" "RRE,RXY,RIL") + (set_attr "cpu_facility" "*,*,z10") + (set_attr "type" "*,*,larl")]) (define_insn "*cmpsi_ccs_sign" [(set (reg CC_REGNUM) - (compare (sign_extend:SI (match_operand:HI 1 "memory_operand" "R,T")) - (match_operand:SI 0 "register_operand" "d,d")))] + (compare (sign_extend:SI (match_operand:HI 1 "memory_operand" "R,T,b")) + (match_operand:SI 0 "register_operand" "d,d,d")))] "s390_match_ccmode(insn, CCSRmode)" "@ ch\t%0,%1 - chy\t%0,%1" - [(set_attr "op_type" "RX,RXY")]) + chy\t%0,%1 + chrl\t%0,%1" + [(set_attr "op_type" "RX,RXY,RIL") + (set_attr "cpu_facility" "*,*,z10") + (set_attr "type" "*,*,larl")]) + +(define_insn "*cmphi_ccs_z10" + [(set (reg CC_REGNUM) + (compare (match_operand:HI 0 "s_operand" "Q") + (match_operand:HI 1 "immediate_operand" "K")))] + "s390_match_ccmode(insn, CCSmode) && TARGET_Z10" + "chhsi\t%0,%1" + [(set_attr "op_type" "SIL")]) + +(define_insn "*cmpdi_ccs_signhi_rl" + [(set (reg CC_REGNUM) + (compare (sign_extend:DI (match_operand:HI 1 "memory_operand" "RT,b")) + (match_operand:GPR 0 "register_operand" "d,d")))] + "s390_match_ccmode(insn, CCSRmode) && TARGET_Z10" + "@ + cgh\t%0,%1 + cghrl\t%0,%1" + [(set_attr "op_type" "RXY,RIL") + (set_attr "type" "*,larl")]) -; cr, chi, cfi, c, cy, cgr, cghi, cgfi, cg +; cr, chi, cfi, c, cy, cgr, cghi, cgfi, cg, chsi, cghsi, crl, cgrl (define_insn "*cmp<mode>_ccs" [(set (reg CC_REGNUM) - (compare (match_operand:GPR 0 "register_operand" "d,d,d,d,d") - (match_operand:GPR 1 "general_operand" "d,K,Os,R,T")))] + (compare (match_operand:GPR 0 "nonimmediate_operand" + "d,d,Q, d,d,d,d") + (match_operand:GPR 1 "general_operand" + "d,K,K,Os,R,T,b")))] "s390_match_ccmode(insn, CCSmode)" "@ c<g>r\t%0,%1 c<g>hi\t%0,%h1 + c<g>hsi\t%0,%h1 c<g>fi\t%0,%1 c<g>\t%0,%1 - c<y>\t%0,%1" - [(set_attr "op_type" "RR<E>,RI,RIL,RX<Y>,RXY")]) + c<y>\t%0,%1 + c<g>rl\t%0,%1" + [(set_attr "op_type" "RR<E>,RI,SIL,RIL,RX<Y>,RXY,RIL") + (set_attr "cpu_facility" "*,*,z10,extimm,*,*,z10") + (set_attr "type" "*,*,*,*,*,*,larl")]) ; Compare (unsigned) instructions +(define_insn "*cmpsi_ccu_zerohi_rlsi" + [(set (reg CC_REGNUM) + (compare (zero_extend:SI (mem:HI (match_operand:SI 1 + "larl_operand" "X"))) + (match_operand:SI 0 "register_operand" "d")))] + "s390_match_ccmode(insn, CCURmode) && TARGET_Z10" + "clhrl\t%0,%1" + [(set_attr "op_type" "RIL") + (set_attr "type" "larl")]) + +; clhrl, clghrl +(define_insn "*cmp<GPR:mode>_ccu_zerohi_rldi" + [(set (reg CC_REGNUM) + (compare (zero_extend:GPR (mem:HI (match_operand:DI 1 + "larl_operand" "X"))) + (match_operand:GPR 0 "register_operand" "d")))] + "s390_match_ccmode(insn, CCURmode) && TARGET_Z10" + "cl<g>hrl\t%0,%1" + [(set_attr "op_type" "RIL") + (set_attr "type" "larl")]) + (define_insn "*cmpdi_ccu_zero" [(set (reg CC_REGNUM) - (compare (zero_extend:DI (match_operand:SI 1 "nonimmediate_operand" "d,RT")) - (match_operand:DI 0 "register_operand" "d,d")))] + (compare (zero_extend:DI (match_operand:SI 1 "nonimmediate_operand" + "d,RT,b")) + (match_operand:DI 0 "register_operand" "d, d,d")))] "s390_match_ccmode (insn, CCURmode) && TARGET_64BIT" "@ clgfr\t%0,%1 - clgf\t%0,%1" - [(set_attr "op_type" "RRE,RXY")]) + clgf\t%0,%1 + clgfrl\t%0,%1" + [(set_attr "op_type" "RRE,RXY,RIL") + (set_attr "cpu_facility" "*,*,z10") + (set_attr "type" "*,*,larl")]) (define_insn "*cmpdi_ccu" [(set (reg CC_REGNUM) - (compare (match_operand:DI 0 "nonimmediate_operand" "d,d,d,Q,BQ") - (match_operand:DI 1 "general_operand" "d,Op,RT,BQ,Q")))] + (compare (match_operand:DI 0 "nonimmediate_operand" + "d, d,d,Q, d, Q,BQ") + (match_operand:DI 1 "general_operand" + "d,Op,b,D,RT,BQ,Q")))] "s390_match_ccmode (insn, CCUmode) && TARGET_64BIT" "@ clgr\t%0,%1 clgfi\t%0,%1 + clgrl\t%0,%1 + clghsi\t%0,%x1 clg\t%0,%1 # #" - [(set_attr "op_type" "RRE,RIL,RXY,SS,SS")]) + [(set_attr "op_type" "RRE,RIL,RIL,SIL,RXY,SS,SS") + (set_attr "cpu_facility" "*,extimm,z10,z10,*,*,*") + (set_attr "type" "*,*,larl,*,*,*,*")]) (define_insn "*cmpsi_ccu" [(set (reg CC_REGNUM) - (compare (match_operand:SI 0 "nonimmediate_operand" "d,d,d,d,Q,BQ") - (match_operand:SI 1 "general_operand" "d,Os,R,T,BQ,Q")))] + (compare (match_operand:SI 0 "nonimmediate_operand" "d, d,d,Q,d,d, Q,BQ") + (match_operand:SI 1 "general_operand" "d,Os,b,D,R,T,BQ, Q")))] "s390_match_ccmode (insn, CCUmode)" "@ clr\t%0,%1 clfi\t%0,%o1 + clrl\t%0,%1 + clfhsi\t%0,%x1 cl\t%0,%1 cly\t%0,%1 # #" - [(set_attr "op_type" "RR,RIL,RX,RXY,SS,SS")]) + [(set_attr "op_type" "RR,RIL,RIL,SIL,RX,RXY,SS,SS") + (set_attr "cpu_facility" "*,extimm,z10,z10,*,*,*,*") + (set_attr "type" "*,*,larl,*,*,*,*,*")]) (define_insn "*cmphi_ccu" [(set (reg CC_REGNUM) - (compare (match_operand:HI 0 "nonimmediate_operand" "d,d,Q,BQ") - (match_operand:HI 1 "general_operand" "Q,S,BQ,Q")))] + (compare (match_operand:HI 0 "nonimmediate_operand" "d,d,Q,Q,BQ") + (match_operand:HI 1 "general_operand" "Q,S,D,BQ,Q")))] "s390_match_ccmode (insn, CCUmode) && !register_operand (operands[1], HImode)" "@ clm\t%0,3,%S1 clmy\t%0,3,%S1 + clhhsi\t%0,%1 # #" - [(set_attr "op_type" "RS,RSY,SS,SS")]) + [(set_attr "op_type" "RS,RSY,SIL,SS,SS") + (set_attr "cpu_facility" "*,*,z10,*,*")]) (define_insn "*cmpqi_ccu" [(set (reg CC_REGNUM) @@ -881,6 +962,59 @@ [(set_attr "op_type" "RRE,RXE") (set_attr "type" "fsimp<bfp>")]) + +; Compare and Branch instructions + +; cij, cgij, crj, cgrj, cfi, cgfi, cr, cgr +(define_insn "*cmp_and_br_signed_<mode>" + [(set (pc) + (if_then_else (match_operator 0 "s390_signed_integer_comparison" + [(match_operand:GPR 1 "register_operand" "d,d") + (match_operand:GPR 2 "nonmemory_operand" "d,C")]) + (label_ref (match_operand 3 "" "")) + (pc))) + (clobber (reg:CC CC_REGNUM))] + "TARGET_Z10" +{ + if (get_attr_length (insn) == 6) + return which_alternative ? + "c<g>ij%C0\t%1,%c2,%l3" : "c<g>rj%C0\t%1,%2,%l3"; + else + return which_alternative ? + "c<g>fi\t%1,%c2\;jg%C0\t%l3" : "c<g>r\t%1,%2\;jg%C0\t%l3"; +} + [(set_attr "op_type" "RIE") + (set_attr "type" "branch") + (set (attr "length") + (if_then_else (lt (abs (minus (pc) (match_dup 3))) (const_int 60000)) + (const_int 6) (const_int 12)))]) ; 8 byte for cr/jg + ; 10 byte for cgr/jg + +; clij, clgij, clrj, clgrj, clfi, clgfi, clr, clgr +(define_insn "*cmp_and_br_unsigned_<mode>" + [(set (pc) + (if_then_else (match_operator 0 "s390_unsigned_integer_comparison" + [(match_operand:GPR 1 "register_operand" "d,d") + (match_operand:GPR 2 "nonmemory_operand" "d,I")]) + (label_ref (match_operand 3 "" "")) + (pc))) + (clobber (reg:CC CC_REGNUM))] + "TARGET_Z10" +{ + if (get_attr_length (insn) == 6) + return which_alternative ? + "cl<g>ij%C0\t%1,%b2,%l3" : "cl<g>rj%C0\t%1,%2,%l3"; + else + return which_alternative ? + "cl<g>fi\t%1,%b2\;jg%C0\t%l3" : "cl<g>r\t%1,%2\;jg%C0\t%l3"; +} + [(set_attr "op_type" "RIE") + (set_attr "type" "branch") + (set (attr "length") + (if_then_else (lt (abs (minus (pc) (match_dup 3))) (const_int 60000)) + (const_int 6) (const_int 12)))]) ; 8 byte for clr/jg + ; 10 byte for clgr/jg + ;; ;;- Move instructions. ;; @@ -947,6 +1081,60 @@ ; Patterns used for secondary reloads ; +; z10 provides move instructions accepting larl memory operands. +; Unfortunately there is no such variant for QI, TI and FP mode moves. +; These patterns are also used for unaligned SI and DI accesses. + +(define_expand "reload<INTALL:mode><P:mode>_tomem_z10" + [(parallel [(match_operand:INTALL 0 "memory_operand" "") + (match_operand:INTALL 1 "register_operand" "=d") + (match_operand:P 2 "register_operand" "=&a")])] + "TARGET_Z10" +{ + s390_reload_symref_address (operands[1], operands[0], operands[2], 1); + DONE; +}) + +(define_expand "reload<INTALL:mode><P:mode>_toreg_z10" + [(parallel [(match_operand:INTALL 0 "register_operand" "=d") + (match_operand:INTALL 1 "memory_operand" "") + (match_operand:P 2 "register_operand" "=a")])] + "TARGET_Z10" +{ + s390_reload_symref_address (operands[0], operands[1], operands[2], 0); + DONE; +}) + +(define_expand "reload<FPALL:mode><P:mode>_tomem_z10" + [(parallel [(match_operand:FPALL 0 "memory_operand" "") + (match_operand:FPALL 1 "register_operand" "=d") + (match_operand:P 2 "register_operand" "=&a")])] + "TARGET_Z10" +{ + s390_reload_symref_address (operands[1], operands[0], operands[2], 1); + DONE; +}) + +(define_expand "reload<FPALL:mode><P:mode>_toreg_z10" + [(parallel [(match_operand:FPALL 0 "register_operand" "=d") + (match_operand:FPALL 1 "memory_operand" "") + (match_operand:P 2 "register_operand" "=a")])] + "TARGET_Z10" +{ + s390_reload_symref_address (operands[0], operands[1], operands[2], 0); + DONE; +}) + +(define_expand "reload<P:mode>_larl_odd_addend_z10" + [(parallel [(match_operand:P 0 "register_operand" "=d") + (match_operand:P 1 "larl_operand" "") + (match_operand:P 2 "register_operand" "=a")])] + "TARGET_Z10" +{ + s390_reload_larl_operand (operands[0], operands[1], operands[2]); + DONE; +}) + ; Handles loading a PLUS (load address) expression (define_expand "reload<mode>_plus" @@ -1016,11 +1204,11 @@ (define_insn "*movdi_64" [(set (match_operand:DI 0 "nonimmediate_operand" - "=d,d,d,d,d,d,d,d,f,d,d,d,d, - RT,!*f,!*f,!*f,!R,!T,d,t,Q,t,?Q") + "=d,d,d,d,d,d,d,d,f,d,d,d,d,d, + RT,!*f,!*f,!*f,!R,!T,b,Q,d,t,Q,t,?Q") (match_operand:DI 1 "general_operand" - "K,N0HD0,N1HD0,N2HD0,N3HD0,Os,N0SD0,N1SD0,d,f,L,d,RT, - d,*f,R,T,*f,*f,t,d,t,Q,?Q"))] + "K,N0HD0,N1HD0,N2HD0,N3HD0,Os,N0SD0,N1SD0,d,f,L,b,d,RT, + d,*f,R,T,*f,*f,d,K,t,d,t,Q,?Q"))] "TARGET_64BIT" "@ lghi\t%0,%h1 @@ -1034,6 +1222,7 @@ ldgr\t%0,%1 lgdr\t%0,%1 lay\t%0,%a1 + lgrl\t%0,%1 lgr\t%0,%1 lg\t%0,%1 stg\t%1,%0 @@ -1042,17 +1231,21 @@ ldy\t%0,%1 std\t%1,%0 stdy\t%1,%0 + stgrl\t%1,%0 + mvghi\t%0,%1 # # stam\t%1,%N1,%S0 lam\t%0,%N0,%S1 #" - [(set_attr "op_type" "RI,RI,RI,RI,RI,RIL,RIL,RIL,RRE,RRE,RXY,RRE,RXY,RXY, - RR,RX,RXY,RX,RXY,*,*,RS,RS,SS") - (set_attr "type" "*,*,*,*,*,*,*,*,floaddf,floaddf,la,lr,load,store, - floaddf,floaddf,floaddf,fstoredf,fstoredf,*,*,*,*,*") + [(set_attr "op_type" "RI,RI,RI,RI,RI,RIL,RIL,RIL,RRE,RRE,RXY,RIL,RRE,RXY, + RXY,RR,RX,RXY,RX,RXY,RIL,SIL,*,*,RS,RS,SS") + (set_attr "type" "*,*,*,*,*,*,*,*,floaddf,floaddf,la,larl,lr,load,store, + floaddf,floaddf,floaddf,fstoredf,fstoredf,larl,*,*,*, + *,*,*") (set_attr "cpu_facility" "*,*,*,*,*,extimm,extimm,extimm,dfp,dfp,longdisp, - *,*,*,*,*,longdisp,*,longdisp,*,*,*,*,*")]) + z10,*,*,*,*,*,longdisp,*,longdisp, + z10,z10,*,*,*,*,*")]) (define_split [(set (match_operand:DI 0 "register_operand" "") @@ -1088,8 +1281,10 @@ s390_split_access_reg (operands[0], &operands[3], &operands[4]);") (define_insn "*movdi_31" - [(set (match_operand:DI 0 "nonimmediate_operand" "=d,d,Q,S,d,o,!*f,!*f,!*f,!R,!T,Q") - (match_operand:DI 1 "general_operand" "Q,S,d,d,dPRT,d,*f,R,T,*f,*f,Q"))] + [(set (match_operand:DI 0 "nonimmediate_operand" + "=d,d,Q,S,d ,o,!*f,!*f,!*f,!R,!T,Q,d") + (match_operand:DI 1 "general_operand" + " Q,S,d,d,dPRT,d, *f, R, T,*f,*f,Q,b"))] "!TARGET_64BIT" "@ lm\t%0,%N0,%S1 @@ -1103,9 +1298,26 @@ ldy\t%0,%1 std\t%1,%0 stdy\t%1,%0 + # #" - [(set_attr "op_type" "RS,RSY,RS,RSY,*,*,RR,RX,RXY,RX,RXY,SS") - (set_attr "type" "lm,lm,stm,stm,*,*,floaddf,floaddf,floaddf,fstoredf,fstoredf,*")]) + [(set_attr "op_type" "RS,RSY,RS,RSY,*,*,RR,RX,RXY,RX,RXY,SS,*") + (set_attr "type" "lm,lm,stm,stm,*,*,floaddf,floaddf,floaddf,fstoredf,fstoredf,*,*") + (set_attr "cpu_facility" "*,*,*,*,*,*,*,*,*,*,*,*,z10")]) + +; For a load from a symbol ref we can use one of the target registers +; together with larl to load the address. +(define_split + [(set (match_operand:DI 0 "register_operand" "") + (match_operand:DI 1 "memory_operand" ""))] + "!TARGET_64BIT && reload_completed && TARGET_Z10 + && larl_operand (XEXP (operands[1], 0), SImode)" + [(set (match_dup 2) (match_dup 3)) + (set (match_dup 0) (match_dup 1))] +{ + operands[2] = operand_subword (operands[0], 1, 0, DImode); + operands[3] = XEXP (operands[1], 0); + operands[1] = replace_equiv_address (operands[1], operands[2]); +}) (define_split [(set (match_operand:DI 0 "nonimmediate_operand" "") @@ -1223,9 +1435,9 @@ (define_insn "*movsi_zarch" [(set (match_operand:SI 0 "nonimmediate_operand" - "=d,d,d,d,d,d,d,d,R,T,!*f,!*f,!*f,!R,!T,d,t,Q,t,?Q") + "=d,d,d,d,d,d,d,d,d,R,T,!*f,!*f,!*f,!R,!T,d,t,Q,b,Q,t,?Q") (match_operand:SI 1 "general_operand" - "K,N0HS0,N1HS0,Os,L,d,R,T,d,d,*f,R,T,*f,*f,t,d,t,Q,?Q"))] + "K,N0HS0,N1HS0,Os,L,b,d,R,T,d,d,*f,R,T,*f,*f,t,d,t,d,K,Q,?Q"))] "TARGET_ZARCH" "@ lhi\t%0,%h1 @@ -1233,6 +1445,7 @@ llill\t%0,%i1 iilf\t%0,%o1 lay\t%0,%a1 + lrl\t%0,%1 lr\t%0,%1 l\t%0,%1 ly\t%0,%1 @@ -1246,12 +1459,16 @@ ear\t%0,%1 sar\t%0,%1 stam\t%1,%1,%S0 + strl\t%1,%0 + mvhi\t%0,%1 lam\t%0,%0,%S1 #" - [(set_attr "op_type" "RI,RI,RI,RIL,RXY,RR,RX,RXY,RX,RXY, - RR,RX,RXY,RX,RXY,RRE,RRE,RS,RS,SS") - (set_attr "type" "*,*,*,*,la,lr,load,load,store,store, - floadsf,floadsf,floadsf,fstoresf,fstoresf,*,*,*,*,*")]) + [(set_attr "op_type" "RI,RI,RI,RIL,RXY,RIL,RR,RX,RXY,RX,RXY, + RR,RX,RXY,RX,RXY,RRE,RRE,RS,RIL,SIL,RS,SS") + (set_attr "type" "*,*,*,*,la,larl,lr,load,load,store,store, + floadsf,floadsf,floadsf,fstoresf,fstoresf,*,*,*,larl,*,*,*") + (set_attr "cpu_facility" "*,*,*,extimm,longdisp,z10,*,*,longdisp,*,longdisp, + *,*,longdisp,*,longdisp,*,*,*,z10,z10,*,*")]) (define_insn "*movsi_esa" [(set (match_operand:SI 0 "nonimmediate_operand" "=d,d,d,R,!*f,!*f,!R,d,t,Q,t,?Q") @@ -1377,19 +1594,23 @@ }) (define_insn "*movhi" - [(set (match_operand:HI 0 "nonimmediate_operand" "=d,d,d,d,R,T,?Q") - (match_operand:HI 1 "general_operand" "d,n,R,T,d,d,?Q"))] + [(set (match_operand:HI 0 "nonimmediate_operand" "=d,d,d,d,d,R,T,b,Q,?Q") + (match_operand:HI 1 "general_operand" " d,n,R,T,b,d,d,d,K,?Q"))] "" "@ lr\t%0,%1 lhi\t%0,%h1 lh\t%0,%1 lhy\t%0,%1 + lhrl\t%0,%1 sth\t%1,%0 sthy\t%1,%0 + sthrl\t%1,%0 + mvhhi\t%0,%1 #" - [(set_attr "op_type" "RR,RI,RX,RXY,RX,RXY,SS") - (set_attr "type" "lr,*,*,*,store,store,*")]) + [(set_attr "op_type" "RR,RI,RX,RXY,RIL,RX,RXY,RIL,SIL,SS") + (set_attr "type" "lr,*,*,*,larl,store,store,store,*,*") + (set_attr "cpu_facility" "*,*,*,*,z10,*,*,z10,z10,*")]) (define_peephole2 [(set (match_operand:HI 0 "register_operand" "") @@ -2010,6 +2231,17 @@ ;; String instructions. ;; +(define_insn "*execute_rl" + [(match_parallel 0 "" + [(unspec [(match_operand 1 "register_operand" "a") + (match_operand 2 "" "") + (match_operand:SI 3 "larl_operand" "X")] UNSPEC_EXECUTE)])] + "TARGET_Z10 && GET_MODE_CLASS (GET_MODE (operands[1])) == MODE_INT + && GET_MODE_SIZE (GET_MODE (operands[1])) <= UNITS_PER_WORD" + "exrl\t%1,%3" + [(set_attr "op_type" "RIL") + (set_attr "type" "cs")]) + (define_insn "*execute" [(match_parallel 0 "" [(unspec [(match_operand 1 "register_operand" "a") @@ -2154,9 +2386,9 @@ ; (define_expand "movmem<mode>" - [(set (match_operand:BLK 0 "memory_operand" "") - (match_operand:BLK 1 "memory_operand" "")) - (use (match_operand:GPR 2 "general_operand" "")) + [(set (match_operand:BLK 0 "memory_operand" "") ; destination + (match_operand:BLK 1 "memory_operand" "")) ; source + (use (match_operand:GPR 2 "general_operand" "")) ; count (match_operand 3 "" "")] "" "s390_expand_movmem (operands[0], operands[1], operands[2]); DONE;") @@ -2175,15 +2407,16 @@ "operands[3] = gen_rtx_SCRATCH (Pmode);") (define_insn "*movmem_short" - [(set (match_operand:BLK 0 "memory_operand" "=Q,Q,Q") - (match_operand:BLK 1 "memory_operand" "Q,Q,Q")) - (use (match_operand 2 "nonmemory_operand" "n,a,a")) - (use (match_operand 3 "immediate_operand" "X,R,X")) - (clobber (match_scratch 4 "=X,X,&a"))] + [(set (match_operand:BLK 0 "memory_operand" "=Q,Q,Q,Q") + (match_operand:BLK 1 "memory_operand" "Q,Q,Q,Q")) + (use (match_operand 2 "nonmemory_operand" "n,a,a,a")) + (use (match_operand 3 "immediate_operand" "X,R,X,X")) + (clobber (match_scratch 4 "=X,X,X,&a"))] "(GET_MODE (operands[2]) == Pmode || GET_MODE (operands[2]) == VOIDmode) && GET_MODE (operands[4]) == Pmode" "#" - [(set_attr "type" "cs")]) + [(set_attr "type" "cs") + (set_attr "cpu_facility" "*,*,z10,*")]) (define_split [(set (match_operand:BLK 0 "memory_operand" "") @@ -2216,6 +2449,20 @@ (match_operand:BLK 1 "memory_operand" "")) (use (match_operand 2 "register_operand" "")) (use (const:BLK (unspec:BLK [(const_int 0)] UNSPEC_INSN))) + (clobber (scratch))] + "TARGET_Z10 && reload_completed" + [(parallel + [(unspec [(match_dup 2) (const_int 0) + (label_ref (match_dup 3))] UNSPEC_EXECUTE) + (set (match_dup 0) (match_dup 1)) + (use (const_int 1))])] + "operands[3] = gen_label_rtx ();") + +(define_split + [(set (match_operand:BLK 0 "memory_operand" "") + (match_operand:BLK 1 "memory_operand" "")) + (use (match_operand 2 "register_operand" "")) + (use (const:BLK (unspec:BLK [(const_int 0)] UNSPEC_INSN))) (clobber (match_operand 3 "register_operand" ""))] "reload_completed && TARGET_CPU_ZARCH" [(set (match_dup 3) (label_ref (match_dup 4))) @@ -2247,11 +2494,11 @@ rtx len0 = gen_lowpart (Pmode, reg0); rtx len1 = gen_lowpart (Pmode, reg1); - emit_insn (gen_rtx_CLOBBER (VOIDmode, reg0)); + emit_clobber (reg0); emit_move_insn (addr0, force_operand (XEXP (operands[0], 0), NULL_RTX)); emit_move_insn (len0, operands[2]); - emit_insn (gen_rtx_CLOBBER (VOIDmode, reg1)); + emit_clobber (reg1); emit_move_insn (addr1, force_operand (XEXP (operands[1], 0), NULL_RTX)); emit_move_insn (len1, operands[2]); @@ -2354,16 +2601,17 @@ "operands[2] = gen_rtx_SCRATCH (Pmode);") (define_insn "*clrmem_short" - [(set (match_operand:BLK 0 "memory_operand" "=Q,Q,Q") + [(set (match_operand:BLK 0 "memory_operand" "=Q,Q,Q,Q") (const_int 0)) - (use (match_operand 1 "nonmemory_operand" "n,a,a")) - (use (match_operand 2 "immediate_operand" "X,R,X")) - (clobber (match_scratch 3 "=X,X,&a")) + (use (match_operand 1 "nonmemory_operand" "n,a,a,a")) + (use (match_operand 2 "immediate_operand" "X,R,X,X")) + (clobber (match_scratch 3 "=X,X,X,&a")) (clobber (reg:CC CC_REGNUM))] "(GET_MODE (operands[1]) == Pmode || GET_MODE (operands[1]) == VOIDmode) && GET_MODE (operands[3]) == Pmode" "#" - [(set_attr "type" "cs")]) + [(set_attr "type" "cs") + (set_attr "cpu_facility" "*,*,z10,*")]) (define_split [(set (match_operand:BLK 0 "memory_operand" "") @@ -2400,6 +2648,22 @@ (const_int 0)) (use (match_operand 1 "register_operand" "")) (use (const:BLK (unspec:BLK [(const_int 0)] UNSPEC_INSN))) + (clobber (scratch)) + (clobber (reg:CC CC_REGNUM))] + "TARGET_Z10 && reload_completed" + [(parallel + [(unspec [(match_dup 1) (const_int 0) + (label_ref (match_dup 3))] UNSPEC_EXECUTE) + (set (match_dup 0) (const_int 0)) + (use (const_int 1)) + (clobber (reg:CC CC_REGNUM))])] + "operands[3] = gen_label_rtx ();") + +(define_split + [(set (match_operand:BLK 0 "memory_operand" "") + (const_int 0)) + (use (match_operand 1 "register_operand" "")) + (use (const:BLK (unspec:BLK [(const_int 0)] UNSPEC_INSN))) (clobber (match_operand 2 "register_operand" "")) (clobber (reg:CC CC_REGNUM))] "reload_completed && TARGET_CPU_ZARCH" @@ -2430,7 +2694,7 @@ rtx addr0 = gen_lowpart (Pmode, gen_highpart (word_mode, reg0)); rtx len0 = gen_lowpart (Pmode, reg0); - emit_insn (gen_rtx_CLOBBER (VOIDmode, reg0)); + emit_clobber (reg0); emit_move_insn (addr0, force_operand (XEXP (operands[0], 0), NULL_RTX)); emit_move_insn (len0, operands[1]); @@ -2495,15 +2759,16 @@ (define_insn "*cmpmem_short" [(set (reg:CCU CC_REGNUM) - (compare:CCU (match_operand:BLK 0 "memory_operand" "Q,Q,Q") - (match_operand:BLK 1 "memory_operand" "Q,Q,Q"))) - (use (match_operand 2 "nonmemory_operand" "n,a,a")) - (use (match_operand 3 "immediate_operand" "X,R,X")) - (clobber (match_scratch 4 "=X,X,&a"))] + (compare:CCU (match_operand:BLK 0 "memory_operand" "Q,Q,Q,Q") + (match_operand:BLK 1 "memory_operand" "Q,Q,Q,Q"))) + (use (match_operand 2 "nonmemory_operand" "n,a,a,a")) + (use (match_operand 3 "immediate_operand" "X,R,X,X")) + (clobber (match_scratch 4 "=X,X,X,&a"))] "(GET_MODE (operands[2]) == Pmode || GET_MODE (operands[2]) == VOIDmode) && GET_MODE (operands[4]) == Pmode" "#" - [(set_attr "type" "cs")]) + [(set_attr "type" "cs") + (set_attr "cpu_facility" "*,*,z10,*")]) (define_split [(set (reg:CCU CC_REGNUM) @@ -2539,6 +2804,21 @@ (match_operand:BLK 1 "memory_operand" ""))) (use (match_operand 2 "register_operand" "")) (use (const:BLK (unspec:BLK [(const_int 0)] UNSPEC_INSN))) + (clobber (scratch))] + "TARGET_Z10 && reload_completed" + [(parallel + [(unspec [(match_dup 2) (const_int 0) + (label_ref (match_dup 4))] UNSPEC_EXECUTE) + (set (reg:CCU CC_REGNUM) (compare:CCU (match_dup 0) (match_dup 1))) + (use (const_int 1))])] + "operands[4] = gen_label_rtx ();") + +(define_split + [(set (reg:CCU CC_REGNUM) + (compare:CCU (match_operand:BLK 0 "memory_operand" "") + (match_operand:BLK 1 "memory_operand" ""))) + (use (match_operand 2 "register_operand" "")) + (use (const:BLK (unspec:BLK [(const_int 0)] UNSPEC_INSN))) (clobber (match_operand 3 "register_operand" ""))] "reload_completed && TARGET_CPU_ZARCH" [(set (match_dup 3) (label_ref (match_dup 4))) @@ -2570,11 +2850,11 @@ rtx len0 = gen_lowpart (Pmode, reg0); rtx len1 = gen_lowpart (Pmode, reg1); - emit_insn (gen_rtx_CLOBBER (VOIDmode, reg0)); + emit_clobber (reg0); emit_move_insn (addr0, force_operand (XEXP (operands[0], 0), NULL_RTX)); emit_move_insn (len0, operands[2]); - emit_insn (gen_rtx_CLOBBER (VOIDmode, reg1)); + emit_clobber (reg1); emit_move_insn (addr1, force_operand (XEXP (operands[1], 0), NULL_RTX)); emit_move_insn (len1, operands[2]); @@ -2772,6 +3052,83 @@ FAIL; }) +(define_insn "*insv<mode>_z10" + [(set (zero_extract:GPR (match_operand:GPR 0 "nonimmediate_operand" "+d") + (match_operand 1 "const_int_operand" "I") + (match_operand 2 "const_int_operand" "I")) + (match_operand:GPR 3 "nonimmediate_operand" "d")) + (clobber (reg:CC CC_REGNUM))] + "TARGET_Z10 + && (INTVAL (operands[1]) + INTVAL (operands[2])) <= + GET_MODE_BITSIZE (<MODE>mode)" +{ + int start = INTVAL (operands[2]); + int size = INTVAL (operands[1]); + int offset = 64 - GET_MODE_BITSIZE (<MODE>mode); + + operands[2] = GEN_INT (offset + start); /* start bit position */ + operands[1] = GEN_INT (offset + start + size - 1); /* end bit position */ + operands[4] = GEN_INT (GET_MODE_BITSIZE (<MODE>mode) - + start - size); /* left shift count */ + + return "risbg\t%0,%3,%b2,%b1,%b4"; +} + [(set_attr "op_type" "RIE")]) + +; and op1 with a mask being 1 for the selected bits and 0 for the rest +; and op3=op0 with a mask being 0 for the selected bits and 1 for the rest +(define_insn "*insv<mode>_z10_noshift" + [(set (match_operand:GPR 0 "nonimmediate_operand" "=d") + (ior:GPR (and:GPR (match_operand:GPR 1 "nonimmediate_operand" "d") + (match_operand 2 "const_int_operand" "n")) + (and:GPR (match_operand:GPR 3 "nonimmediate_operand" "0") + (match_operand 4 "const_int_operand" "n")))) + (clobber (reg:CC CC_REGNUM))] + "TARGET_Z10 + && s390_contiguous_bitmask_p (INTVAL (operands[2]), + GET_MODE_BITSIZE (<MODE>mode), NULL, NULL) + && INTVAL (operands[2]) == ~(INTVAL (operands[4]))" + +{ + int start; + int size; + + s390_contiguous_bitmask_p (INTVAL (operands[2]), + GET_MODE_BITSIZE (<MODE>mode), &start, &size); + + operands[5] = GEN_INT (64 - start - size); /* start bit position */ + operands[6] = GEN_INT (64 - 1 - start); /* end bit position */ + operands[7] = const0_rtx; /* left shift count */ + + return "risbg\t%0,%1,%b5,%b6,%b7"; +} + [(set_attr "op_type" "RIE")]) + +; and op1 with a mask being 1 for the selected bits and 0 for the rest +(define_insn "*insv<mode>_or_z10_noshift" + [(set (match_operand:GPR 0 "nonimmediate_operand" "=d") + (ior:GPR (and:GPR (match_operand:GPR 1 "nonimmediate_operand" "d") + (match_operand 2 "const_int_operand" "n")) + (match_operand:GPR 3 "nonimmediate_operand" "0"))) + (clobber (reg:CC CC_REGNUM))] + "TARGET_Z10 + && s390_contiguous_bitmask_p (INTVAL (operands[2]), + GET_MODE_BITSIZE (<MODE>mode), NULL, NULL)" +{ + int start; + int size; + + s390_contiguous_bitmask_p (INTVAL (operands[2]), + GET_MODE_BITSIZE (<MODE>mode), &start, &size); + + operands[4] = GEN_INT (64 - start - size); /* start bit position */ + operands[5] = GEN_INT (64 - 1 - start); /* end bit position */ + operands[6] = const0_rtx; /* left shift count */ + + return "rosbg\t%0,%1,%b4,%b5,%b6"; +} + [(set_attr "op_type" "RIE")]) + (define_insn "*insv<mode>_mem_reg" [(set (zero_extract:P (match_operand:QI 0 "memory_operand" "+Q,S") (match_operand 1 "const_int_operand" "n,n") @@ -2858,7 +3215,7 @@ { if (!TARGET_64BIT) { - emit_insn (gen_rtx_CLOBBER (VOIDmode, operands[0])); + emit_clobber (operands[0]); emit_move_insn (gen_highpart (SImode, operands[0]), operands[1]); emit_move_insn (gen_lowpart (SImode, operands[0]), const0_rtx); emit_insn (gen_ashrdi3 (operands[0], operands[0], GEN_INT (32))); @@ -2867,13 +3224,16 @@ }) (define_insn "*extendsidi2" - [(set (match_operand:DI 0 "register_operand" "=d,d") - (sign_extend:DI (match_operand:SI 1 "nonimmediate_operand" "d,RT")))] + [(set (match_operand:DI 0 "register_operand" "=d,d,d") + (sign_extend:DI (match_operand:SI 1 "nonimmediate_operand" "d,RT,b")))] "TARGET_64BIT" "@ lgfr\t%0,%1 - lgf\t%0,%1" - [(set_attr "op_type" "RRE,RXY")]) + lgf\t%0,%1 + lgfrl\t%0,%1" + [(set_attr "op_type" "RRE,RXY,RIL") + (set_attr "type" "*,*,larl") + (set_attr "cpu_facility" "*,*,z10")]) ; ; extend(hi|qi)(si|di)2 instruction pattern(s). @@ -2908,13 +3268,16 @@ ; (define_insn "*extendhidi2_extimm" - [(set (match_operand:DI 0 "register_operand" "=d,d") - (sign_extend:DI (match_operand:HI 1 "nonimmediate_operand" "d,RT")))] + [(set (match_operand:DI 0 "register_operand" "=d,d,d") + (sign_extend:DI (match_operand:HI 1 "general_operand" "d,RT,b")))] "TARGET_64BIT && TARGET_EXTIMM" "@ lghr\t%0,%1 - lgh\t%0,%1" - [(set_attr "op_type" "RRE,RXY")]) + lgh\t%0,%1 + lghrl\t%0,%1" + [(set_attr "op_type" "RRE,RXY,RIL") + (set_attr "type" "*,*,larl") + (set_attr "cpu_facility" "extimm,extimm,z10")]) (define_insn "*extendhidi2" [(set (match_operand:DI 0 "register_operand" "=d") @@ -2928,14 +3291,17 @@ ; (define_insn "*extendhisi2_extimm" - [(set (match_operand:SI 0 "register_operand" "=d,d,d") - (sign_extend:SI (match_operand:HI 1 "nonimmediate_operand" "d,R,T")))] + [(set (match_operand:SI 0 "register_operand" "=d,d,d,d") + (sign_extend:SI (match_operand:HI 1 "nonimmediate_operand" " d,R,T,b")))] "TARGET_EXTIMM" "@ lhr\t%0,%1 lh\t%0,%1 - lhy\t%0,%1" - [(set_attr "op_type" "RRE,RX,RXY")]) + lhy\t%0,%1 + lhrl\t%0,%1" + [(set_attr "op_type" "RRE,RX,RXY,RIL") + (set_attr "type" "*,*,*,larl") + (set_attr "cpu_facility" "extimm,extimm,extimm,z10")]) (define_insn "*extendhisi2" [(set (match_operand:SI 0 "register_operand" "=d,d") @@ -2999,7 +3365,7 @@ { if (!TARGET_64BIT) { - emit_insn (gen_rtx_CLOBBER (VOIDmode, operands[0])); + emit_clobber (operands[0]); emit_move_insn (gen_lowpart (SImode, operands[0]), operands[1]); emit_move_insn (gen_highpart (SImode, operands[0]), const0_rtx); DONE; @@ -3007,13 +3373,16 @@ }) (define_insn "*zero_extendsidi2" - [(set (match_operand:DI 0 "register_operand" "=d,d") - (zero_extend:DI (match_operand:SI 1 "nonimmediate_operand" "d,RT")))] + [(set (match_operand:DI 0 "register_operand" "=d,d,d") + (zero_extend:DI (match_operand:SI 1 "nonimmediate_operand" "d,RT,b")))] "TARGET_64BIT" "@ llgfr\t%0,%1 - llgf\t%0,%1" - [(set_attr "op_type" "RRE,RXY")]) + llgf\t%0,%1 + llgfrl\t%0,%1" + [(set_attr "op_type" "RRE,RXY,RIL") + (set_attr "type" "*,*,larl") + (set_attr "cpu_facility" "*,*,z10")]) ; ; LLGT-type instructions (zero-extend from 31 bit to 64 bit). @@ -3112,6 +3481,19 @@ } }) +; llhrl, llghrl +(define_insn "*zero_extendhi<mode>2_z10" + [(set (match_operand:GPR 0 "register_operand" "=d,d,d") + (zero_extend:GPR (match_operand:HI 1 "nonimmediate_operand" "d,RT,b")))] + "TARGET_Z10" + "@ + ll<g>hr\t%0,%1 + ll<g>h\t%0,%1 + ll<g>hrl\t%0,%1" + [(set_attr "op_type" "RXY,RRE,RIL") + (set_attr "type" "*,*,larl") + (set_attr "cpu_facility" "*,*,z10")]) + ; llhr, llcr, llghr, llgcr, llh, llc, llgh, llgc (define_insn "*zero_extend<HQI:mode><GPR:mode>2_extimm" [(set (match_operand:GPR 0 "register_operand" "=d,d") @@ -3624,7 +4006,7 @@ (define_expand "adddi3" [(parallel - [(set (match_operand:DI 0 "register_operand" "") + [(set (match_operand:DI 0 "nonimmediate_operand" "") (plus:DI (match_operand:DI 1 "nonimmediate_operand" "") (match_operand:DI 2 "general_operand" ""))) (clobber (reg:CC CC_REGNUM))])] @@ -3679,7 +4061,7 @@ [(set_attr "op_type" "RRE,RXY")]) (define_insn_and_split "*adddi3_31z" - [(set (match_operand:DI 0 "register_operand" "=&d") + [(set (match_operand:DI 0 "nonimmediate_operand" "=&d") (plus:DI (match_operand:DI 1 "nonimmediate_operand" "%0") (match_operand:DI 2 "general_operand" "do") ) ) (clobber (reg:CC CC_REGNUM))] @@ -3704,7 +4086,7 @@ operands[8] = operand_subword (operands[2], 1, 0, DImode);") (define_insn_and_split "*adddi3_31" - [(set (match_operand:DI 0 "register_operand" "=&d") + [(set (match_operand:DI 0 "nonimmediate_operand" "=&d") (plus:DI (match_operand:DI 1 "nonimmediate_operand" "%0") (match_operand:DI 2 "general_operand" "do") ) ) (clobber (reg:CC CC_REGNUM))] @@ -3741,7 +4123,7 @@ (define_expand "addsi3" [(parallel - [(set (match_operand:SI 0 "register_operand" "") + [(set (match_operand:SI 0 "nonimmediate_operand" "") (plus:SI (match_operand:SI 1 "nonimmediate_operand" "") (match_operand:SI 2 "general_operand" ""))) (clobber (reg:CC CC_REGNUM))])] @@ -3763,11 +4145,11 @@ ; add(di|si)3 instruction pattern(s). ; -; ar, ahi, alfi, slfi, a, ay, agr, aghi, algfi, slgfi, ag +; ar, ahi, alfi, slfi, a, ay, agr, aghi, algfi, slgfi, ag, asi, agsi (define_insn "*add<mode>3" - [(set (match_operand:GPR 0 "register_operand" "=d,d,d,d,d,d") - (plus:GPR (match_operand:GPR 1 "nonimmediate_operand" "%0,0,0,0,0,0") - (match_operand:GPR 2 "general_operand" "d,K,Op,On,R,T") ) ) + [(set (match_operand:GPR 0 "nonimmediate_operand" "=d,d,d,d,d,d,QS") + (plus:GPR (match_operand:GPR 1 "nonimmediate_operand" "%0,0,0,0,0,0,0") + (match_operand:GPR 2 "general_operand" "d,K,Op,On,R,T,C") ) ) (clobber (reg:CC CC_REGNUM))] "" "@ @@ -3776,16 +4158,18 @@ al<g>fi\t%0,%2 sl<g>fi\t%0,%n2 a<g>\t%0,%2 - a<y>\t%0,%2" - [(set_attr "op_type" "RR<E>,RI,RIL,RIL,RX<Y>,RXY")]) + a<y>\t%0,%2 + a<g>si\t%0,%c2" + [(set_attr "op_type" "RR<E>,RI,RIL,RIL,RX<Y>,RXY,SIY") + (set_attr "cpu_facility" "*,*,extimm,extimm,*,*,z10")]) -; alr, alfi, slfi, al, aly, algr, algfi, slgfi, alg +; alr, alfi, slfi, al, aly, algr, algfi, slgfi, alg, alsi, algsi (define_insn "*add<mode>3_carry1_cc" [(set (reg CC_REGNUM) - (compare (plus:GPR (match_operand:GPR 1 "nonimmediate_operand" "%0,0,0,0,0") - (match_operand:GPR 2 "general_operand" "d,Op,On,R,T")) + (compare (plus:GPR (match_operand:GPR 1 "nonimmediate_operand" "%0,0,0,0,0,0") + (match_operand:GPR 2 "general_operand" "d,Op,On,R,T,C")) (match_dup 1))) - (set (match_operand:GPR 0 "register_operand" "=d,d,d,d,d") + (set (match_operand:GPR 0 "nonimmediate_operand" "=d,d,d,d,d,d") (plus:GPR (match_dup 1) (match_dup 2)))] "s390_match_ccmode (insn, CCL1mode)" "@ @@ -3793,8 +4177,10 @@ al<g>fi\t%0,%2 sl<g>fi\t%0,%n2 al<g>\t%0,%2 - al<y>\t%0,%2" - [(set_attr "op_type" "RR<E>,RIL,RIL,RX<Y>,RXY")]) + al<y>\t%0,%2 + al<g>si\t%0,%c2" + [(set_attr "op_type" "RR<E>,RIL,RIL,RX<Y>,RXY,SIY") + (set_attr "cpu_facility" "*,extimm,extimm,*,*,z10")]) ; alr, al, aly, algr, alg (define_insn "*add<mode>3_carry1_cconly" @@ -3810,13 +4196,13 @@ al<y>\t%0,%2" [(set_attr "op_type" "RR<E>,RX<Y>,RXY")]) -; alr, alfi, slfi, al, aly, algr, algfi, slgfi, alg +; alr, alfi, slfi, al, aly, algr, algfi, slgfi, alg, alsi, algsi (define_insn "*add<mode>3_carry2_cc" [(set (reg CC_REGNUM) - (compare (plus:GPR (match_operand:GPR 1 "nonimmediate_operand" "%0,0,0,0,0") - (match_operand:GPR 2 "general_operand" "d,Op,On,R,T")) + (compare (plus:GPR (match_operand:GPR 1 "nonimmediate_operand" "%0,0,0,0,0,0") + (match_operand:GPR 2 "general_operand" "d,Op,On,R,T,C")) (match_dup 2))) - (set (match_operand:GPR 0 "register_operand" "=d,d,d,d,d") + (set (match_operand:GPR 0 "nonimmediate_operand" "=d,d,d,d,d,RS") (plus:GPR (match_dup 1) (match_dup 2)))] "s390_match_ccmode (insn, CCL1mode)" "@ @@ -3824,8 +4210,10 @@ al<g>fi\t%0,%2 sl<g>fi\t%0,%n2 al<g>\t%0,%2 - al<y>\t%0,%2" - [(set_attr "op_type" "RR<E>,RIL,RIL,RX<Y>,RXY")]) + al<y>\t%0,%2 + al<g>si\t%0,%c2" + [(set_attr "op_type" "RR<E>,RIL,RIL,RX<Y>,RXY,SIY") + (set_attr "cpu_facility" "*,extimm,extimm,*,*,z10")]) ; alr, al, aly, algr, alg (define_insn "*add<mode>3_carry2_cconly" @@ -3841,13 +4229,13 @@ al<y>\t%0,%2" [(set_attr "op_type" "RR<E>,RX<Y>,RXY")]) -; alr, alfi, slfi, al, aly, algr, algfi, slgfi, alg +; alr, alfi, slfi, al, aly, algr, algfi, slgfi, alg, alsi, algsi (define_insn "*add<mode>3_cc" [(set (reg CC_REGNUM) - (compare (plus:GPR (match_operand:GPR 1 "nonimmediate_operand" "%0,0,0,0,0") - (match_operand:GPR 2 "general_operand" "d,Op,On,R,T")) + (compare (plus:GPR (match_operand:GPR 1 "nonimmediate_operand" "%0,0,0,0,0,0") + (match_operand:GPR 2 "general_operand" "d,Op,On,R,T,C")) (const_int 0))) - (set (match_operand:GPR 0 "register_operand" "=d,d,d,d,d") + (set (match_operand:GPR 0 "nonimmediate_operand" "=d,d,d,d,d,RS") (plus:GPR (match_dup 1) (match_dup 2)))] "s390_match_ccmode (insn, CCLmode)" "@ @@ -3855,8 +4243,10 @@ al<g>fi\t%0,%2 sl<g>fi\t%0,%n2 al<g>\t%0,%2 - al<y>\t%0,%2" - [(set_attr "op_type" "RR<E>,RIL,RIL,RX<Y>,RXY")]) + al<y>\t%0,%2 + al<g>si\t%0,%c2" + [(set_attr "op_type" "RR<E>,RIL,RIL,RX<Y>,RXY,SIY") + (set_attr "cpu_facility" "*,extimm,extimm,*,*,z10")]) ; alr, al, aly, algr, alg (define_insn "*add<mode>3_cconly" @@ -3885,22 +4275,25 @@ al<y>\t%0,%2" [(set_attr "op_type" "RR<E>,RX<Y>,RXY")]) -; ahi, afi, aghi, agfi +; ahi, afi, aghi, agfi, asi, agsi (define_insn "*add<mode>3_imm_cc" [(set (reg CC_REGNUM) - (compare (plus:GPR (match_operand:GPR 1 "nonimmediate_operand" "0,0") - (match_operand:GPR 2 "const_int_operand" "K,Os")) + (compare (plus:GPR (match_operand:GPR 1 "nonimmediate_operand" "0,0,0") + (match_operand:GPR 2 "const_int_operand" "K,Os,C")) (const_int 0))) - (set (match_operand:GPR 0 "register_operand" "=d,d") + (set (match_operand:GPR 0 "nonimmediate_operand" "=d,d,QS") (plus:GPR (match_dup 1) (match_dup 2)))] "s390_match_ccmode (insn, CCAmode) && (CONST_OK_FOR_CONSTRAINT_P (INTVAL (operands[2]), 'K', \"K\") - || CONST_OK_FOR_CONSTRAINT_P (INTVAL (operands[2]), 'O', \"Os\")) + || CONST_OK_FOR_CONSTRAINT_P (INTVAL (operands[2]), 'O', \"Os\") + || CONST_OK_FOR_CONSTRAINT_P (INTVAL (operands[2]), 'C', \"C\")) && INTVAL (operands[2]) != -((HOST_WIDE_INT)1 << (GET_MODE_BITSIZE(<MODE>mode) - 1))" "@ a<g>hi\t%0,%h2 - a<g>fi\t%0,%2" - [(set_attr "op_type" "RI,RIL")]) + a<g>fi\t%0,%2 + a<g>si\t%0,%c2" + [(set_attr "op_type" "RI,RIL,SIY") + (set_attr "cpu_facility" "*,extimm,z10")]) ; ; add(tf|df|sf|td|dd)3 instruction pattern(s). @@ -4499,69 +4892,78 @@ (define_insn "*muldi3_sign" [(set (match_operand:DI 0 "register_operand" "=d,d") - (mult:DI (sign_extend:DI (match_operand:SI 2 "nonimmediate_operand" "d,RT")) + (mult:DI (sign_extend:DI (match_operand:SI 2 "general_operand" "d,RT")) (match_operand:DI 1 "register_operand" "0,0")))] "TARGET_64BIT" "@ msgfr\t%0,%2 msgf\t%0,%2" - [(set_attr "op_type" "RRE,RXY") - (set_attr "type" "imuldi")]) + [(set_attr "op_type" "RRE,RXY") + (set_attr "type" "imuldi")]) (define_insn "muldi3" - [(set (match_operand:DI 0 "register_operand" "=d,d,d") - (mult:DI (match_operand:DI 1 "nonimmediate_operand" "%0,0,0") - (match_operand:DI 2 "general_operand" "d,K,RT")))] + [(set (match_operand:DI 0 "register_operand" "=d,d,d,d") + (mult:DI (match_operand:DI 1 "nonimmediate_operand" "%0,0,0,0") + (match_operand:DI 2 "general_operand" "d,K,RT,Os")))] "TARGET_64BIT" "@ msgr\t%0,%2 mghi\t%0,%h2 - msg\t%0,%2" - [(set_attr "op_type" "RRE,RI,RXY") - (set_attr "type" "imuldi")]) + msg\t%0,%2 + msgfi\t%0,%2" + [(set_attr "op_type" "RRE,RI,RXY,RIL") + (set_attr "type" "imuldi") + (set_attr "cpu_facility" "*,*,*,z10")]) ; ; mulsi3 instruction pattern(s). ; (define_insn "*mulsi3_sign" - [(set (match_operand:SI 0 "register_operand" "=d") - (mult:SI (sign_extend:SI (match_operand:HI 2 "memory_operand" "R")) - (match_operand:SI 1 "register_operand" "0")))] + [(set (match_operand:SI 0 "register_operand" "=d,d") + (mult:SI (sign_extend:SI (match_operand:HI 2 "memory_operand" "R,T")) + (match_operand:SI 1 "register_operand" "0,0")))] "" - "mh\t%0,%2" - [(set_attr "op_type" "RX") - (set_attr "type" "imulhi")]) + "@ + mh\t%0,%2 + mhy\t%0,%2" + [(set_attr "op_type" "RX,RXY") + (set_attr "type" "imulhi") + (set_attr "cpu_facility" "*,z10")]) (define_insn "mulsi3" - [(set (match_operand:SI 0 "register_operand" "=d,d,d,d") - (mult:SI (match_operand:SI 1 "nonimmediate_operand" "%0,0,0,0") - (match_operand:SI 2 "general_operand" "d,K,R,T")))] + [(set (match_operand:SI 0 "register_operand" "=d,d,d,d,d") + (mult:SI (match_operand:SI 1 "nonimmediate_operand" "%0,0,0,0,0") + (match_operand:SI 2 "general_operand" "d,K,R,T,Os")))] "" "@ msr\t%0,%2 mhi\t%0,%h2 ms\t%0,%2 - msy\t%0,%2" - [(set_attr "op_type" "RRE,RI,RX,RXY") - (set_attr "type" "imulsi,imulhi,imulsi,imulsi")]) + msy\t%0,%2 + msfi\t%0,%2" + [(set_attr "op_type" "RRE,RI,RX,RXY,RIL") + (set_attr "type" "imulsi,imulhi,imulsi,imulsi,imulsi") + (set_attr "cpu_facility" "*,*,*,*,z10")]) ; ; mulsidi3 instruction pattern(s). ; (define_insn "mulsidi3" - [(set (match_operand:DI 0 "register_operand" "=d,d") + [(set (match_operand:DI 0 "register_operand" "=d,d,d") (mult:DI (sign_extend:DI - (match_operand:SI 1 "register_operand" "%0,0")) + (match_operand:SI 1 "register_operand" "%0,0,0")) (sign_extend:DI - (match_operand:SI 2 "nonimmediate_operand" "d,R"))))] + (match_operand:SI 2 "nonimmediate_operand" "d,R,T"))))] "!TARGET_64BIT" "@ mr\t%0,%2 - m\t%0,%2" - [(set_attr "op_type" "RR,RX") - (set_attr "type" "imulsi")]) + m\t%0,%2 + mfy\t%0,%2" + [(set_attr "op_type" "RR,RX,RXY") + (set_attr "type" "imulsi") + (set_attr "cpu_facility" "*,*,z10")]) ; ; umulsidi3 instruction pattern(s). @@ -4714,7 +5116,7 @@ gen_rtx_ZERO_EXTEND (TImode, div_equal)); operands[4] = gen_reg_rtx(TImode); - emit_insn (gen_rtx_CLOBBER (VOIDmode, operands[4])); + emit_clobber (operands[4]); emit_move_insn (gen_lowpart (DImode, operands[4]), operands[1]); emit_move_insn (gen_highpart (DImode, operands[4]), const0_rtx); @@ -4832,7 +5234,7 @@ gen_rtx_ZERO_EXTEND (DImode, div_equal)); operands[4] = gen_reg_rtx(DImode); - emit_insn (gen_rtx_CLOBBER (VOIDmode, operands[4])); + emit_clobber (operands[4]); emit_move_insn (gen_lowpart (SImode, operands[4]), operands[1]); emit_move_insn (gen_highpart (SImode, operands[4]), const0_rtx); @@ -6758,6 +7160,32 @@ [(set_attr "op_type" "RI") (set_attr "type" "branch")]) +; crt, cgrt, cit, cgit +(define_insn "*cmp_and_trap_signed_int<mode>" + [(trap_if (match_operator 0 "s390_signed_integer_comparison" + [(match_operand:GPR 1 "register_operand" "d,d") + (match_operand:GPR 2 "nonmemory_operand" "d,K")]) + (const_int 0))] + "TARGET_Z10" + "@ + c<g>rt%C0\t%1,%2 + c<g>it%C0\t%1,%h2" + [(set_attr "op_type" "RRF,RIE") + (set_attr "type" "branch")]) + +; clrt, clgrt, clfit, clgit +(define_insn "*cmp_and_trap_unsigned_int<mode>" + [(trap_if (match_operator 0 "s390_unsigned_integer_comparison" + [(match_operand:GPR 1 "register_operand" "d,d") + (match_operand:GPR 2 "nonmemory_operand" "d,D")]) + (const_int 0))] + "TARGET_Z10" + "@ + cl<g>rt%C0\t%1,%2 + cl<gf>it%C0\t%1,%x2" + [(set_attr "op_type" "RRF,RIE") + (set_attr "type" "branch")]) + ;; ;;- Loop instructions. ;; @@ -7576,7 +8004,7 @@ "flag_pic" { emit_insn (s390_load_got ()); - emit_insn (gen_rtx_USE (VOIDmode, pic_offset_table_rtx)); + emit_use (pic_offset_table_rtx); DONE; }) @@ -7659,7 +8087,7 @@ if (temp) emit_move_insn (s390_back_chain_rtx (), temp); - emit_insn (gen_rtx_USE (VOIDmode, base)); + emit_use (base); DONE; }) @@ -7904,3 +8332,30 @@ "" "" [(set_attr "length" "0")]) + + +; +; Data prefetch patterns +; + +(define_insn "prefetch" + [(prefetch (match_operand 0 "address_operand" "UW,X") + (match_operand:SI 1 "const_int_operand" "n,n") + (match_operand:SI 2 "const_int_operand" "n,n"))] + "TARGET_Z10" +{ + if (larl_operand (operands[0], Pmode)) + return INTVAL (operands[1]) == 1 ? "pfdrl\t2,%a0" : "pfdrl\t1,%a0"; + + if (s390_mem_constraint ("W", operands[0]) + || s390_mem_constraint ("U", operands[0])) + return INTVAL (operands[1]) == 1 ? "pfd\t2,%a0" : "pfd\t1,%a0"; + + /* This point might be reached if op0 is a larl operand with an + uneven addend. In this case we simply omit issuing a prefetch + instruction. */ + + return ""; + +} [(set_attr "type" "load,larl") + (set_attr "op_type" "RXY,RIL")]) diff --git a/gcc/config/sh/sh.c b/gcc/config/sh/sh.c index 3af0ee8cff1..71419ec61de 100644 --- a/gcc/config/sh/sh.c +++ b/gcc/config/sh/sh.c @@ -1371,8 +1371,7 @@ prepare_move_operands (rtx operands[], enum machine_mode mode) if (flag_schedule_insns) emit_insn (gen_blockage ()); emit_insn (gen_GOTaddr2picreg ()); - emit_insn (gen_rtx_USE (VOIDmode, gen_rtx_REG (SImode, - PIC_REG))); + emit_use (gen_rtx_REG (SImode, PIC_REG)); if (flag_schedule_insns) emit_insn (gen_blockage ()); } @@ -5723,8 +5722,8 @@ output_stack_adjust (int size, rtx reg, int epilogue_p, mem = gen_tmp_stack_mem (Pmode, gen_rtx_POST_INC (Pmode, reg)); emit_move_insn (tmp_reg, mem); /* Tell flow the insns that pop r4/r5 aren't dead. */ - emit_insn (gen_rtx_USE (VOIDmode, tmp_reg)); - emit_insn (gen_rtx_USE (VOIDmode, adj_reg)); + emit_use (tmp_reg); + emit_use (adj_reg); return; } const_reg = gen_rtx_REG (GET_MODE (reg), temp); @@ -6862,7 +6861,7 @@ sh_expand_epilogue (bool sibcall_p) USE PR_MEDIA_REG, since it will be explicitly copied to TR0_REG by the return pattern. */ if (TEST_HARD_REG_BIT (live_regs_mask, PR_REG)) - emit_insn (gen_rtx_USE (VOIDmode, gen_rtx_REG (SImode, PR_REG))); + emit_use (gen_rtx_REG (SImode, PR_REG)); } static int sh_need_epilogue_known = 0; @@ -6916,7 +6915,7 @@ sh_set_return_address (rtx ra, rtx tmp) emit_insn (GEN_MOV (rr, ra)); /* Tell flow the register for return isn't dead. */ - emit_insn (gen_rtx_USE (VOIDmode, rr)); + emit_use (rr); return; } @@ -10714,7 +10713,7 @@ sh_expand_t_scc (enum rtx_code code, rtx target) emit_insn (gen_movrt (result)); else if ((code == EQ && val == 0) || (code == NE && val == 1)) { - emit_insn (gen_rtx_CLOBBER (VOIDmode, result)); + emit_clobber (result); emit_insn (gen_subc (result, result, result)); emit_insn (gen_addsi3 (result, result, const1_rtx)); } diff --git a/gcc/config/sparc/sparc.c b/gcc/config/sparc/sparc.c index c1cc725334c..009ab3a2bcf 100644 --- a/gcc/config/sparc/sparc.c +++ b/gcc/config/sparc/sparc.c @@ -3427,7 +3427,7 @@ load_pic_register (bool delay_pic_helper) if (TARGET_VXWORKS_RTP) { emit_insn (gen_vxworks_load_got ()); - emit_insn (gen_rtx_USE (VOIDmode, pic_offset_table_rtx)); + emit_use (pic_offset_table_rtx); return; } @@ -3457,7 +3457,7 @@ load_pic_register (bool delay_pic_helper) since setjmp/longjmp can cause life info to screw up. ??? In the case where we don't obey regdecls, this is not sufficient since we may not fall out the bottom. */ - emit_insn (gen_rtx_USE (VOIDmode, pic_offset_table_rtx)); + emit_use (pic_offset_table_rtx); } /* Emit a call instruction with the pattern given by PAT. ADDR is the diff --git a/gcc/config/sparc/sparc.md b/gcc/config/sparc/sparc.md index c02c7094df2..bc29bcf819c 100644 --- a/gcc/config/sparc/sparc.md +++ b/gcc/config/sparc/sparc.md @@ -7104,8 +7104,8 @@ adjust_address (result, TARGET_ARCH64 ? TFmode : DFmode, 8)); /* Put USE insns before the return. */ - emit_insn (gen_rtx_USE (VOIDmode, valreg1)); - emit_insn (gen_rtx_USE (VOIDmode, valreg2)); + emit_use (valreg1); + emit_use (valreg2); /* Construct the return. */ expand_naked_return (); @@ -7191,8 +7191,8 @@ and reload the appropriate value into %fp. */ emit_move_insn (hard_frame_pointer_rtx, stack); - emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx)); - emit_insn (gen_rtx_USE (VOIDmode, static_chain_rtx)); + emit_use (stack_pointer_rtx); + emit_use (static_chain_rtx); /* ??? The V9-specific version was disabled in rev 1.65. */ emit_jump_insn (gen_goto_handler_and_restore (labreg)); diff --git a/gcc/config/spu/spu.c b/gcc/config/spu/spu.c index de307ab32ed..b944a00e5bf 100644 --- a/gcc/config/spu/spu.c +++ b/gcc/config/spu/spu.c @@ -1906,8 +1906,7 @@ spu_expand_epilogue (bool sibcall_p) if (!sibcall_p) { - emit_insn (gen_rtx_USE - (VOIDmode, gen_rtx_REG (SImode, LINK_REGISTER_REGNUM))); + emit_use (gen_rtx_REG (SImode, LINK_REGISTER_REGNUM)); jump = emit_jump_insn (gen__return ()); emit_barrier_after (jump); } diff --git a/gcc/config/t-darwin b/gcc/config/t-darwin index d43ce5068a7..b1ba53c4774 100644 --- a/gcc/config/t-darwin +++ b/gcc/config/t-darwin @@ -10,6 +10,10 @@ darwin-c.o: $(srcdir)/config/darwin-c.c $(CONFIG_H) $(SYSTEM_H) coretypes.h \ incpath.h flags.h $(C_COMMON_H) $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $(srcdir)/config/darwin-c.c $(PREPROCESSOR_DEFINES) +darwin-f.o: $(srcdir)/config/darwin-f.c $(CONFIG_H) $(SYSTEM_H) coretypes.h + $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ + $(srcdir)/config/darwin-f.c $(PREPROCESSOR_DEFINES) + gt-darwin.h : s-gtype ; @true darwin-driver.o: $(srcdir)/config/darwin-driver.c \ diff --git a/gcc/config/v850/v850.c b/gcc/config/v850/v850.c index 2a0f3093641..b9f11b1583f 100644 --- a/gcc/config/v850/v850.c +++ b/gcc/config/v850/v850.c @@ -1909,7 +1909,7 @@ Saved %d bytes via epilogue function (%d vs. %d) in function %s\n", plus_constant (stack_pointer_rtx, offset))); - emit_insn (gen_rtx_USE (VOIDmode, restore_regs[i])); + emit_use (restore_regs[i]); offset -= 4; } diff --git a/gcc/configure b/gcc/configure index b2ab9a71988..e2888090372 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 loose_warn cxx_compat_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 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 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 loose_warn cxx_compat_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 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' # Initialize some variables set by options. @@ -868,13 +868,13 @@ echo X"$0" | /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` srcdir=$ac_confdir - if test ! -r $srcdir/$ac_unique_file; then + if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi -if test ! -r $srcdir/$ac_unique_file; then +if test ! -r "$srcdir/$ac_unique_file"; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } @@ -883,7 +883,7 @@ if test ! -r $srcdir/$ac_unique_file; then { (exit 1); exit 1; }; } fi fi -(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || +(cd $srcdir && test -r "./$ac_unique_file") 2>/dev/null || { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 { (exit 1); exit 1; }; } srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` @@ -14663,13 +14663,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:14657: $ac_compile\"" >&5) + (eval echo "\"\$as_me:14666: $ac_compile\"" >&5) (eval "$ac_compile" 2>conftest.err) cat conftest.err >&5 - (eval echo "\"\$as_me:14660: $NM \\\"conftest.$ac_objext\\\"\"" >&5) + (eval echo "\"\$as_me:14669: $NM \\\"conftest.$ac_objext\\\"\"" >&5) (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) cat conftest.err >&5 - (eval echo "\"\$as_me:14663: output\"" >&5) + (eval echo "\"\$as_me:14672: output\"" >&5) cat conftest.out >&5 if $GREP 'External.*some_variable' conftest.out > /dev/null; then lt_cv_nm_interface="MS dumpbin" @@ -15724,7 +15724,7 @@ ia64-*-hpux*) ;; *-*-irix6*) # Find out which ABI we are using. - echo '#line 15718 "configure"' > conftest.$ac_ext + echo '#line 15727 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? @@ -16344,11 +16344,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:16338: $lt_compile\"" >&5) + (eval echo "\"\$as_me:16347: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:16342: \$? = $ac_status" >&5 + echo "$as_me:16351: \$? = $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. @@ -16666,11 +16666,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:16660: $lt_compile\"" >&5) + (eval echo "\"\$as_me:16669: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:16664: \$? = $ac_status" >&5 + echo "$as_me:16673: \$? = $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. @@ -16771,11 +16771,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:16765: $lt_compile\"" >&5) + (eval echo "\"\$as_me:16774: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 - echo "$as_me:16769: \$? = $ac_status" >&5 + echo "$as_me:16778: \$? = $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 @@ -16826,11 +16826,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:16820: $lt_compile\"" >&5) + (eval echo "\"\$as_me:16829: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 - echo "$as_me:16824: \$? = $ac_status" >&5 + echo "$as_me:16833: \$? = $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 @@ -19623,7 +19623,7 @@ else lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF -#line 19617 "configure" +#line 19626 "configure" #include "confdefs.h" #if HAVE_DLFCN_H @@ -19723,7 +19723,7 @@ else lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF -#line 19717 "configure" +#line 19726 "configure" #include "confdefs.h" #if HAVE_DLFCN_H @@ -23795,6 +23795,7 @@ fi; + # Echo link setup. if test x${build} = x${host} ; then if test x${host} = x${target} ; then @@ -24641,6 +24642,7 @@ s,@xm_include_list@,$xm_include_list,;t t s,@xm_defines@,$xm_defines,;t t s,@c_target_objs@,$c_target_objs,;t t s,@cxx_target_objs@,$cxx_target_objs,;t t +s,@fortran_target_objs@,$fortran_target_objs,;t t s,@target_cpu_default@,$target_cpu_default,;t t s,@GMPLIBS@,$GMPLIBS,;t t s,@GMPINC@,$GMPINC,;t t diff --git a/gcc/configure.ac b/gcc/configure.ac index 3ac7ff53d86..6bbe29da71d 100644 --- a/gcc/configure.ac +++ b/gcc/configure.ac @@ -1078,7 +1078,7 @@ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/resource.h> #endif ]], [[rlim_t l = 0;]])],[],[AC_DEFINE([rlim_t],[long], -[Define to \`long' if <sys/resource.h> doesn't define.])]) +[Define to `long' if <sys/resource.h> doesn't define.])]) # On AIX 5.2, <ldfcn.h> conflicts with <fcntl.h>, as both define incompatible # FREAD and FWRITE macros. Fortunately, for GCC's single usage of ldgetname @@ -3803,6 +3803,7 @@ AC_SUBST(xm_include_list) AC_SUBST(xm_defines) AC_SUBST(c_target_objs) AC_SUBST(cxx_target_objs) +AC_SUBST(fortran_target_objs) AC_SUBST(target_cpu_default) AC_SUBST_FILE(language_hooks) diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 3c54503608b..54afddc9851 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,28 @@ +2008-06-02 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/36404 + * pt.c (push_template_decl_real): Consistently return error_mark_node + on error. + +2008-06-02 Tomas Bily <tbily@suse.cz> + + * typeck.c (is_bitfield_expr_with_lowered_type): Use CASE_CONVERT. + (cp_build_unary_op): Likewise. + (cp_build_indirect_ref): Use CONVERT_EXPR_P. + (maybe_warn_about_returning_address_of_local): Likewise. + +2008-05-29 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/35243 + * pt.c (tsubst_initializer_list): Consistently check the tree + returned by tsubst_pack_expansion for error_mark_node. + +2008-05-27 Michael Matz <matz@suse.de> + + PR c++/27975 + * call.c (build_new_op): Make warning conditional on + OPT_Wenum_compare. + 2008-05-27 Alexandre Oliva <aoliva@redhat.com> PR c++/35909 diff --git a/gcc/cp/call.c b/gcc/cp/call.c index b4127988083..1d54e7cb43e 100644 --- a/gcc/cp/call.c +++ b/gcc/cp/call.c @@ -4004,7 +4004,8 @@ build_new_op (enum tree_code code, int flags, tree arg1, tree arg2, tree arg3, != TYPE_MAIN_VARIANT (TREE_TYPE (arg2))) && (complain & tf_warning)) { - warning (0, "comparison between %q#T and %q#T", + warning (OPT_Wenum_compare, + "comparison between %q#T and %q#T", TREE_TYPE (arg1), TREE_TYPE (arg2)); } break; diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c index 3d4d41f2cc3..f141b74a6fd 100644 --- a/gcc/cp/pt.c +++ b/gcc/cp/pt.c @@ -3791,7 +3791,10 @@ push_template_decl_real (tree decl, bool is_friend) member_template_p = true; if (TREE_CODE (decl) == TYPE_DECL && ANON_AGGRNAME_P (DECL_NAME (decl))) - error ("template class without a name"); + { + error ("template class without a name"); + return error_mark_node; + } else if (TREE_CODE (decl) == FUNCTION_DECL) { if (DECL_DESTRUCTOR_P (decl)) @@ -15500,6 +15503,8 @@ tsubst_initializer_list (tree t, tree argvec) = tsubst_pack_expansion (expr, argvec, tf_warning_or_error, NULL_TREE); + if (expanded_exprs == error_mark_node) + continue; /* Prepend each of the expanded expressions to the corresponding TREE_LIST in EXPANDED_ARGUMENTS. */ diff --git a/gcc/cp/typeck.c b/gcc/cp/typeck.c index bf264ad2cc7..026e4469b7d 100644 --- a/gcc/cp/typeck.c +++ b/gcc/cp/typeck.c @@ -1515,8 +1515,7 @@ is_bitfield_expr_with_lowered_type (const_tree exp) return DECL_BIT_FIELD_TYPE (field); } - case NOP_EXPR: - case CONVERT_EXPR: + CASE_CONVERT: if (TYPE_MAIN_VARIANT (TREE_TYPE (TREE_OPERAND (exp, 0))) == TYPE_MAIN_VARIANT (TREE_TYPE (exp))) return is_bitfield_expr_with_lowered_type (TREE_OPERAND (exp, 0)); @@ -2449,8 +2448,7 @@ cp_build_indirect_ref (tree ptr, const char *errorstring, types. */ tree t = canonical_type_variant (TREE_TYPE (type)); - if (TREE_CODE (ptr) == CONVERT_EXPR - || TREE_CODE (ptr) == NOP_EXPR + if (CONVERT_EXPR_P (ptr) || TREE_CODE (ptr) == VIEW_CONVERT_EXPR) { /* If a warning is issued, mark it to avoid duplicates from @@ -4658,8 +4656,7 @@ cp_build_unary_op (enum tree_code code, tree xarg, int noconvert, switch (TREE_CODE (arg)) { - case NOP_EXPR: - case CONVERT_EXPR: + CASE_CONVERT: case FLOAT_EXPR: case FIX_TRUNC_EXPR: /* Even if we're not being pedantic, we cannot allow this @@ -6854,9 +6851,8 @@ maybe_warn_about_returning_address_of_local (tree retval) { if (TREE_CODE (whats_returned) == COMPOUND_EXPR) whats_returned = TREE_OPERAND (whats_returned, 1); - else if (TREE_CODE (whats_returned) == CONVERT_EXPR - || TREE_CODE (whats_returned) == NON_LVALUE_EXPR - || TREE_CODE (whats_returned) == NOP_EXPR) + else if (CONVERT_EXPR_P (whats_returned) + || TREE_CODE (whats_returned) == NON_LVALUE_EXPR) whats_returned = TREE_OPERAND (whats_returned, 0); else break; diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi index 103af2c4c51..86d15743b26 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -2508,6 +2508,19 @@ instruction). Caveat: such addressing is by definition not position independent and hence this attribute must not be used for objects defined by shared libraries. +@item ms_abi/sysv_abi +@cindex @code{ms_abi} attribute +@cindex @code{sysv_abi} attribute + +On 64-bit x86_65-*-* targets, you can use an ABI attribute to indicate +which calling convention should be used for a function. The @code{ms_abi} +attribute tells the compiler to use the Microsoft ABI, while the +@code{sysv_abi} attribute tells the compiler to use the ABI used on +GNU/Linux and other systems. The default is to use the Microsoft ABI +when targeting Windows. On all other systems, the default is the AMD ABI. + +Note, This feature is currently sorried out for Windows targets trying to + @item naked @cindex function without a prologue/epilogue code Use this attribute on the ARM, AVR, IP2K and SPU ports to indicate that diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index e3678177a80..6dbd19ea2f9 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -232,7 +232,7 @@ Objective-C and Objective-C++ Dialects}. -Wchar-subscripts -Wclobbered -Wcomment @gol -Wconversion -Wcoverage-mismatch -Wno-deprecated @gol -Wno-deprecated-declarations -Wdisabled-optimization -Wno-div-by-zero @gol --Wempty-body -Wno-endif-labels @gol +-Wempty-body -Wenum-compare -Wno-endif-labels @gol -Werror -Werror=* @gol -Wfatal-errors -Wfloat-equal -Wformat -Wformat=2 @gol -Wno-format-contains-nul -Wno-format-extra-args -Wformat-nonliteral @gol @@ -3658,6 +3658,11 @@ while} statement. Additionally, in C++, warn when an empty body occurs in a @samp{while} or @samp{for} statement with no whitespacing before the semicolon. This warning is also enabled by @option{-Wextra}. +@item -Wenum-compare @r{(C++ and Objective-C++ only)} +@opindex Wenum-compare +@opindex Wno-enum-compare +Warn about a comparison between values of different enum types. + @item -Wsign-compare @opindex Wsign-compare @opindex Wno-sign-compare @@ -11931,6 +11936,7 @@ The processor names are: @samp{24kec}, @samp{24kef2_1}, @samp{24kef1_1}, @samp{34kc}, @samp{34kf2_1}, @samp{34kf1_1}, @samp{74kc}, @samp{74kf2_1}, @samp{74kf1_1}, @samp{74kf3_2}, +@samp{loongson2e}, @samp{loongson2f}, @samp{m4k}, @samp{orion}, @samp{r2000}, @samp{r3000}, @samp{r3900}, @samp{r4000}, @samp{r4400}, diff --git a/gcc/doc/tm.texi b/gcc/doc/tm.texi index 3e4d2b7b5bf..d18bf2e00e9 100644 --- a/gcc/doc/tm.texi +++ b/gcc/doc/tm.texi @@ -4055,6 +4055,15 @@ arguments are passed on the stack, there is no need to store anything in should not be empty, so use @code{int}. @end defmac +@defmac OVERRIDE_ABI_FORMAT (@var{fndecl}) +If defined, this macro is called before generating any code for a +function, but after the @var{cfun} descriptor for the function has been +created. The back end may use this macro to update @var{cfun} to +reflect an ABI other than that which would normally be used by default. +If the compiler is generating code for a compiler-generated function, +@var{fndecl} may be @code{NULL}. +@end defmac + @defmac INIT_CUMULATIVE_ARGS (@var{cum}, @var{fntype}, @var{libname}, @var{fndecl}, @var{n_named_args}) A C statement (sans semicolon) for initializing the variable @var{cum} for the state at the beginning of the argument list. The diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index 145b8fefaef..2113410232c 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -315,6 +315,14 @@ static GTY(()) unsigned fde_table_in_use; fde_table. */ #define FDE_TABLE_INCREMENT 256 +/* Get the current fde_table entry we should use. */ + +static inline dw_fde_ref +current_fde (void) +{ + return fde_table_in_use ? &fde_table[fde_table_in_use - 1] : NULL; +} + /* A list of call frame insns for the CIE. */ static GTY(()) dw_cfi_ref cie_cfi_head; @@ -641,7 +649,9 @@ add_fde_cfi (const char *label, dw_cfi_ref cfi) { if (label) { - dw_fde_ref fde = &fde_table[fde_table_in_use - 1]; + dw_fde_ref fde = current_fde (); + + gcc_assert (fde != NULL); if (*label == 0) label = dwarf2out_cfi_label (); @@ -713,6 +723,7 @@ static void lookup_cfa (dw_cfa_location *loc) { dw_cfi_ref cfi; + dw_fde_ref fde; loc->reg = INVALID_REGNUM; loc->offset = 0; @@ -722,12 +733,10 @@ lookup_cfa (dw_cfa_location *loc) for (cfi = cie_cfi_head; cfi; cfi = cfi->dw_cfi_next) lookup_cfa_1 (cfi, loc); - if (fde_table_in_use) - { - dw_fde_ref fde = &fde_table[fde_table_in_use - 1]; - for (cfi = fde->dw_fde_cfi; cfi; cfi = cfi->dw_cfi_next) - lookup_cfa_1 (cfi, loc); - } + fde = current_fde (); + if (fde) + for (cfi = fde->dw_fde_cfi; cfi; cfi = cfi->dw_cfi_next) + lookup_cfa_1 (cfi, loc); } /* The current rule for calculating the DWARF2 canonical frame address. */ @@ -2686,7 +2695,8 @@ dwarf2out_end_epilogue (unsigned int line ATTRIBUTE_UNUSED, ASM_GENERATE_INTERNAL_LABEL (label, FUNC_END_LABEL, current_function_funcdef_no); ASM_OUTPUT_LABEL (asm_out_file, label); - fde = &fde_table[fde_table_in_use - 1]; + fde = current_fde (); + gcc_assert (fde != NULL); fde->dw_fde_end = xstrdup (label); } @@ -2739,11 +2749,10 @@ dwarf2out_note_section_used (void) void dwarf2out_switch_text_section (void) { - dw_fde_ref fde; + dw_fde_ref fde = current_fde (); - gcc_assert (cfun); + gcc_assert (cfun && fde); - fde = &fde_table[fde_table_in_use - 1]; fde->dw_fde_switched_sections = true; fde->dw_fde_hot_section_label = crtl->subsections.hot_section_label; fde->dw_fde_hot_section_end_label = crtl->subsections.hot_section_end_label; @@ -10985,7 +10994,8 @@ convert_cfa_to_fb_loc_list (HOST_WIDE_INT offset) dw_cfa_location last_cfa, next_cfa; const char *start_label, *last_label, *section; - fde = &fde_table[fde_table_in_use - 1]; + fde = current_fde (); + gcc_assert (fde != NULL); section = secname_for_decl (current_function_decl); list_tail = &list; diff --git a/gcc/emit-rtl.c b/gcc/emit-rtl.c index 45a256347c0..1194ad79b81 100644 --- a/gcc/emit-rtl.c +++ b/gcc/emit-rtl.c @@ -4548,6 +4548,62 @@ emit_note (enum insn_note kind) return note; } +/* Emit a clobber of lvalue X. */ + +rtx +emit_clobber (rtx x) +{ + /* CONCATs should not appear in the insn stream. */ + if (GET_CODE (x) == CONCAT) + { + emit_clobber (XEXP (x, 0)); + return emit_clobber (XEXP (x, 1)); + } + return emit_insn (gen_rtx_CLOBBER (VOIDmode, x)); +} + +/* Return a sequence of insns to clobber lvalue X. */ + +rtx +gen_clobber (rtx x) +{ + rtx seq; + + start_sequence (); + emit_clobber (x); + seq = get_insns (); + end_sequence (); + return seq; +} + +/* Emit a use of rvalue X. */ + +rtx +emit_use (rtx x) +{ + /* CONCATs should not appear in the insn stream. */ + if (GET_CODE (x) == CONCAT) + { + emit_use (XEXP (x, 0)); + return emit_use (XEXP (x, 1)); + } + return emit_insn (gen_rtx_USE (VOIDmode, x)); +} + +/* Return a sequence of insns to use rvalue X. */ + +rtx +gen_use (rtx x) +{ + rtx seq; + + start_sequence (); + emit_use (x); + seq = get_insns (); + end_sequence (); + return seq; +} + /* Cause next statement to emit a line note even if the line number has not changed. */ diff --git a/gcc/exec-tool.in b/gcc/exec-tool.in index 6bdddd1d063..98b4500e75e 100644 --- a/gcc/exec-tool.in +++ b/gcc/exec-tool.in @@ -61,12 +61,11 @@ case "$original" in # libtool has not relinked ld-new yet, but we cannot just use the # previous stage (because then the relinking would just never happen!). # So we take extra care to use prev-ld/ld-new *on recursive calls*. - test -f $lt_prog-recursive && exec $scriptdir/../prev-$dir/$prog ${1+"$@"} + test x"$LT_RCU" = x"1" && exec $scriptdir/../prev-$dir/$prog ${1+"$@"} - touch $lt_prog-recursive + LT_RCU=1; export LT_RCU $scriptdir/../$dir/$prog ${1+"$@"} result=$? - rm -f $lt_prog-recursive exit $result else diff --git a/gcc/explow.c b/gcc/explow.c index d3cc01b9701..d573836d293 100644 --- a/gcc/explow.c +++ b/gcc/explow.c @@ -1016,11 +1016,8 @@ emit_stack_restore (enum save_level save_level, rtx sa, rtx after) /* These clobbers prevent the scheduler from moving references to variable arrays below the code that deletes (pops) the arrays. */ - emit_insn (gen_rtx_CLOBBER (VOIDmode, - gen_rtx_MEM (BLKmode, - gen_rtx_SCRATCH (VOIDmode)))); - emit_insn (gen_rtx_CLOBBER (VOIDmode, - gen_rtx_MEM (BLKmode, stack_pointer_rtx))); + emit_clobber (gen_rtx_MEM (BLKmode, gen_rtx_SCRATCH (VOIDmode))); + emit_clobber (gen_rtx_MEM (BLKmode, stack_pointer_rtx)); } discard_pending_stack_adjust (); diff --git a/gcc/expmed.c b/gcc/expmed.c index ab5057a9e8f..27ff0c063cf 100644 --- a/gcc/expmed.c +++ b/gcc/expmed.c @@ -1374,7 +1374,7 @@ extract_bit_field_1 (rtx str_rtx, unsigned HOST_WIDE_INT bitsize, target = gen_reg_rtx (mode); /* Indicate for flow that the entire target reg is being set. */ - emit_insn (gen_rtx_CLOBBER (VOIDmode, target)); + emit_clobber (target); for (i = 0; i < nwords; i++) { diff --git a/gcc/expr.c b/gcc/expr.c index e2693d84740..d55a2797fb5 100644 --- a/gcc/expr.c +++ b/gcc/expr.c @@ -557,7 +557,7 @@ convert_move (rtx to, rtx from, int unsignedp) { if (reg_overlap_mentioned_p (to, from)) from = force_reg (from_mode, from); - emit_insn (gen_rtx_CLOBBER (VOIDmode, to)); + emit_clobber (to); } convert_move (word_to, from, unsignedp); emit_unop_insn (code, to, word_to, equiv_code); @@ -3108,7 +3108,7 @@ emit_move_complex_parts (rtx x, rtx y) hard regs shouldn't appear here except as return values. */ if (!reload_completed && !reload_in_progress && REG_P (x) && !reg_overlap_mentioned_p (x, y)) - emit_insn (gen_rtx_CLOBBER (VOIDmode, x)); + emit_clobber (x); write_complex_part (x, read_complex_part (y, false), false); write_complex_part (x, read_complex_part (y, true), true); @@ -3305,7 +3305,7 @@ emit_move_multi_word (enum machine_mode mode, rtx x, rtx y) if (x != y && ! (reload_in_progress || reload_completed) && need_clobber != 0) - emit_insn (gen_rtx_CLOBBER (VOIDmode, x)); + emit_clobber (x); emit_insn (seq); @@ -5160,7 +5160,7 @@ store_constructor (tree exp, rtx target, int cleared, HOST_WIDE_INT size) } if (REG_P (target) && !cleared) - emit_insn (gen_rtx_CLOBBER (VOIDmode, target)); + emit_clobber (target); /* Store each element of the constructor into the corresponding field of TARGET. */ @@ -5360,7 +5360,7 @@ store_constructor (tree exp, rtx target, int cleared, HOST_WIDE_INT size) if (!cleared && REG_P (target)) /* Inform later passes that the old value is dead. */ - emit_insn (gen_rtx_CLOBBER (VOIDmode, target)); + emit_clobber (target); /* Store each element of the constructor into the corresponding element of TARGET, determined by counting the diff --git a/gcc/fold-const.c b/gcc/fold-const.c index 25756bbb9c9..609217b755f 100644 --- a/gcc/fold-const.c +++ b/gcc/fold-const.c @@ -7866,7 +7866,10 @@ fold_unary (enum tree_code code, tree type, tree op0) /* Convert (T)(x & c) into (T)x & (T)c, if c is an integer constants (if x has signed type, the sign bit cannot be set - in c). This folds extension into the BIT_AND_EXPR. */ + in c). This folds extension into the BIT_AND_EXPR. + ??? We don't do it for BOOLEAN_TYPE or ENUMERAL_TYPE because they + very likely don't have maximal range for their precision and this + transformation effectively doesn't preserve non-maximal ranges. */ if (TREE_CODE (type) == INTEGER_TYPE && TREE_CODE (op0) == BIT_AND_EXPR && TREE_CODE (TREE_OPERAND (op0, 1)) == INTEGER_CST) @@ -14071,11 +14074,6 @@ tree_single_nonnegative_warnv_p (tree t, bool *strict_overflow_p) switch (TREE_CODE (t)) { - case SSA_NAME: - /* Query VRP to see if it has recorded any information about - the range of this object. */ - return ssa_name_nonnegative_p (t); - case INTEGER_CST: return tree_int_cst_sgn (t) >= 0; @@ -14560,11 +14558,6 @@ tree_single_nonzero_warnv_p (tree t, bool *strict_overflow_p) bool sub_strict_overflow_p; switch (TREE_CODE (t)) { - case SSA_NAME: - /* Query VRP to see if it has recorded any information about - the range of this object. */ - return ssa_name_nonzero_p (t); - case INTEGER_CST: return !integer_zerop (t); diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 073f5428a16..fd0817becbd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,153 @@ +2008-06-02 Janus Weil <janus@gcc.gnu.org> + + PR fortran/36361 + * symbol.c (gfc_add_allocatable,gfc_add_dimension, + gfc_add_explicit_interface): Added checks. + * decl.c (attr_decl1): Added missing "var_locus". + * parse.c (parse_interface): Checking for errors. + +2008-06-02 Daniel Kraft <d@domob.eu> + + * gfortran.h: New statement-type ST_FINAL for FINAL declarations. + (struct gfc_symbol): New member f2k_derived. + (struct gfc_namespace): New member finalizers, for use in the above + mentioned f2k_derived namespace. + (struct gfc_finalizer): New type defined for finalizers linked list. + * match.h (gfc_match_final_decl): New function header. + * decl.c (gfc_match_derived_decl): Create f2k_derived namespace on + constructed symbol node. + (gfc_match_final_decl): New function to match a FINAL declaration line. + * parse.c (decode_statement): match-call for keyword FINAL. + (parse_derived): Parse CONTAINS section and accept FINAL statements. + * resolve.c (gfc_resolve_finalizers): New function to resolve (that is + in this case, check) a list of finalizer procedures. + (resolve_fl_derived): Call gfc_resolve_finalizers here. + * symbol.c (gfc_get_namespace): Initialize new finalizers to NULL. + (gfc_free_namespace): Free finalizers list. + (gfc_new_symbol): Initialize new f2k_derived to NULL. + (gfc_free_symbol): Free f2k_derived namespace. + (gfc_free_finalizer): New function to free a single gfc_finalizer node. + (gfc_free_finalizer_list): New function to free a linked list of + gfc_finalizer nodes. + +2008-06-02 Daniel Franke <franke.daniel@gmail.com> + + PR fortran/36375 + PR fortran/36377 + * cpp.c (gfc_cpp_init): Do not initialize builtins if + processing already preprocessed input. + (gfc_cpp_preprocess): Finalize output with newline. + +2008-05-31 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + * intrinsic.texi: Revert wrong commit. + +2008-05-31 Steven G. Kargl <kargls@comcast.net> + + * arith.c (gfc_arith_init_1): Remove now unused r and c variables. + Cleanup numerical inquiry function initialization. + (gfc_arith_done_1): Replace multiple mpfr_clear() invocations with + a single mpfr_clears(). + (gfc_check_real_range): Re-arrange logic to eliminate multiple + unnecessary branching and assignments. + (gfc_arith_times): Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_arith_divide): Ditto. + (complex_reciprocal): Eliminate now unused variables a, re, im. + Cleanup the mpfr abuse. Use mpfr_clears() in preference to + multiple mpfr_clear(). + (complex_pow): Fix comment whitespace. Use mpfr_clears() in + preference to multiple mpfr_clear(). + * simplify.c (gfc_simplify_and): Remove blank line. + (gfc_simplify_atan2): Move error checking earlier to eliminate + a now unnecessay gfc_free_expr(). + (gfc_simplify_bessel_j0): Remove unnecessary gfc_set_model_kind(). + (gfc_simplify_bessel_j1): Ditto. + (gfc_simplify_bessel_jn): Ditto. + (gfc_simplify_bessel_y0): Ditto. + (gfc_simplify_bessel_y1): Ditto. + (gfc_simplify_bessel_yn): Ditto. + (only_convert_cmplx_boz): Eliminate unnecessary duplicate code, and + combine nested if statement rational expressions. + (gfc_simplify_cos): Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_simplify_exp): Ditto. + (gfc_simplify_fraction): Move gfc_set_model_kind() to after the + special case of 0. Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_simplify_gamma): Eliminate unnecessary gfc_set_model_kind(). + (gfc_simplify_lgamma): Ditto. + (gfc_simplify_log10): Ditto. + (gfc_simplify_log): Move gfc_set_model_kind () inside switch + statement. Use mpfr_clears() in preference to multiple mpfr_clear(). + (gfc_simplify_mod): Eliminate now unused variables quot, iquot, + and term. Simplify the mpfr magic. + (gfc_simplify_modulo): Ditto. + (gfc_simplify_nearest): Eliminate unnecessary gfc_set_model_kind(). + (gfc_simplify_scale): Use mpfr_clears() in preference to multiple + mpfr_clear(). + (gfc_simplify_sin): Ditto + (gfc_simplify_sqrt): Ditto + (gfc_simplify_set_exponent): Move gfc_set_model_kind() to after the + special case of 0. Use mpfr_clears() in preference to multiple + mpfr_clear(). + +2008-05-29 Daniel Franke <franke.daniel@gmail.com> + + PR target/36348 + * Make-lang.in (F95_OBJS): Added dependency on FORTRAN_TARGET_OBJS. + +2008-05-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + * scanner.c (load_line): Add first_char argument. Don't call ungetc. + (gfc_read_orig_filename): Adjust call to load_line. Don't call + ungetc. + (load_file): Adjust call to load_line. + +2008-05-28 Janus Weil <janus@gcc.gnu.org> + + PR fortran/36325 + PR fortran/35830 + * interface.c (gfc_procedure_use): Enable argument checking for + external procedures with explicit interface. + * symbol.c (check_conflict): Fix conflict checking for externals. + (copy_formal_args): Fix handling of arrays. + * resolve.c (resolve_specific_f0, resolve_specific_s0): Fix handling + of intrinsics. + * parse.c (parse_interface): Non-abstract INTERFACE statement implies + EXTERNAL attribute. + +2008-05-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/36319 + * intrinsic.c (gfc_convert_chartype): Don't mark conversion + function as pure. + * trans-array.c (gfc_trans_array_ctor_element): Divide element + size by the size of one character to obtain length. + * iresolve.c (gfc_resolve_cshift): Call the _char4 variant when + appropriate. + (gfc_resolve_eoshift): Likewise. + * trans-intrinsic.c (gfc_conv_intrinsic_ctime): Minor beautification. + (gfc_conv_intrinsic_fdate): Minor beautification. + (gfc_conv_intrinsic_ttynam): Minor beautification. + (gfc_conv_intrinsic_minmax_char): Allow all character kinds. + (size_of_string_in_bytes): New function. + (gfc_conv_intrinsic_size): Call size_of_string_in_bytes for + character expressions. + (gfc_conv_intrinsic_sizeof): Likewise. + (gfc_conv_intrinsic_array_transfer): Likewise. + (gfc_conv_intrinsic_trim): Allow all character kinds. Minor + beautification. + (gfc_conv_intrinsic_repeat): Fix comment typo. + * simplify.c (gfc_convert_char_constant): Take care of conversion + of array constructors. + +2008-05-27 Tobias Burnus <burnus@net-b.de> + + PR fortran/36316 + * trans-array.c (gfc_set_loop_bounds_from_array_spec): + Add missing fold_convert. + 2008-05-26 Daniel Franke <franke.daniel@gmail.com> * fortran/cpp.c (cpp_define_builtins): Remove usage of TARGET_* macros, diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in index dbbed88bd60..6acdbbefd7b 100644 --- a/gcc/fortran/Make-lang.in +++ b/gcc/fortran/Make-lang.in @@ -61,7 +61,7 @@ F95_PARSER_OBJS = fortran/arith.o fortran/array.o fortran/bbt.o \ fortran/resolve.o fortran/scanner.o fortran/simplify.o fortran/st.o \ fortran/symbol.o fortran/target-memory.o -F95_OBJS = $(F95_PARSER_OBJS) \ +F95_OBJS = $(F95_PARSER_OBJS) $(FORTRAN_TARGET_OBJS) \ fortran/convert.o fortran/dependency.o fortran/f95-lang.o \ fortran/trans.o fortran/trans-array.o fortran/trans-common.o \ fortran/trans-const.o fortran/trans-decl.o fortran/trans-expr.o \ diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 6e09f8a3e1e..8e6de3068f0 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -123,24 +123,21 @@ gfc_arith_init_1 (void) { gfc_integer_info *int_info; gfc_real_info *real_info; - mpfr_t a, b, c; - mpz_t r; + mpfr_t a, b; int i; mpfr_set_default_prec (128); mpfr_init (a); - mpz_init (r); /* Convert the minimum and maximum values for each kind into their GNU MP representation. */ for (int_info = gfc_integer_kinds; int_info->kind != 0; int_info++) { /* Huge */ - mpz_set_ui (r, int_info->radix); - mpz_pow_ui (r, r, int_info->digits); - mpz_init (int_info->huge); - mpz_sub_ui (int_info->huge, r, 1); + mpz_set_ui (int_info->huge, int_info->radix); + mpz_pow_ui (int_info->huge, int_info->huge, int_info->digits); + mpz_sub_ui (int_info->huge, int_info->huge, 1); /* These are the numbers that are actually representable by the target. For bases other than two, this needs to be changed. */ @@ -164,8 +161,7 @@ gfc_arith_init_1 (void) mpfr_set_z (a, int_info->huge, GFC_RND_MODE); mpfr_log10 (a, a, GFC_RND_MODE); mpfr_trunc (a, a); - gfc_mpfr_to_mpz (r, a); - int_info->range = mpz_get_si (r); + int_info->range = (int) mpfr_get_si (a, GFC_RND_MODE); } mpfr_clear (a); @@ -176,49 +172,43 @@ gfc_arith_init_1 (void) mpfr_init (a); mpfr_init (b); - mpfr_init (c); /* huge(x) = (1 - b**(-p)) * b**(emax-1) * b */ - /* a = 1 - b**(-p) */ - mpfr_set_ui (a, 1, GFC_RND_MODE); - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, -real_info->digits, GFC_RND_MODE); - mpfr_sub (a, a, b, GFC_RND_MODE); - - /* c = b**(emax-1) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_ui (c, b, real_info->max_exponent - 1, GFC_RND_MODE); + /* 1 - b**(-p) */ + mpfr_init (real_info->huge); + mpfr_set_ui (real_info->huge, 1, GFC_RND_MODE); + mpfr_set_ui (a, real_info->radix, GFC_RND_MODE); + mpfr_pow_si (a, a, -real_info->digits, GFC_RND_MODE); + mpfr_sub (real_info->huge, real_info->huge, a, GFC_RND_MODE); - /* a = a * c = (1 - b**(-p)) * b**(emax-1) */ - mpfr_mul (a, a, c, GFC_RND_MODE); + /* b**(emax-1) */ + mpfr_set_ui (a, real_info->radix, GFC_RND_MODE); + mpfr_pow_ui (a, a, real_info->max_exponent - 1, GFC_RND_MODE); - /* a = (1 - b**(-p)) * b**(emax-1) * b */ - mpfr_mul_ui (a, a, real_info->radix, GFC_RND_MODE); + /* (1 - b**(-p)) * b**(emax-1) */ + mpfr_mul (real_info->huge, real_info->huge, a, GFC_RND_MODE); - mpfr_init (real_info->huge); - mpfr_set (real_info->huge, a, GFC_RND_MODE); + /* (1 - b**(-p)) * b**(emax-1) * b */ + mpfr_mul_ui (real_info->huge, real_info->huge, real_info->radix, + GFC_RND_MODE); /* tiny(x) = b**(emin-1) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, real_info->min_exponent - 1, GFC_RND_MODE); - mpfr_init (real_info->tiny); - mpfr_set (real_info->tiny, b, GFC_RND_MODE); + mpfr_set_ui (real_info->tiny, real_info->radix, GFC_RND_MODE); + mpfr_pow_si (real_info->tiny, real_info->tiny, + real_info->min_exponent - 1, GFC_RND_MODE); /* subnormal (x) = b**(emin - digit) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, real_info->min_exponent - real_info->digits, - GFC_RND_MODE); - mpfr_init (real_info->subnormal); - mpfr_set (real_info->subnormal, b, GFC_RND_MODE); + mpfr_set_ui (real_info->subnormal, real_info->radix, GFC_RND_MODE); + mpfr_pow_si (real_info->subnormal, real_info->subnormal, + real_info->min_exponent - real_info->digits, GFC_RND_MODE); /* epsilon(x) = b**(1-p) */ - mpfr_set_ui (b, real_info->radix, GFC_RND_MODE); - mpfr_pow_si (b, b, 1 - real_info->digits, GFC_RND_MODE); - mpfr_init (real_info->epsilon); - mpfr_set (real_info->epsilon, b, GFC_RND_MODE); + mpfr_set_ui (real_info->epsilon, real_info->radix, GFC_RND_MODE); + mpfr_pow_si (real_info->epsilon, real_info->epsilon, + 1 - real_info->digits, GFC_RND_MODE); /* range(x) = int(min(log10(huge(x)), -log10(tiny)) */ mpfr_log10 (a, real_info->huge, GFC_RND_MODE); @@ -227,31 +217,23 @@ gfc_arith_init_1 (void) /* a = min(a, b) */ mpfr_min (a, a, b, GFC_RND_MODE); - mpfr_trunc (a, a); - gfc_mpfr_to_mpz (r, a); - real_info->range = mpz_get_si (r); + real_info->range = (int) mpfr_get_si (a, GFC_RND_MODE); /* precision(x) = int((p - 1) * log10(b)) + k */ mpfr_set_ui (a, real_info->radix, GFC_RND_MODE); mpfr_log10 (a, a, GFC_RND_MODE); - mpfr_mul_ui (a, a, real_info->digits - 1, GFC_RND_MODE); mpfr_trunc (a, a); - gfc_mpfr_to_mpz (r, a); - real_info->precision = mpz_get_si (r); + real_info->precision = (int) mpfr_get_si (a, GFC_RND_MODE); /* If the radix is an integral power of 10, add one to the precision. */ for (i = 10; i <= real_info->radix; i *= 10) if (i == real_info->radix) real_info->precision++; - mpfr_clear (a); - mpfr_clear (b); - mpfr_clear (c); + mpfr_clears (a, b, NULL); } - - mpz_clear (r); } @@ -271,12 +253,7 @@ gfc_arith_done_1 (void) } for (rp = gfc_real_kinds; rp->kind; rp++) - { - mpfr_clear (rp->epsilon); - mpfr_clear (rp->huge); - mpfr_clear (rp->tiny); - mpfr_clear (rp->subnormal); - } + mpfr_clears (rp->epsilon, rp->huge, rp->tiny, rp->subnormal, NULL); } @@ -345,29 +322,27 @@ gfc_check_real_range (mpfr_t p, int kind) mpfr_init (q); mpfr_abs (q, p, GFC_RND_MODE); + retval = ARITH_OK; + if (mpfr_inf_p (p)) { - if (gfc_option.flag_range_check == 0) - retval = ARITH_OK; - else + if (gfc_option.flag_range_check != 0) retval = ARITH_OVERFLOW; } else if (mpfr_nan_p (p)) { - if (gfc_option.flag_range_check == 0) - retval = ARITH_OK; - else + if (gfc_option.flag_range_check != 0) retval = ARITH_NAN; } else if (mpfr_sgn (q) == 0) - retval = ARITH_OK; + { + mpfr_clear (q); + return retval; + } else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0) { if (gfc_option.flag_range_check == 0) - { - mpfr_set_inf (p, mpfr_sgn (p)); - retval = ARITH_OK; - } + mpfr_set_inf (p, mpfr_sgn (p)); else retval = ARITH_OVERFLOW; } @@ -383,7 +358,6 @@ gfc_check_real_range (mpfr_t p, int kind) } else mpfr_set_ui (p, 0, GFC_RND_MODE); - retval = ARITH_OK; } else retval = ARITH_UNDERFLOW; @@ -412,11 +386,7 @@ gfc_check_real_range (mpfr_t p, int kind) mpfr_neg (p, q, GMP_RNDN); else mpfr_set (p, q, GMP_RNDN); - - retval = ARITH_OK; } - else - retval = ARITH_OK; mpfr_clear (q); @@ -779,8 +749,7 @@ gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) mpfr_mul (y, op1->value.complex.i, op2->value.complex.r, GFC_RND_MODE); mpfr_add (result->value.complex.i, x, y, GFC_RND_MODE); - mpfr_clear (x); - mpfr_clear (y); + mpfr_clears (x, y, NULL); break; default: @@ -858,9 +827,7 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) mpfr_div (result->value.complex.i, result->value.complex.i, div, GFC_RND_MODE); - mpfr_clear (x); - mpfr_clear (y); - mpfr_clear (div); + mpfr_clears (x, y, div, NULL); break; default: @@ -879,30 +846,22 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp) static void complex_reciprocal (gfc_expr *op) { - mpfr_t mod, a, re, im; + mpfr_t mod, tmp; gfc_set_model (op->value.complex.r); mpfr_init (mod); - mpfr_init (a); - mpfr_init (re); - mpfr_init (im); + mpfr_init (tmp); mpfr_mul (mod, op->value.complex.r, op->value.complex.r, GFC_RND_MODE); - mpfr_mul (a, op->value.complex.i, op->value.complex.i, GFC_RND_MODE); - mpfr_add (mod, mod, a, GFC_RND_MODE); + mpfr_mul (tmp, op->value.complex.i, op->value.complex.i, GFC_RND_MODE); + mpfr_add (mod, mod, tmp, GFC_RND_MODE); - mpfr_div (re, op->value.complex.r, mod, GFC_RND_MODE); + mpfr_div (op->value.complex.r, op->value.complex.r, mod, GFC_RND_MODE); - mpfr_neg (im, op->value.complex.i, GFC_RND_MODE); - mpfr_div (im, im, mod, GFC_RND_MODE); + mpfr_neg (op->value.complex.i, op->value.complex.i, GFC_RND_MODE); + mpfr_div (op->value.complex.i, op->value.complex.i, mod, GFC_RND_MODE); - mpfr_set (op->value.complex.r, re, GFC_RND_MODE); - mpfr_set (op->value.complex.i, im, GFC_RND_MODE); - - mpfr_clear (re); - mpfr_clear (im); - mpfr_clear (mod); - mpfr_clear (a); + mpfr_clears (tmp, mod, NULL); } @@ -934,8 +893,8 @@ complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power) mpfr_set (x_r, base->value.complex.r, GFC_RND_MODE); mpfr_set (x_i, base->value.complex.i, GFC_RND_MODE); -/* Macro for complex multiplication. We have to take care that - res_r/res_i and a_r/a_i can (and will) be the same variable. */ + /* Macro for complex multiplication. We have to take care that + res_r/res_i and a_r/a_i can (and will) be the same variable. */ #define CMULT(res_r,res_i,a_r,a_i,b_r,b_i) \ mpfr_mul (re, a_r, b_r, GFC_RND_MODE), \ mpfr_mul (tmp, a_i, b_i, GFC_RND_MODE), \ @@ -964,11 +923,7 @@ complex_pow (gfc_expr *result, gfc_expr *base, mpz_t power) #undef res_i #undef CMULT - mpfr_clear (x_r); - mpfr_clear (x_i); - mpfr_clear (tmp); - mpfr_clear (re); - mpfr_clear (im); + mpfr_clears (x_r, x_i, tmp, re, im, NULL); } diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c index 865e2efc79d..170f6cdcd63 100644 --- a/gcc/fortran/cpp.c +++ b/gcc/fortran/cpp.c @@ -524,6 +524,9 @@ gfc_cpp_init (void) { int i; + if (gfc_option.flag_preprocessed) + return; + cpp_change_file (cpp_in, LC_RENAME, _("<built-in>")); if (!gfc_cpp_option.no_predefined) cpp_define_builtins (cpp_in); @@ -574,6 +577,8 @@ gfc_cpp_preprocess (const char *source_file) cpp_forall_identifiers (cpp_in, dump_macro, NULL); } + putc ('\n', print.outf); + if (!gfc_cpp_preprocess_only () || (gfc_cpp_preprocess_only () && gfc_cpp_option.output_filename)) fclose (print.outf); diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 79044eb1846..ea87c211d49 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -5216,7 +5216,7 @@ attr_decl1 (void) /* Update symbol table. DIMENSION attribute is set in gfc_set_array_spec(). */ if (current_attr.dimension == 0 - && gfc_copy_attr (&sym->attr, ¤t_attr, NULL) == FAILURE) + && gfc_copy_attr (&sym->attr, ¤t_attr, &var_locus) == FAILURE) { m = MATCH_ERROR; goto cleanup; @@ -6270,6 +6270,10 @@ gfc_match_derived_decl (void) if (attr.is_bind_c != 0) sym->attr.is_bind_c = attr.is_bind_c; + /* Construct the f2k_derived namespace if it is not yet there. */ + if (!sym->f2k_derived) + sym->f2k_derived = gfc_get_namespace (NULL, 0); + gfc_new_block = sym; return MATCH_YES; @@ -6480,3 +6484,105 @@ cleanup: } +/* Match a FINAL declaration inside a derived type. */ + +match +gfc_match_final_decl (void) +{ + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol* sym; + match m; + gfc_namespace* module_ns; + bool first, last; + + if (gfc_state_stack->state != COMP_DERIVED) + { + gfc_error ("FINAL declaration at %C must be inside a derived type " + "definition!"); + return MATCH_ERROR; + } + + gcc_assert (gfc_current_block ()); + + if (!gfc_state_stack->previous + || gfc_state_stack->previous->state != COMP_MODULE) + { + gfc_error ("Derived type declaration with FINAL at %C must be in the" + " specification part of a MODULE"); + return MATCH_ERROR; + } + + module_ns = gfc_current_ns; + gcc_assert (module_ns); + gcc_assert (module_ns->proc_name->attr.flavor == FL_MODULE); + + /* Match optional ::, don't care about MATCH_YES or MATCH_NO. */ + if (gfc_match (" ::") == MATCH_ERROR) + return MATCH_ERROR; + + /* Match the sequence of procedure names. */ + first = true; + last = false; + do + { + gfc_finalizer* f; + + if (first && gfc_match_eos () == MATCH_YES) + { + gfc_error ("Empty FINAL at %C"); + return MATCH_ERROR; + } + + m = gfc_match_name (name); + if (m == MATCH_NO) + { + gfc_error ("Expected module procedure name at %C"); + return MATCH_ERROR; + } + else if (m != MATCH_YES) + return MATCH_ERROR; + + if (gfc_match_eos () == MATCH_YES) + last = true; + if (!last && gfc_match_char (',') != MATCH_YES) + { + gfc_error ("Expected ',' at %C"); + return MATCH_ERROR; + } + + if (gfc_get_symbol (name, module_ns, &sym)) + { + gfc_error ("Unknown procedure name \"%s\" at %C", name); + return MATCH_ERROR; + } + + /* Mark the symbol as module procedure. */ + if (sym->attr.proc != PROC_MODULE + && gfc_add_procedure (&sym->attr, PROC_MODULE, + sym->name, NULL) == FAILURE) + return MATCH_ERROR; + + /* Check if we already have this symbol in the list, this is an error. */ + for (f = gfc_current_block ()->f2k_derived->finalizers; f; f = f->next) + if (f->procedure == sym) + { + gfc_error ("'%s' at %C is already defined as FINAL procedure!", + name); + return MATCH_ERROR; + } + + /* Add this symbol to the list of finalizers. */ + gcc_assert (gfc_current_block ()->f2k_derived); + ++sym->refs; + f = gfc_getmem (sizeof (gfc_finalizer)); + f->procedure = sym; + f->where = gfc_current_locus; + f->next = gfc_current_block ()->f2k_derived->finalizers; + gfc_current_block ()->f2k_derived->finalizers = f; + + first = false; + } + while (!last); + + return MATCH_YES; +} diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index d6068a4994c..8665a48c566 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -210,7 +210,7 @@ typedef enum ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE, ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF, ST_ELSEWHERE, ST_END_BLOCK_DATA, ST_ENDDO, ST_IMPLIED_ENDDO, - ST_END_FILE, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF, + ST_END_FILE, ST_FINAL, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF, ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT, ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE, ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO, @@ -1018,6 +1018,10 @@ typedef struct gfc_symbol gfc_formal_arglist *formal; struct gfc_namespace *formal_ns; + /* The namespace containing type-associated procedure symbols. */ + /* TODO: Make this union with formal? */ + struct gfc_namespace *f2k_derived; + struct gfc_expr *value; /* Parameter/Initializer value */ gfc_array_spec *as; struct gfc_symbol *result; /* function result symbol */ @@ -1155,6 +1159,8 @@ typedef struct gfc_namespace gfc_symtree *uop_root; /* Tree containing all the common blocks. */ gfc_symtree *common_root; + /* Linked list of finalizer procedures. */ + struct gfc_finalizer *finalizers; /* If set_flag[letter] is set, an implicit type has been set for letter. */ int set_flag[GFC_LETTERS]; @@ -1946,6 +1952,17 @@ typedef struct iterator_stack iterator_stack; extern iterator_stack *iter_stack; + +/* Node in the linked list used for storing finalizer procedures. */ + +typedef struct gfc_finalizer +{ + struct gfc_finalizer* next; + gfc_symbol* procedure; + locus where; /* Where the FINAL declaration occured. */ +} +gfc_finalizer; + /************************ Function prototypes *************************/ /* decl.c */ @@ -2215,6 +2232,8 @@ gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *); void copy_formal_args (gfc_symbol *dest, gfc_symbol *src); +void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */ + /* intrinsic.c */ extern int gfc_init_expr; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f70cedba949..f2ad4f6734e 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2421,8 +2421,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) } } - if (sym->attr.external - || sym->attr.if_source == IFSRC_UNKNOWN) + if (sym->attr.if_source == IFSRC_UNKNOWN) { gfc_actual_arglist *a; for (a = *ap; a; a = a->next) diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index e902f693f6b..62ee442a19c 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -3807,7 +3807,6 @@ gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts) new->symtree->n.sym->attr.flavor = FL_PROCEDURE; new->symtree->n.sym->attr.function = 1; new->symtree->n.sym->attr.elemental = 1; - new->symtree->n.sym->attr.pure = 1; new->symtree->n.sym->attr.referenced = 1; gfc_intrinsic_symbol(new->symtree->n.sym); gfc_commit_symbol (new->symtree->n.sym); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 94ed4a67baf..acbf5becff0 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -627,9 +627,19 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift, } } - f->value.function.name - = gfc_get_string (PREFIX ("cshift%d_%d%s"), n, shift->ts.kind, - array->ts.type == BT_CHARACTER ? "_char" : ""); + if (array->ts.type == BT_CHARACTER) + { + if (array->ts.kind == gfc_default_character_kind) + f->value.function.name + = gfc_get_string (PREFIX ("cshift%d_%d_char"), n, shift->ts.kind); + else + f->value.function.name + = gfc_get_string (PREFIX ("cshift%d_%d_char%d"), n, shift->ts.kind, + array->ts.kind); + } + else + f->value.function.name + = gfc_get_string (PREFIX ("cshift%d_%d"), n, shift->ts.kind); } @@ -768,9 +778,19 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift, } } - f->value.function.name - = gfc_get_string (PREFIX ("eoshift%d_%d%s"), n, shift->ts.kind, - array->ts.type == BT_CHARACTER ? "_char" : ""); + if (array->ts.type == BT_CHARACTER) + { + if (array->ts.kind == gfc_default_character_kind) + f->value.function.name + = gfc_get_string (PREFIX ("eoshift%d_%d_char"), n, shift->ts.kind); + else + f->value.function.name + = gfc_get_string (PREFIX ("eoshift%d_%d_char%d"), n, shift->ts.kind, + array->ts.kind); + } + else + f->value.function.name + = gfc_get_string (PREFIX ("eoshift%d_%d"), n, shift->ts.kind); } diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 85ffcd675fc..5ee91fb62de 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -142,6 +142,7 @@ match gfc_match_function_decl (void); match gfc_match_entry (void); match gfc_match_subroutine (void); match gfc_match_derived_decl (void); +match gfc_match_final_decl (void); match gfc_match_implicit_none (void); match gfc_match_implicit (void); diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 149b7b1829b..c35db2d9cf6 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -366,6 +366,7 @@ decode_statement (void) break; case 'f': + match ("final", gfc_match_final_decl, ST_FINAL); match ("flush", gfc_match_flush, ST_FLUSH); match ("format", gfc_match_format, ST_FORMAT); break; @@ -1695,6 +1696,7 @@ static void parse_derived (void) { int compiling_type, seen_private, seen_sequence, seen_component, error_flag; + int seen_contains, seen_contains_comp; gfc_statement st; gfc_state_data s; gfc_symbol *derived_sym = NULL; @@ -1710,6 +1712,8 @@ parse_derived (void) seen_private = 0; seen_sequence = 0; seen_component = 0; + seen_contains = 0; + seen_contains_comp = 0; compiling_type = 1; @@ -1723,23 +1727,57 @@ parse_derived (void) case ST_DATA_DECL: case ST_PROCEDURE: + if (seen_contains) + { + gfc_error ("Components in TYPE at %C must precede CONTAINS"); + error_flag = 1; + } + accept_statement (st); seen_component = 1; break; + case ST_FINAL: + if (!seen_contains) + { + gfc_error ("FINAL declaration at %C must be inside CONTAINS"); + error_flag = 1; + } + + if (gfc_notify_std (GFC_STD_F2003, + "Fortran 2003: FINAL procedure declaration" + " at %C") == FAILURE) + error_flag = 1; + + accept_statement (ST_FINAL); + seen_contains_comp = 1; + break; + case ST_END_TYPE: compiling_type = 0; if (!seen_component && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Derived type " - "definition at %C without components") + "definition at %C without components") == FAILURE)) error_flag = 1; + if (seen_contains && !seen_contains_comp + && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type " + "definition at %C with empty CONTAINS " + "section") == FAILURE)) + error_flag = 1; + accept_statement (ST_END_TYPE); break; case ST_PRIVATE: + if (seen_contains) + { + gfc_error ("PRIVATE statement at %C must precede CONTAINS"); + error_flag = 1; + } + if (gfc_find_state (COMP_MODULE) == FAILURE) { gfc_error ("PRIVATE statement in TYPE at %C must be inside " @@ -1768,6 +1806,12 @@ parse_derived (void) break; case ST_SEQUENCE: + if (seen_contains) + { + gfc_error ("SEQUENCE statement at %C must precede CONTAINS"); + error_flag = 1; + } + if (seen_component) { gfc_error ("SEQUENCE statement at %C must precede " @@ -1791,6 +1835,22 @@ parse_derived (void) gfc_current_block ()->name, NULL); break; + case ST_CONTAINS: + if (gfc_notify_std (GFC_STD_F2003, + "Fortran 2003: CONTAINS block in derived type" + " definition at %C") == FAILURE) + error_flag = 1; + + if (seen_contains) + { + gfc_error ("Already inside a CONTAINS block at %C"); + error_flag = 1; + } + + seen_contains = 1; + accept_statement (ST_CONTAINS); + break; + default: unexpected_statement (st); break; @@ -1927,15 +1987,26 @@ loop: unexpected_eof (); case ST_SUBROUTINE: - new_state = COMP_SUBROUTINE; - gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, - gfc_new_block->formal, NULL); - break; - case ST_FUNCTION: - new_state = COMP_FUNCTION; - gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, - gfc_new_block->formal, NULL); + if (st == ST_SUBROUTINE) + new_state = COMP_SUBROUTINE; + else if (st == ST_FUNCTION) + new_state = COMP_FUNCTION; + if (gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY, + gfc_new_block->formal, NULL) == FAILURE) + { + reject_statement (); + gfc_free_namespace (gfc_current_ns); + goto loop; + } + if (current_interface.type != INTERFACE_ABSTRACT && + !gfc_new_block->attr.dummy && + gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE) + { + reject_statement (); + gfc_free_namespace (gfc_current_ns); + goto loop; + } break; case ST_PROCEDURE: diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index edf7c8748d2..fdee416b4e3 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1571,7 +1571,8 @@ resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr) /* Existance of isym should be checked already. */ gcc_assert (isym); - sym->ts = isym->ts; + sym->ts.type = isym->ts.type; + sym->ts.kind = isym->ts.kind; sym->attr.function = 1; sym->attr.proc = PROC_EXTERNAL; goto found; @@ -2646,8 +2647,9 @@ resolve_specific_s0 (gfc_code *c, gfc_symbol *sym) /* Existance of isym should be checked already. */ gcc_assert (isym); - sym->ts = isym->ts; - sym->attr.function = 1; + sym->ts.type = isym->ts.type; + sym->ts.kind = isym->ts.kind; + sym->attr.subroutine = 1; goto found; } @@ -7444,6 +7446,146 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) } +/* Resolve a list of finalizer procedures. That is, after they have hopefully + been defined and we now know their defined arguments, check that they fulfill + the requirements of the standard for procedures used as finalizers. */ + +static try +gfc_resolve_finalizers (gfc_symbol* derived) +{ + gfc_finalizer* list; + gfc_finalizer** prev_link; /* For removing wrong entries from the list. */ + try result = SUCCESS; + bool seen_scalar = false; + + if (!derived->f2k_derived || !derived->f2k_derived->finalizers) + return SUCCESS; + + /* Walk over the list of finalizer-procedures, check them, and if any one + does not fit in with the standard's definition, print an error and remove + it from the list. */ + prev_link = &derived->f2k_derived->finalizers; + for (list = derived->f2k_derived->finalizers; list; list = *prev_link) + { + gfc_symbol* arg; + gfc_finalizer* i; + int my_rank; + + /* Check this exists and is a SUBROUTINE. */ + if (!list->procedure->attr.subroutine) + { + gfc_error ("FINAL procedure '%s' at %L is not a SUBROUTINE", + list->procedure->name, &list->where); + goto error; + } + + /* We should have exactly one argument. */ + if (!list->procedure->formal || list->procedure->formal->next) + { + gfc_error ("FINAL procedure at %L must have exactly one argument", + &list->where); + goto error; + } + arg = list->procedure->formal->sym; + + /* This argument must be of our type. */ + if (arg->ts.type != BT_DERIVED || arg->ts.derived != derived) + { + gfc_error ("Argument of FINAL procedure at %L must be of type '%s'", + &arg->declared_at, derived->name); + goto error; + } + + /* It must neither be a pointer nor allocatable nor optional. */ + if (arg->attr.pointer) + { + gfc_error ("Argument of FINAL procedure at %L must not be a POINTER", + &arg->declared_at); + goto error; + } + if (arg->attr.allocatable) + { + gfc_error ("Argument of FINAL procedure at %L must not be" + " ALLOCATABLE", &arg->declared_at); + goto error; + } + if (arg->attr.optional) + { + gfc_error ("Argument of FINAL procedure at %L must not be OPTIONAL", + &arg->declared_at); + goto error; + } + + /* It must not be INTENT(OUT). */ + if (arg->attr.intent == INTENT_OUT) + { + gfc_error ("Argument of FINAL procedure at %L must not be" + " INTENT(OUT)", &arg->declared_at); + goto error; + } + + /* Warn if the procedure is non-scalar and not assumed shape. */ + if (gfc_option.warn_surprising && arg->as && arg->as->rank > 0 + && arg->as->type != AS_ASSUMED_SHAPE) + gfc_warning ("Non-scalar FINAL procedure at %L should have assumed" + " shape argument", &arg->declared_at); + + /* Check that it does not match in kind and rank with a FINAL procedure + defined earlier. To really loop over the *earlier* declarations, + we need to walk the tail of the list as new ones were pushed at the + front. */ + /* TODO: Handle kind parameters once they are implemented. */ + my_rank = (arg->as ? arg->as->rank : 0); + for (i = list->next; i; i = i->next) + { + /* Argument list might be empty; that is an error signalled earlier, + but we nevertheless continued resolving. */ + if (i->procedure->formal) + { + gfc_symbol* i_arg = i->procedure->formal->sym; + const int i_rank = (i_arg->as ? i_arg->as->rank : 0); + if (i_rank == my_rank) + { + gfc_error ("FINAL procedure '%s' declared at %L has the same" + " rank (%d) as '%s'", + list->procedure->name, &list->where, my_rank, + i->procedure->name); + goto error; + } + } + } + + /* Is this the/a scalar finalizer procedure? */ + if (!arg->as || arg->as->rank == 0) + seen_scalar = true; + + prev_link = &list->next; + continue; + + /* Remove wrong nodes immediatelly from the list so we don't risk any + troubles in the future when they might fail later expectations. */ +error: + result = FAILURE; + i = list; + *prev_link = list->next; + gfc_free_finalizer (i); + } + + /* Warn if we haven't seen a scalar finalizer procedure (but we know there + were nodes in the list, must have been for arrays. It is surely a good + idea to have a scalar version there if there's something to finalize. */ + if (gfc_option.warn_surprising && result == SUCCESS && !seen_scalar) + gfc_warning ("Only array FINAL procedures declared for derived type '%s'" + " defined at %L, suggest also scalar one", + derived->name, &derived->declared_at); + + /* TODO: Remove this error when finalization is finished. */ + gfc_error ("Finalization at %L is not yet implemented", &derived->declared_at); + + return result; +} + + /* Resolve the components of a derived type. */ static try @@ -7522,6 +7664,10 @@ resolve_fl_derived (gfc_symbol *sym) } } + /* Resolve the finalizer procedures. */ + if (gfc_resolve_finalizers (sym) == FAILURE) + return FAILURE; + /* Add derived type to the derived type list. */ for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->next) if (sym == dt_list->derived) diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 08f4688de7d..1b0eeca1e65 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -1313,6 +1313,11 @@ gfc_gobble_whitespace (void) In fixed mode, we expand a tab that occurs within the statement label region to expand to spaces that leave the next character in the source region. + + If first_char is not NULL, it's a pointer to a single char value holding + the first character of the line, which has already been read by the + caller. This avoids the use of ungetc(). + load_line returns whether the line was truncated. NOTE: The error machinery isn't available at this point, so we can't @@ -1320,7 +1325,7 @@ gfc_gobble_whitespace (void) parts of gfortran. */ static int -load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen) +load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char) { static int linenum = 0, current_line = 1; int c, maxlen, i, preprocessor_flag, buflen = *pbuflen; @@ -1355,20 +1360,20 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen) i = 0; buffer = *pbuf; - preprocessor_flag = 0; - c = getc (input); - if (c == '#') - /* In order to not truncate preprocessor lines, we have to - remember that this is one. */ - preprocessor_flag = 1; - ungetc (c, input); + if (first_char) + c = *first_char; + else + c = getc (input); + + /* In order to not truncate preprocessor lines, we have to + remember that this is one. */ + preprocessor_flag = (c == '#' ? 1 : 0); for (;;) { - c = getc (input); - if (c == EOF) break; + if (c == '\n') { /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */ @@ -1385,10 +1390,8 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen) break; } - if (c == '\r') - continue; /* Gobble characters. */ - if (c == '\0') - continue; + if (c == '\r' || c == '\0') + goto next_char; /* Gobble characters. */ if (c == '&') { @@ -1413,7 +1416,7 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen) if (c >= '1' && c <= '9') { *(buffer-1) = c; - continue; + goto next_char; } } @@ -1435,7 +1438,7 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen) i++; } - continue; + goto next_char; } *buffer++ = c; @@ -1464,8 +1467,12 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen) trunc_flag = 1; } - ungetc ('\n', input); + c = '\n'; + continue; } + +next_char: + c = getc (input); } /* Pad lines to the selected line length in fixed form. */ @@ -1813,7 +1820,7 @@ load_file (const char *filename, bool initial) for (;;) { - int trunc = load_line (input, &line, &line_len); + int trunc = load_line (input, &line, &line_len, NULL); len = gfc_wide_strlen (line); if (feof (input) && len == 0) @@ -1995,13 +2002,12 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file) return NULL; c = getc (gfc_src_file); - ungetc (c, gfc_src_file); if (c != '#') return NULL; len = 0; - load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len); + load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len, &c); if (wide_strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0) return NULL; @@ -2013,13 +2019,12 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file) return NULL; c = getc (gfc_src_file); - ungetc (c, gfc_src_file); if (c != '#') return filename; len = 0; - load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len); + load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len, &c); if (wide_strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0) return filename; diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 8c1c6b349e7..058a9f293a1 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -543,7 +543,6 @@ gfc_simplify_and (gfc_expr *x, gfc_expr *y) result->value.logical = x->value.logical && y->value.logical; return result; } - } @@ -651,16 +650,15 @@ gfc_simplify_atan2 (gfc_expr *y, gfc_expr *x) if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT) return NULL; - result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - if (mpfr_sgn (y->value.real) == 0 && mpfr_sgn (x->value.real) == 0) { gfc_error ("If first argument of ATAN2 %L is zero, then the " "second argument must not be zero", &x->where); - gfc_free_expr (result); return &gfc_bad_expr; } + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "ATAN2"); @@ -677,7 +675,6 @@ gfc_simplify_bessel_j0 (gfc_expr *x ATTRIBUTE_UNUSED) return NULL; result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_j0 (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_J0"); @@ -697,7 +694,6 @@ gfc_simplify_bessel_j1 (gfc_expr *x ATTRIBUTE_UNUSED) return NULL; result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_j1 (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_J1"); @@ -720,7 +716,6 @@ gfc_simplify_bessel_jn (gfc_expr *order ATTRIBUTE_UNUSED, n = mpz_get_si (order->value.integer); result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_jn (result->value.real, n, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_JN"); @@ -740,7 +735,6 @@ gfc_simplify_bessel_y0 (gfc_expr *x ATTRIBUTE_UNUSED) return NULL; result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_y0 (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_Y0"); @@ -760,7 +754,6 @@ gfc_simplify_bessel_y1 (gfc_expr *x ATTRIBUTE_UNUSED) return NULL; result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_y1 (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_Y1"); @@ -783,7 +776,6 @@ gfc_simplify_bessel_yn (gfc_expr *order ATTRIBUTE_UNUSED, n = mpz_get_si (order->value.integer); result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); mpfr_yn (result->value.real, n, x->value.real, GFC_RND_MODE); return range_check (result, "BESSEL_YN"); @@ -937,25 +929,16 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) static gfc_expr * only_convert_cmplx_boz (gfc_expr *x, gfc_expr *y, int kind) { - if (x->is_boz) - { - gfc_typespec ts; - gfc_clear_ts (&ts); - ts.type = BT_REAL; - ts.kind = kind; - if (!gfc_convert_boz (x, &ts)) - return &gfc_bad_expr; - } + gfc_typespec ts; + gfc_clear_ts (&ts); + ts.type = BT_REAL; + ts.kind = kind; - if (y && y->is_boz) - { - gfc_typespec ts; - gfc_clear_ts (&ts); - ts.type = BT_REAL; - ts.kind = kind; - if (!gfc_convert_boz (y, &ts)) - return &gfc_bad_expr; - } + if (x->is_boz && !gfc_convert_boz (x, &ts)) + return &gfc_bad_expr; + + if (y && y->is_boz && !gfc_convert_boz (y, &ts)) + return &gfc_bad_expr; return NULL; } @@ -1051,8 +1034,7 @@ gfc_simplify_cos (gfc_expr *x) mpfr_mul (xp, xp, xq, GFC_RND_MODE); mpfr_neg (result->value.complex.i, xp, GFC_RND_MODE ); - mpfr_clear (xp); - mpfr_clear (xq); + mpfr_clears (xp, xq, NULL); break; default: gfc_internal_error ("in gfc_simplify_cos(): Bad type"); @@ -1296,8 +1278,7 @@ gfc_simplify_exp (gfc_expr *x) mpfr_mul (result->value.complex.r, xq, xp, GFC_RND_MODE); mpfr_sin (xp, x->value.complex.i, GFC_RND_MODE); mpfr_mul (result->value.complex.i, xq, xp, GFC_RND_MODE); - mpfr_clear (xp); - mpfr_clear (xq); + mpfr_clears (xp, xq, NULL); break; default: @@ -1402,14 +1383,13 @@ gfc_simplify_fraction (gfc_expr *x) result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); - if (mpfr_sgn (x->value.real) == 0) { mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); return result; } + gfc_set_model_kind (x->ts.kind); mpfr_init (exp); mpfr_init (absv); mpfr_init (pow2); @@ -1424,9 +1404,7 @@ gfc_simplify_fraction (gfc_expr *x) mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE); - mpfr_clear (exp); - mpfr_clear (absv); - mpfr_clear (pow2); + mpfr_clears (exp, absv, pow2, NULL); return range_check (result, "FRACTION"); } @@ -1442,8 +1420,6 @@ gfc_simplify_gamma (gfc_expr *x) result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); - mpfr_gamma (result->value.real, x->value.real, GFC_RND_MODE); return range_check (result, "GAMMA"); @@ -2491,8 +2467,6 @@ gfc_simplify_lgamma (gfc_expr *x ATTRIBUTE_UNUSED) result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); - mpfr_lgamma (result->value.real, &sg, x->value.real, GFC_RND_MODE); return range_check (result, "LGAMMA"); @@ -2554,7 +2528,6 @@ gfc_simplify_log (gfc_expr *x) result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); switch (x->ts.type) { @@ -2580,6 +2553,7 @@ gfc_simplify_log (gfc_expr *x) return &gfc_bad_expr; } + gfc_set_model_kind (x->ts.kind); mpfr_init (xr); mpfr_init (xi); @@ -2592,8 +2566,7 @@ gfc_simplify_log (gfc_expr *x) mpfr_sqrt (xr, xr, GFC_RND_MODE); mpfr_log (result->value.complex.r, xr, GFC_RND_MODE); - mpfr_clear (xr); - mpfr_clear (xi); + mpfr_clears (xr, xi, NULL); break; @@ -2613,8 +2586,6 @@ gfc_simplify_log10 (gfc_expr *x) if (x->expr_type != EXPR_CONSTANT) return NULL; - gfc_set_model_kind (x->ts.kind); - if (mpfr_sgn (x->value.real) <= 0) { gfc_error ("Argument of LOG10 at %L cannot be less than or equal " @@ -2812,7 +2783,7 @@ gfc_expr * gfc_simplify_mod (gfc_expr *a, gfc_expr *p) { gfc_expr *result; - mpfr_t quot, iquot, term; + mpfr_t tmp; int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) @@ -2844,18 +2815,12 @@ gfc_simplify_mod (gfc_expr *a, gfc_expr *p) } gfc_set_model_kind (kind); - mpfr_init (quot); - mpfr_init (iquot); - mpfr_init (term); - - mpfr_div (quot, a->value.real, p->value.real, GFC_RND_MODE); - mpfr_trunc (iquot, quot); - mpfr_mul (term, iquot, p->value.real, GFC_RND_MODE); - mpfr_sub (result->value.real, a->value.real, term, GFC_RND_MODE); - - mpfr_clear (quot); - mpfr_clear (iquot); - mpfr_clear (term); + mpfr_init (tmp); + mpfr_div (tmp, a->value.real, p->value.real, GFC_RND_MODE); + mpfr_trunc (tmp, tmp); + mpfr_mul (tmp, tmp, p->value.real, GFC_RND_MODE); + mpfr_sub (result->value.real, a->value.real, tmp, GFC_RND_MODE); + mpfr_clear (tmp); break; default: @@ -2870,7 +2835,7 @@ gfc_expr * gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) { gfc_expr *result; - mpfr_t quot, iquot, term; + mpfr_t tmp; int kind; if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT) @@ -2904,18 +2869,12 @@ gfc_simplify_modulo (gfc_expr *a, gfc_expr *p) } gfc_set_model_kind (kind); - mpfr_init (quot); - mpfr_init (iquot); - mpfr_init (term); - - mpfr_div (quot, a->value.real, p->value.real, GFC_RND_MODE); - mpfr_floor (iquot, quot); - mpfr_mul (term, iquot, p->value.real, GFC_RND_MODE); - mpfr_sub (result->value.real, a->value.real, term, GFC_RND_MODE); - - mpfr_clear (quot); - mpfr_clear (iquot); - mpfr_clear (term); + mpfr_init (tmp); + mpfr_div (tmp, a->value.real, p->value.real, GFC_RND_MODE); + mpfr_floor (tmp, tmp); + mpfr_mul (tmp, tmp, p->value.real, GFC_RND_MODE); + mpfr_sub (result->value.real, a->value.real, tmp, GFC_RND_MODE); + mpfr_clear (tmp); break; default: @@ -2955,7 +2914,6 @@ gfc_simplify_nearest (gfc_expr *x, gfc_expr *s) return &gfc_bad_expr; } - gfc_set_model_kind (x->ts.kind); result = gfc_copy_expr (x); /* Save current values of emin and emax. */ @@ -3715,8 +3673,7 @@ gfc_simplify_scale (gfc_expr *x, gfc_expr *i) else mpfr_mul (result->value.real, x->value.real, scale, GFC_RND_MODE); - mpfr_clear (scale); - mpfr_clear (radix); + mpfr_clears (scale, radix, NULL); return range_check (result, "SCALE"); } @@ -3944,14 +3901,13 @@ gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i) result = gfc_constant_result (BT_REAL, x->ts.kind, &x->where); - gfc_set_model_kind (x->ts.kind); - if (mpfr_sgn (x->value.real) == 0) { mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); return result; } + gfc_set_model_kind (x->ts.kind); mpfr_init (absv); mpfr_init (log2); mpfr_init (exp); @@ -3973,10 +3929,7 @@ gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i) exp2 = (unsigned long) mpz_get_d (i->value.integer); mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE); - mpfr_clear (absv); - mpfr_clear (log2); - mpfr_clear (pow2); - mpfr_clear (frac); + mpfr_clears (absv, log2, pow2, frac, NULL); return range_check (result, "SET_EXPONENT"); } @@ -4137,8 +4090,7 @@ gfc_simplify_sin (gfc_expr *x) mpfr_sinh (xq, x->value.complex.i, GFC_RND_MODE); mpfr_mul (result->value.complex.i, xp, xq, GFC_RND_MODE); - mpfr_clear (xp); - mpfr_clear (xq); + mpfr_clears (xp, xq, NULL); break; default: @@ -4314,11 +4266,7 @@ gfc_simplify_sqrt (gfc_expr *e) gfc_internal_error ("invalid complex argument of SQRT at %L", &e->where); - mpfr_clear (s); - mpfr_clear (t); - mpfr_clear (ac); - mpfr_clear (ad); - mpfr_clear (w); + mpfr_clears (s, t, ac, ad, w, NULL); break; @@ -4811,26 +4759,75 @@ gfc_convert_char_constant (gfc_expr *e, bt type ATTRIBUTE_UNUSED, int kind) if (!gfc_is_constant_expr (e)) return NULL; - result = gfc_constant_result (BT_CHARACTER, kind, &e->where); - if (result == NULL) - return &gfc_bad_expr; - - result->value.character.length = e->value.character.length; - result->value.character.string - = gfc_get_wide_string (e->value.character.length + 1); - memcpy (result->value.character.string, e->value.character.string, - (e->value.character.length + 1) * sizeof (gfc_char_t)); - - /* Check we only have values representable in the destination kind. */ - for (i = 0; i < result->value.character.length; i++) - if (!gfc_check_character_range (result->value.character.string[i], kind)) - { - gfc_error ("Character '%s' in string at %L cannot be converted into " - "character kind %d", - gfc_print_wide_char (result->value.character.string[i]), - &e->where, kind); + if (e->expr_type == EXPR_CONSTANT) + { + /* Simple case of a scalar. */ + result = gfc_constant_result (BT_CHARACTER, kind, &e->where); + if (result == NULL) return &gfc_bad_expr; - } - return result; + result->value.character.length = e->value.character.length; + result->value.character.string + = gfc_get_wide_string (e->value.character.length + 1); + memcpy (result->value.character.string, e->value.character.string, + (e->value.character.length + 1) * sizeof (gfc_char_t)); + + /* Check we only have values representable in the destination kind. */ + for (i = 0; i < result->value.character.length; i++) + if (!gfc_check_character_range (result->value.character.string[i], + kind)) + { + gfc_error ("Character '%s' in string at %L cannot be converted " + "into character kind %d", + gfc_print_wide_char (result->value.character.string[i]), + &e->where, kind); + return &gfc_bad_expr; + } + + return result; + } + else if (e->expr_type == EXPR_ARRAY) + { + /* For an array constructor, we convert each constructor element. */ + gfc_constructor *head = NULL, *tail = NULL, *c; + + for (c = e->value.constructor; c; c = c->next) + { + if (head == NULL) + head = tail = gfc_get_constructor (); + else + { + tail->next = gfc_get_constructor (); + tail = tail->next; + } + + tail->where = c->where; + tail->expr = gfc_convert_char_constant (c->expr, type, kind); + if (tail->expr == &gfc_bad_expr) + { + tail->expr = NULL; + return &gfc_bad_expr; + } + + if (tail->expr == NULL) + { + gfc_free_constructor (head); + return NULL; + } + } + + result = gfc_get_expr (); + result->ts.type = type; + result->ts.kind = kind; + result->expr_type = EXPR_ARRAY; + result->value.constructor = head; + result->shape = gfc_copy_shape (e->shape, e->rank); + result->where = e->where; + result->rank = e->rank; + result->ts.cl = e->ts.cl; + + return result; + } + else + return NULL; } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 431b6513ce0..e4e43244d59 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -434,12 +434,14 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (target, external); conf (target, intrinsic); - conf (external, dimension); /* See Fortran 95's R504. */ + + if (!attr->if_source) + conf (external, dimension); /* See Fortran 95's R504. */ conf (external, intrinsic); conf (entry, intrinsic); - if ((attr->if_source && !attr->procedure) || attr->contained) + if ((attr->if_source == IFSRC_DECL && !attr->procedure) || attr->contained) { conf (external, subroutine); conf (external, function); @@ -812,6 +814,14 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where) return FAILURE; } + if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY + && gfc_find_state (COMP_INTERFACE) == FAILURE) + { + gfc_error ("ALLOCATABLE specified outside of INTERFACE body at %L", + where); + return FAILURE; + } + attr->allocatable = 1; return check_conflict (attr, NULL, where); } @@ -830,6 +840,14 @@ gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where) return FAILURE; } + if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY + && gfc_find_state (COMP_INTERFACE) == FAILURE) + { + gfc_error ("DIMENSION specified for '%s' outside its INTERFACE body " + "at %L", name, where); + return FAILURE; + } + attr->dimension = 1; return check_conflict (attr, name, where); } @@ -1451,6 +1469,13 @@ gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source, return FAILURE; } + if (source == IFSRC_IFBODY && (sym->attr.dimension || sym->attr.allocatable)) + { + gfc_error ("'%s' at %L has attributes specified outside its INTERFACE " + "body", sym->name, where); + return FAILURE; + } + sym->formal = formal; sym->attr.if_source = source; @@ -2094,6 +2119,7 @@ gfc_get_namespace (gfc_namespace *parent, int parent_types) ns = gfc_getmem (sizeof (gfc_namespace)); ns->sym_root = NULL; ns->uop_root = NULL; + ns->finalizers = NULL; ns->default_access = ACCESS_UNKNOWN; ns->parent = parent; @@ -2282,6 +2308,8 @@ gfc_free_symbol (gfc_symbol *sym) gfc_free_formal_arglist (sym->formal); + gfc_free_namespace (sym->f2k_derived); + gfc_free (sym); } @@ -2314,6 +2342,7 @@ gfc_new_symbol (const char *name, gfc_namespace *ns) /* Clear the ptrs we may need. */ p->common_block = NULL; + p->f2k_derived = NULL; return p; } @@ -2882,6 +2911,33 @@ gfc_free_equiv_lists (gfc_equiv_list *l) } +/* Free a finalizer procedure list. */ + +void +gfc_free_finalizer (gfc_finalizer* el) +{ + if (el) + { + --el->procedure->refs; + if (!el->procedure->refs) + gfc_free_symbol (el->procedure); + + gfc_free (el); + } +} + +static void +gfc_free_finalizer_list (gfc_finalizer* list) +{ + while (list) + { + gfc_finalizer* current = list; + list = list->next; + gfc_free_finalizer (current); + } +} + + /* Free a namespace structure and everything below it. Interface lists associated with intrinsic operators are not freed. These are taken care of when a specific name is freed. */ @@ -2906,6 +2962,7 @@ gfc_free_namespace (gfc_namespace *ns) free_sym_tree (ns->sym_root); free_uop_tree (ns->uop_root); free_common_tree (ns->common_root); + gfc_free_finalizer_list (ns->finalizers); for (cl = ns->cl_list; cl; cl = cl2) { @@ -3664,6 +3721,7 @@ copy_formal_args (gfc_symbol *dest, gfc_symbol *src) /* May need to copy more info for the symbol. */ formal_arg->sym->attr = curr_arg->sym->attr; formal_arg->sym->ts = curr_arg->sym->ts; + formal_arg->sym->as = gfc_copy_array_spec (curr_arg->sym->as); /* If this isn't the first arg, set up the next ptr. For the last arg built, the formal_arg->next will never get set to diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a691ad5ffef..7df192ca88a 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -472,14 +472,14 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping, gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]); gfc_add_block_to_block (&se->pre, &tmpse.pre); gfc_add_block_to_block (&se->post, &tmpse.post); - lower = tmpse.expr; + lower = fold_convert (gfc_array_index_type, tmpse.expr); /* ...and the upper bound. */ gfc_init_se (&tmpse, NULL); gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]); gfc_add_block_to_block (&se->pre, &tmpse.pre); gfc_add_block_to_block (&se->post, &tmpse.post); - upper = tmpse.expr; + upper = fold_convert (gfc_array_index_type, tmpse.expr); /* Set the upper bound of the loop to UPPER - LOWER. */ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, upper, lower); @@ -969,7 +969,6 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, tree offset, gfc_se * se, gfc_expr * expr) { tree tmp; - tree esize; gfc_conv_expr (se, expr); @@ -977,11 +976,17 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, tmp = build_fold_indirect_ref (gfc_conv_descriptor_data_get (desc)); tmp = gfc_build_array_ref (tmp, offset, NULL); - esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc))); - esize = fold_convert (gfc_charlen_type_node, esize); - if (expr->ts.type == BT_CHARACTER) { + int i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false); + tree esize; + + esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc))); + esize = fold_convert (gfc_charlen_type_node, esize); + esize = fold_build2 (TRUNC_DIV_EXPR, gfc_charlen_type_node, esize, + build_int_cst (gfc_charlen_type_node, + gfc_character_kinds[i].bit_size / 8)); + gfc_conv_string_parameter (se); if (POINTER_TYPE_P (TREE_TYPE (tmp))) { diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 990a12789fe..73e14a3f1fa 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1327,9 +1327,7 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr) tree var; tree len; tree tmp; - tree type; tree cond; - tree gfc_int8_type_node = gfc_get_int_type (8); tree fndecl; tree *args; unsigned int num_args; @@ -1337,9 +1335,8 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr) num_args = gfc_intrinsic_argument_list_length (expr) + 2; args = alloca (sizeof (tree) * num_args); - type = build_pointer_type (gfc_character1_type_node); - var = gfc_create_var (type, "pstr"); - len = gfc_create_var (gfc_int8_type_node, "len"); + var = gfc_create_var (pchar_type_node, "pstr"); + len = gfc_create_var (gfc_get_int_type (8), "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (var); @@ -1368,9 +1365,7 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr) tree var; tree len; tree tmp; - tree type; tree cond; - tree gfc_int4_type_node = gfc_get_int_type (4); tree fndecl; tree *args; unsigned int num_args; @@ -1378,9 +1373,8 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr) num_args = gfc_intrinsic_argument_list_length (expr) + 2; args = alloca (sizeof (tree) * num_args); - type = build_pointer_type (gfc_character1_type_node); - var = gfc_create_var (type, "pstr"); - len = gfc_create_var (gfc_int4_type_node, "len"); + var = gfc_create_var (pchar_type_node, "pstr"); + len = gfc_create_var (gfc_get_int_type (4), "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (var); @@ -1411,19 +1405,16 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr) tree var; tree len; tree tmp; - tree type; tree cond; tree fndecl; - tree gfc_int4_type_node = gfc_get_int_type (4); tree *args; unsigned int num_args; num_args = gfc_intrinsic_argument_list_length (expr) + 2; args = alloca (sizeof (tree) * num_args); - type = build_pointer_type (gfc_character1_type_node); - var = gfc_create_var (type, "pstr"); - len = gfc_create_var (gfc_int4_type_node, "len"); + var = gfc_create_var (pchar_type_node, "pstr"); + len = gfc_create_var (gfc_get_int_type (4), "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (var); @@ -1551,7 +1542,7 @@ gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op) /* Create the result variables. */ len = gfc_create_var (gfc_charlen_type_node, "len"); args[0] = build_fold_addr_expr (len); - var = gfc_create_var (build_pointer_type (gfc_character1_type_node), "pstr"); + var = gfc_create_var (gfc_get_pchar_type (expr->ts.kind), "pstr"); args[1] = gfc_build_addr_expr (ppvoid_type_node, var); args[2] = build_int_cst (NULL_TREE, op); args[3] = build_int_cst (NULL_TREE, nargs / 2); @@ -3237,6 +3228,24 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) } +/* Helper function to compute the size of a character variable, + excluding the terminating null characters. The result has + gfc_array_index_type type. */ + +static tree +size_of_string_in_bytes (int kind, tree string_length) +{ + tree bytesize; + int i = gfc_validate_kind (BT_CHARACTER, kind, false); + + bytesize = build_int_cst (gfc_array_index_type, + gfc_character_kinds[i].bit_size / 8); + + return fold_build2 (MULT_EXPR, gfc_array_index_type, bytesize, + fold_convert (gfc_array_index_type, string_length)); +} + + static void gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) { @@ -3249,7 +3258,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) tree tmp; tree lower; tree upper; - /*tree stride;*/ int n; arg = expr->value.function.actual->expr; @@ -3268,8 +3276,8 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) /* Obtain the source word length. */ if (arg->ts.type == BT_CHARACTER) - source_bytes = fold_convert (gfc_array_index_type, - argse.string_length); + source_bytes = size_of_string_in_bytes (arg->ts.kind, + argse.string_length); else source_bytes = fold_convert (gfc_array_index_type, size_in_bytes (type)); @@ -3283,7 +3291,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) /* Obtain the argument's word length. */ if (arg->ts.type == BT_CHARACTER) - tmp = fold_convert (gfc_array_index_type, argse.string_length); + tmp = size_of_string_in_bytes (arg->ts.kind, argse.string_length); else tmp = fold_convert (gfc_array_index_type, size_in_bytes (type)); @@ -3404,7 +3412,8 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) /* Obtain the source word length. */ if (arg->expr->ts.type == BT_CHARACTER) - tmp = fold_convert (gfc_array_index_type, argse.string_length); + tmp = size_of_string_in_bytes (arg->expr->ts.kind, + argse.string_length); else tmp = fold_convert (gfc_array_index_type, size_in_bytes (source_type)); @@ -3443,7 +3452,8 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) /* Obtain the source word length. */ if (arg->expr->ts.type == BT_CHARACTER) - tmp = fold_convert (gfc_array_index_type, argse.string_length); + tmp = size_of_string_in_bytes (arg->expr->ts.kind, + argse.string_length); else tmp = fold_convert (gfc_array_index_type, size_in_bytes (source_type)); @@ -3495,7 +3505,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) if (arg->expr->ts.type == BT_CHARACTER) { - tmp = fold_convert (gfc_array_index_type, argse.string_length); + tmp = size_of_string_in_bytes (arg->expr->ts.kind, argse.string_length); mold_type = gfc_get_character_type_len (arg->expr->ts.kind, tmp); } else @@ -3869,12 +3879,10 @@ gfc_conv_intrinsic_sr_kind (gfc_se *se, gfc_expr *expr) static void gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr) { - tree gfc_int4_type_node = gfc_get_int_type (4); tree var; tree len; tree addr; tree tmp; - tree type; tree cond; tree fndecl; tree function; @@ -3884,10 +3892,9 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr) num_args = gfc_intrinsic_argument_list_length (expr) + 2; args = alloca (sizeof (tree) * num_args); - type = build_pointer_type (gfc_character1_type_node); - var = gfc_create_var (type, "pstr"); + var = gfc_create_var (gfc_get_pchar_type (expr->ts.kind), "pstr"); addr = gfc_build_addr_expr (ppvoid_type_node, var); - len = gfc_create_var (gfc_int4_type_node, "len"); + len = gfc_create_var (gfc_get_int_type (4), "len"); gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2); args[0] = build_fold_addr_expr (len); @@ -3928,7 +3935,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) stmtblock_t block, body; int i; - /* We store in charsize the size of an character. */ + /* We store in charsize the size of a character. */ i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false); size = build_int_cst (size_type_node, gfc_character_kinds[i].bit_size / 8); diff --git a/gcc/function.c b/gcc/function.c index 845017f7124..30dd9f302a0 100644 --- a/gcc/function.c +++ b/gcc/function.c @@ -3852,6 +3852,10 @@ allocate_struct_function (tree fndecl, bool abstract_p) if (init_machine_status) cfun->machine = (*init_machine_status) (); +#ifdef OVERRIDE_ABI_FORMAT + OVERRIDE_ABI_FORMAT (fndecl); +#endif + if (fndecl != NULL_TREE) { DECL_STRUCT_FUNCTION (fndecl) = cfun; @@ -4311,7 +4315,7 @@ diddle_return_value (void (*doit) (rtx, void *), void *arg) static void do_clobber_return_reg (rtx reg, void *arg ATTRIBUTE_UNUSED) { - emit_insn (gen_rtx_CLOBBER (VOIDmode, reg)); + emit_clobber (reg); } void @@ -4334,7 +4338,7 @@ clobber_return_register (void) static void do_use_return_reg (rtx reg, void *arg ATTRIBUTE_UNUSED) { - emit_insn (gen_rtx_USE (VOIDmode, reg)); + emit_use (reg); } static void @@ -4740,7 +4744,7 @@ thread_prologue_and_epilogue_insns (void) /* Insert an explicit USE for the frame pointer if the profiling is on and the frame pointer is required. */ if (crtl->profile && frame_pointer_needed) - emit_insn (gen_rtx_USE (VOIDmode, hard_frame_pointer_rtx)); + emit_use (hard_frame_pointer_rtx); /* Retain a map of the prologue insns. */ record_insns (seq, &prologue); diff --git a/gcc/incpath.c b/gcc/incpath.c index e5fe8db23ca..761b1cf6305 100644 --- a/gcc/incpath.c +++ b/gcc/incpath.c @@ -31,13 +31,12 @@ #include "incpath.h" #include "cppdefault.h" -/* Windows does not natively support inodes, and neither does MSDOS. - Cygwin's emulation can generate non-unique inodes, so don't use it. +/* Microsoft Windows does not natively support inodes. VMS has non-numeric inodes. */ #ifdef VMS # define INO_T_EQ(A, B) (!memcmp (&(A), &(B), sizeof (A))) # define INO_T_COPY(DEST, SRC) memcpy(&(DEST), &(SRC), sizeof (SRC)) -#elif !((defined _WIN32 && !defined (_UWIN)) || defined __MSDOS__) +#elif !defined (HOST_LACKS_INODE_NUMBERS) # define INO_T_EQ(A, B) ((A) == (B)) # define INO_T_COPY(DEST, SRC) (DEST) = (SRC) #endif @@ -46,7 +45,7 @@ #define DIRS_EQ(A, B) ((A)->dev == (B)->dev \ && INO_T_EQ((A)->ino, (B)->ino)) #else -#define DIRS_EQ(A, B) (!strcasecmp ((A)->name, (B)->name)) +#define DIRS_EQ(A, B) (!strcmp ((A)->canonical_name, (B)->canonical_name)) #endif static const char dir_separator_str[] = { DIR_SEPARATOR, 0 }; @@ -408,6 +407,9 @@ add_path (char *path, int chain, int cxx_aware, bool user_supplied_p) p = XNEW (cpp_dir); p->next = NULL; p->name = path; +#ifndef INO_T_EQ + p->canonical_name = lrealpath (path); +#endif if (chain == SYSTEM || chain == AFTER) p->sysp = 1 + !cxx_aware; else diff --git a/gcc/lower-subreg.c b/gcc/lower-subreg.c index 219226048ff..a9e7da998a4 100644 --- a/gcc/lower-subreg.c +++ b/gcc/lower-subreg.c @@ -836,7 +836,7 @@ resolve_simple_move (rtx set, rtx insn) unsigned int i; if (REG_P (dest) && !HARD_REGISTER_NUM_P (REGNO (dest))) - emit_insn (gen_rtx_CLOBBER (VOIDmode, dest)); + emit_clobber (dest); for (i = 0; i < words; ++i) emit_move_insn (simplify_gen_subreg_concatn (word_mode, dest, diff --git a/gcc/optabs.c b/gcc/optabs.c index f10b1705dd6..bd054edce18 100644 --- a/gcc/optabs.c +++ b/gcc/optabs.c @@ -329,7 +329,7 @@ widen_operand (rtx op, enum machine_mode mode, enum machine_mode oldmode, part to OP. */ result = gen_reg_rtx (mode); - emit_insn (gen_rtx_CLOBBER (VOIDmode, result)); + emit_clobber (result); emit_move_insn (gen_lowpart (GET_MODE (op), result), op); return result; } @@ -1998,7 +1998,7 @@ expand_binop (enum machine_mode mode, optab binoptab, rtx op0, rtx op1, /* Indicate for flow that the entire target reg is being set. */ if (REG_P (target)) - emit_insn (gen_rtx_CLOBBER (VOIDmode, xtarget)); + emit_clobber (xtarget); /* Do the actual arithmetic. */ for (i = 0; i < nwords; i++) @@ -2755,7 +2755,7 @@ expand_doubleword_bswap (enum machine_mode mode, rtx op, rtx target) if (target == 0) target = gen_reg_rtx (mode); if (REG_P (target)) - emit_insn (gen_rtx_CLOBBER (VOIDmode, target)); + emit_clobber (target); emit_move_insn (operand_subword (target, 0, 1, mode), t0); emit_move_insn (operand_subword (target, 1, 1, mode), t1); @@ -3829,38 +3829,6 @@ no_conflict_move_test (rtx dest, const_rtx set, void *p0) p->must_stay = true; } -/* Encapsulate the block starting at FIRST and ending with LAST, which is - logically equivalent to EQUIV, so it gets manipulated as a unit if it - is possible to do so. */ - -void -maybe_encapsulate_block (rtx first, rtx last, rtx equiv) -{ - if (!flag_non_call_exceptions || !may_trap_p (equiv)) - { - /* We can't attach the REG_LIBCALL and REG_RETVAL notes when the - encapsulated region would not be in one basic block, i.e. when - there is a control_flow_insn_p insn between FIRST and LAST. */ - bool attach_libcall_retval_notes = true; - rtx insn, next = NEXT_INSN (last); - - for (insn = first; insn != next; insn = NEXT_INSN (insn)) - if (control_flow_insn_p (insn)) - { - attach_libcall_retval_notes = false; - break; - } - - if (attach_libcall_retval_notes) - { - REG_NOTES (first) = gen_rtx_INSN_LIST (REG_LIBCALL, last, - REG_NOTES (first)); - REG_NOTES (last) = gen_rtx_INSN_LIST (REG_RETVAL, first, - REG_NOTES (last)); - } - } -} - /* Emit code to make a call to a constant function or a library call. @@ -3872,25 +3840,13 @@ maybe_encapsulate_block (rtx first, rtx last, rtx equiv) loading constants into registers; doing so allows them to be safely cse'ed between blocks. Then we emit all the other insns in the block, followed by an insn to move RESULT to TARGET. This last insn will have a REQ_EQUAL - note with an operand of EQUIV. - - Moving assignments to pseudos outside of the block is done to improve - the generated code, but is not required to generate correct code, - hence being unable to move an assignment is not grounds for not making - a libcall block. There are two reasons why it is safe to leave these - insns inside the block: First, we know that these pseudos cannot be - used in generated RTL outside the block since they are created for - temporary purposes within the block. Second, CSE will not record the - values of anything set inside a libcall block, so we know they must - be dead at the end of the block. - - Except for the first group of insns (the ones setting pseudos), the - block is delimited by REG_RETVAL and REG_LIBCALL notes. */ + note with an operand of EQUIV. */ + void emit_libcall_block (rtx insns, rtx target, rtx result, rtx equiv) { rtx final_dest = target; - rtx prev, next, first, last, insn; + rtx prev, next, last, insn; /* If this is a reg with REG_USERVAR_P set, then it could possibly turn into a MEM later. Protect the libcall block from this change. */ @@ -3936,14 +3892,6 @@ emit_libcall_block (rtx insns, rtx target, rtx result, rtx equiv) for (insn = insns; insn; insn = next) { rtx set = single_set (insn); - rtx note; - - /* Some ports (cris) create a libcall regions at their own. We must - avoid any potential nesting of LIBCALLs. */ - if ((note = find_reg_note (insn, REG_LIBCALL, NULL)) != NULL) - remove_note (insn, note); - if ((note = find_reg_note (insn, REG_RETVAL, NULL)) != NULL) - remove_note (insn, note); next = NEXT_INSN (insn); @@ -3992,25 +3940,9 @@ emit_libcall_block (rtx insns, rtx target, rtx result, rtx equiv) if (optab_handler (mov_optab, GET_MODE (target))->insn_code != CODE_FOR_nothing) set_unique_reg_note (last, REG_EQUAL, copy_rtx (equiv)); - else - { - /* Remove any existing REG_EQUAL note from "last", or else it will - be mistaken for a note referring to the full contents of the - libcall value when found together with the REG_RETVAL note added - below. An existing note can come from an insn expansion at - "last". */ - remove_note (last, find_reg_note (last, REG_EQUAL, NULL_RTX)); - } if (final_dest != target) emit_move_insn (final_dest, target); - - if (prev == 0) - first = get_insns (); - else - first = NEXT_INSN (prev); - - maybe_encapsulate_block (first, last, equiv); } /* Nonzero if we can perform a comparison of mode MODE straightforwardly. diff --git a/gcc/optabs.h b/gcc/optabs.h index 0b55c4fc8cc..426b0d845fd 100644 --- a/gcc/optabs.h +++ b/gcc/optabs.h @@ -723,10 +723,6 @@ extern rtx expand_copysign (rtx, rtx, rtx); an input. */ extern void emit_unop_insn (int, rtx, rtx, enum rtx_code); -/* Excapsulate the block in REG_LIBCALL, and REG_RETVAL reg notes and add - REG_LIBCALL_ID notes to all insns in block. */ -extern void maybe_encapsulate_block (rtx, rtx, rtx); - /* Emit one rtl insn to compare two rtx's. */ extern void emit_cmp_insn (rtx, rtx, enum rtx_code, rtx, enum machine_mode, int); diff --git a/gcc/predict.c b/gcc/predict.c index 41743331b9e..42852dcfcac 100644 --- a/gcc/predict.c +++ b/gcc/predict.c @@ -107,6 +107,22 @@ static const struct predictor_info predictor_info[]= { }; #undef DEF_PREDICTOR +/* Return TRUE if frequency FREQ is considered to be hot. */ +static bool +maybe_hot_frequency_p (int freq) +{ + if (!profile_info || !flag_branch_probabilities) + { + if (cfun->function_frequency == FUNCTION_FREQUENCY_UNLIKELY_EXECUTED) + return false; + if (cfun->function_frequency == FUNCTION_FREQUENCY_HOT) + return true; + } + if (freq < BB_FREQ_MAX / PARAM_VALUE (HOT_BB_FREQUENCY_FRACTION)) + return false; + return true; +} + /* Return true in case BB can be CPU intensive and should be optimized for maximal performance. */ @@ -117,16 +133,20 @@ maybe_hot_bb_p (const_basic_block bb) && (bb->count < profile_info->sum_max / PARAM_VALUE (HOT_BB_COUNT_FRACTION))) return false; - if (!profile_info || !flag_branch_probabilities) - { - if (cfun->function_frequency == FUNCTION_FREQUENCY_UNLIKELY_EXECUTED) - return false; - if (cfun->function_frequency == FUNCTION_FREQUENCY_HOT) - return true; - } - if (bb->frequency < BB_FREQ_MAX / PARAM_VALUE (HOT_BB_FREQUENCY_FRACTION)) + return maybe_hot_frequency_p (bb->frequency); +} + +/* Return true in case BB can be CPU intensive and should be optimized + for maximal performance. */ + +bool +maybe_hot_edge_p (edge e) +{ + if (profile_info && flag_branch_probabilities + && (e->count + < profile_info->sum_max / PARAM_VALUE (HOT_BB_COUNT_FRACTION))) return false; - return true; + return maybe_hot_frequency_p (EDGE_FREQUENCY (e)); } /* Return true in case BB is cold and should be optimized for size. */ diff --git a/gcc/reload.c b/gcc/reload.c index 7472272d9c4..ad0a04f6633 100644 --- a/gcc/reload.c +++ b/gcc/reload.c @@ -4083,7 +4083,7 @@ find_reloads (rtx insn, int replace, int ind_levels, int live_known, PUT_MODE (emit_insn_before (gen_rtx_USE (VOIDmode, operand), insn), QImode); if (modified[i] != RELOAD_READ) - emit_insn_after (gen_rtx_CLOBBER (VOIDmode, operand), insn); + emit_insn_after (gen_clobber (operand), insn); } } } diff --git a/gcc/reload1.c b/gcc/reload1.c index 51d3f4c4d19..7f413665747 100644 --- a/gcc/reload1.c +++ b/gcc/reload1.c @@ -3316,14 +3316,13 @@ eliminate_regs_in_insn (rtx insn, int replace) this point. */ *recog_data.operand_loc[i] = 0; - /* If an output operand changed from a REG to a MEM and INSN is an - insn, write a CLOBBER insn. */ + /* If an output operand changed from a REG to a MEM and INSN is an + insn, write a CLOBBER insn. */ if (recog_data.operand_type[i] != OP_IN && REG_P (orig_operand[i]) && MEM_P (substed_operand[i]) && replace) - emit_insn_after (gen_rtx_CLOBBER (VOIDmode, orig_operand[i]), - insn); + emit_insn_after (gen_clobber (orig_operand[i]), insn); } } diff --git a/gcc/rtl.h b/gcc/rtl.h index e9dbb3b8d30..2e0884f8f56 100644 --- a/gcc/rtl.h +++ b/gcc/rtl.h @@ -1609,6 +1609,10 @@ extern rtx emit_label (rtx); extern rtx emit_barrier (void); extern rtx emit_note (enum insn_note); extern rtx emit_note_copy (rtx); +extern rtx gen_clobber (rtx); +extern rtx emit_clobber (rtx); +extern rtx gen_use (rtx); +extern rtx emit_use (rtx); extern rtx make_insn_raw (rtx); extern rtx make_jump_insn_raw (rtx); extern void add_function_usage_to (rtx, rtx); diff --git a/gcc/see.c b/gcc/see.c index dce51691cbe..5084b976559 100644 --- a/gcc/see.c +++ b/gcc/see.c @@ -2554,6 +2554,17 @@ see_def_extension_not_merged (struct see_ref_s *curr_ref_s, rtx def_se) /* The manipulation succeeded. Store the new manipulated reference. */ + /* It is possible for dest_reg to appear multiple times in ref_copy. In this + case, ref_copy now has invalid sharing. Copying solves the problem. + We don't use copy_rtx as an optimization for the common case (no sharing). + We can't just use copy_rtx_if_shared since it does nothing on INSNs. + Another possible solution would be to make validate_replace_rtx_1 + public and use it instead of replace_rtx. */ + reset_used_flags (PATTERN (ref_copy)); + reset_used_flags (REG_NOTES (ref_copy)); + PATTERN (ref_copy) = copy_rtx_if_shared (PATTERN (ref_copy)); + REG_NOTES (ref_copy) = copy_rtx_if_shared (REG_NOTES (ref_copy)); + /* Try to simplify the new manipulated insn. */ validate_simplify_insn (ref_copy); diff --git a/gcc/stmt.c b/gcc/stmt.c index 57e8ad4db7e..00dd59ce463 100644 --- a/gcc/stmt.c +++ b/gcc/stmt.c @@ -1775,11 +1775,11 @@ expand_nl_goto_receiver (void) { /* Clobber the FP when we get here, so we have to make sure it's marked as used by this function. */ - emit_insn (gen_rtx_USE (VOIDmode, hard_frame_pointer_rtx)); + emit_use (hard_frame_pointer_rtx); /* Mark the static chain as clobbered here so life information doesn't get messed up for it. */ - emit_insn (gen_rtx_CLOBBER (VOIDmode, static_chain_rtx)); + emit_clobber (static_chain_rtx); #ifdef HAVE_nonlocal_goto if (! HAVE_nonlocal_goto) diff --git a/gcc/target-def.h b/gcc/target-def.h index 19e882f3787..69b6169bf47 100644 --- a/gcc/target-def.h +++ b/gcc/target-def.h @@ -545,9 +545,7 @@ #define TARGET_PROMOTE_PROTOTYPES hook_bool_const_tree_false #define TARGET_STRUCT_VALUE_RTX hook_rtx_tree_int_null -#ifndef TARGET_RETURN_IN_MEMORY #define TARGET_RETURN_IN_MEMORY default_return_in_memory -#endif #define TARGET_RETURN_IN_MSB hook_bool_const_tree_false #define TARGET_EXPAND_BUILTIN_SAVEREGS default_expand_builtin_saveregs diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d1eb120f035..1f319a0e120 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,227 @@ +2008-06-02 Andy Hutchinson <hutchinsonandy@aim.com> + + * gcc.target/avr/avr.exp: Add avr testsuite. + * gcc.target/avr/trivial.c: Add simple test. + * gcc.target/avr/torture/avr-torture.exp: Add avr-torture testsuite. + * gcc.target/avr/torture/trivial.c: Add simple test. + +2008-06-02 Andy Hutchinson <hutchinsonandy@aim.com> + + * gcc.dg/pr19340.c: Disable for AVR as it has no scheduling. + * gcc.dg/section1.c: XFAIL AVR as bss section is used differently. + +2008-06-02 Andy Hutchinson <hutchinsonandy@aim.com> + + * gcc.dg/pr18241-1.c: Use long on small int target. + * gcc.dg/pr32912-2.c: Ditto. + * gcc.dg/pr35065.c: Ditto. + * gcc.dg/pr36300-1.c: Ditto. + * gcc.dg/pr36300-2.c: Ditto. + * gcc.dg/pr27639.c: Reduce array size for small int target. + * gcc.dg/pr28755.c: Skip test if pointers are smaller than 32 bits. + * gcc.dg/pr36194.c: Reduce constant on small int target. + * gcc.dg/torture/builtin-frexp-1.c: Ditto. + +2008-06-02 Andy Hutchinson <hutchinsonandy@aim.com> + + * gcc.dg/torture/pr34330.c: Skip test for targets without pthread. + * gcc.dg/torture/pr36244.c: Ditto. + * gcc.dg/tree-ssa/pr36181.c: Ditto. + +2008-06-02 Janus Weil <janus@gcc.gnu.org> + + PR fortran/36361 + * gfortran.dg/interface_24.f90: New. + +2008-06-02 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/36404 + * g++.dg/template/crash79.C: New. + * g++.dg/other/pr28114.C: Adjust. + +2008-06-02 Daniel Kraft <d@domob.eu> + + * finalize_1.f08: New test. + * finalize_2.f03: New test. + * finalize_3.f03: New test. + * finalize_4.f03: New test. + * finalize_5.f03: New test. + * finalize_6.f90: New test. + * finalize_7.f03: New test. + * finalize_8.f03: New test. + +2008-06-01 Richard Sandiford <rdsandiford@googlemail.com> + + * gcc.c-torture/execute/ieee/ieee.exp: Load c-torture.exp. + +2008-06-01 Richard Sandiford <rdsandiford@googlemail.com> + + * gcc.target/mips/fpr-moves-7.c: New test. + * gcc.target/mips/fpr-moves-8.c: New test. + +2008-05-30 Bernd Schmidt <bernd.schmidt@analog.com> + + * gcc.target/bfin/mcpu-default.c: Adjust for recent changes: default + CPU has all workarounds, and no longer explicitly sets bf532 as CPU + type. + + * gcc.target/bfin/mcpu-bf531.c: Adjust for WORKAROUND_RETS. + * gcc.target/bfin/mcpu-bf532.c: Likewise. + * gcc.target/bfin/mcpu-bf533.c: Likewise. + * gcc.target/bfin/mcpu-bf534.c: Likewise. + * gcc.target/bfin/mcpu-bf536.c: Likewise. + * gcc.target/bfin/mcpu-bf537.c: Likewise. + * gcc.target/bfin/mcpu-bf548.c: Likewise. + * gcc.target/bfin/mcpu-bf549.c: Likewise. + * gcc.target/bfin/mcpu-bf561.c: Likewise. + * gcc.target/bfin/mcpu-bf523.c: Likewise. + * gcc.target/bfin/mcpu-bf524.c: Likewise. + * gcc.target/bfin/mcpu-bf526.c: Likewise. + * gcc.target/bfin/mcpu-bf522.c: Likewise. + * gcc.target/bfin/mcpu-bf525.c: Likewise. + * gcc.target/bfin/mcpu-bf527.c: Likewise. + * gcc.target/bfin/mcpu-bf538.c: Likewise. + * gcc.target/bfin/mcpu-bf539.c: Likewise. + * gcc.target/bfin/mcpu-bf542.c: Likewise. + * gcc.target/bfin/mcpu-bf544.c: Likewise. + * gcc.target/bfin/mcpu-default.c: Likewise. + * gcc.target/bfin/workarounds-any.c: Likewise. + * gcc.target/bfin/workarounds-none.c: Likewise. + * gcc.target/bfin/workarounds-1.c: Likewise. + * gcc.target/bfin/workarounds-2.c: Likewise. + * gcc.target/bfin/workarounds-3.c: Likewise. + * gcc.target/bfin/workarounds-4.c: Likewise. + +2008-05-30 Tom Tromey <tromey@redhat.com> + + PR preprocessor/36320: + * gcc.dg/cpp/pr36320.c: New file. + +2008-05-29 Paolo Carlini <paolo.carlini@oracle.com> + + PR c++/35243 + * g++.dg/cpp0x/vt-35243.C: New. + +2008-05-29 H.J. Lu <hongjiu.lu@intel.com> + + PR target/35771 + * gcc.dg/torture/pr35771.h: New. + * gcc.dg/torture/pr35771-1.c: Likewise. + * gcc.dg/torture/pr35771-2.c: Likewise. + * gcc.dg/torture/pr35771-3.c: Likewise. + +2008-05-29 Eric Botcazou <ebotcazou@adacore.com> + + * gcc.dg/nested-func-6.c: New test. + +2008-05-29 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/36343 + * gcc.c-torture/execute/pr36343.c: New testcase. + +2008-05-29 Arnaud Charlet <charlet@adacore.com> + + * gnat.dg/abstract1.ad[sb]: New test. + +2008-05-28 Janus Weil <janus@gcc.gnu.org> + + PR fortran/36325 + PR fortran/35830 + * gfortran.dg/interface_23.f90: New. + * gfortran.dg/gomp/reduction3.f90: Fixed invalid code. + * gfortran.dg/proc_decl_12.f90: New: + * gfortran.dg/external_procedures_1.f90: Fixed error message. + +2008-05-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/36319 + * gfortran.dg/widechar_5.f90: New file. + * gfortran.dg/widechar_6.f90: New file. + * gfortran.dg/widechar_7.f90: New file. + * gfortran.dg/widechar_intrinsics_5.f90: Uncomment the lines + testing the SPREAD intrinsic. + * gfortran.dg/widechar_intrinsics_6.f90: New file. + * gfortran.dg/widechar_intrinsics_7.f90: New file. + * gfortran.dg/widechar_intrinsics_8.f90: New file. + * gfortran.dg/widechar_intrinsics_9.f90: New file. + * gfortran.dg/widechar_intrinsics_10.f90: New file. + +2008-05-28 Seongbae Park <seongbae.park@gmail.com> + + * gcc.dg/tree-prof/ic-misattribution-1.c: New test. + * gcc.dg/tree-prof/ic-misattribution-1a.c: New test. + * lib/profopt.exp (profopt-get-options): Support + dg-additional-sources. + (profopt-execute): Handle additional sources. + +2008-05-28 Rafael Espindola <espindola@google.com> + + * gcc.dg/20080528-1.c: New test. + +2008-05-28 Arnaud Charlet <charlet@adacore.com> + + * gnat.dg/old_errors.adb, gnat.dg/deep_old.adb: Adjust. + + * gnat.dg/specs/iface_eq_test.ads, + gnat.dg/specs/iface_eq_test-child.ads: New test. + * gnat.dg/specs/self_class.ads: New test. + * gnat.dg/fixce.adb: New test. + * gnat.dg/frunaligned*.ad[sb]: New test. + +2008-05-27 Andy Hutchinson <hutchinsonandy@aim.com> + + * gcc.dg/tree-ssa/data-dep-1.c: Skip test for avr-*-* too much code. + * gcc.dg/tree-ssa/ldist-3.c: Ditto. + * gcc.dg/tree-ssa/ldist-5.c: Ditto. + * gcc.dg/tree-ssa/ifc-20040816-2 .c: Adjust for int size < 4 bytes. + * gcc.dg/tree-ssa/pr32540-1.c: Ditto. + * gcc.dg/tree-ssa/pr32540-2.c: Ditto. + * gcc.dg/tree-ssa/ssa-lim-5.c: Ditto. + * gcc.dg/tree-ssa/pr23115.c: Adjust test for double size < 8 bytes. + +2008-05-27 H.J. Lu <hongjiu.lu@intel.com> + + PR target/35767 + PR target/35771 + * gcc.target/i386/pr35767-1.c: New. + * gcc.target/i386/pr35767-1d.c: Likewise. + * gcc.target/i386/pr35767-1i.c: Likewise. + * gcc.target/i386/pr35767-2.c: Likewise. + * gcc.target/i386/pr35767-2d.c: Likewise. + * gcc.target/i386/pr35767-2i.c: Likewise. + * gcc.target/i386/pr35767-3.c: Likewise. + * gcc.target/i386/pr35767-4.c: Likewise. + * gcc.target/i386/pr35767-5.c: Likewise. + +2008-05-27 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/assignment_3.f90: Add missing cleanup-modules. + +2008-05-27 Tobias Burnus <burnus@net-b.de> + + PR fortran/36316 + * gfortran.dg/assignment_3.f90: New. + +2008-05-27 Richard Sandiford <rdsandiford@googlemail.com> + + * lib/fortran-torture.exp (get-fortran-torture-options): + New function, replacing old FORTRAN_TORTURE_OPTIONS code. + * gfortran.fortran-torture/compile/compile.exp: Use + [get-fortran-torture-options] instead of $FORTRAN_TORTURE_OPTIONS. + * gfortran.fortran-torture/execute/execute.exp: Likewise. + +2008-05-27 Michael Matz <matz@suse.de> + + PR c++/27975 + * g++.dg/warn/Wenum-compare.C: New testcase. + * g++.dg/warn/Wenum-compare-no.C: Ditto. + +2008-05-27 Richard Guenther <rguenther@suse.de> + + PR tree-optimization/36339 + * gcc.c-torture/execute/pr36339.c: New testcase. + * gcc.dg/tree-ssa/loadpre8.c: XFAIL. + 2008-05-27 Eric Botcazou <ebotcazou@adacore.com> * gnat.dg/pack9.ad[sb]: New test. diff --git a/gcc/testsuite/g++.dg/cpp0x/vt-35243.C b/gcc/testsuite/g++.dg/cpp0x/vt-35243.C new file mode 100644 index 00000000000..4b555744269 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/vt-35243.C @@ -0,0 +1,9 @@ +// { dg-options "-std=c++0x" } +struct A {}; + +template<typename... T> struct B : T... +{ + B() : T(x)... {} // { dg-error "not declared" } +}; + +B<A> b; diff --git a/gcc/testsuite/g++.dg/other/pr28114.C b/gcc/testsuite/g++.dg/other/pr28114.C index 05aeebb8055..e16f6b589e5 100644 --- a/gcc/testsuite/g++.dg/other/pr28114.C +++ b/gcc/testsuite/g++.dg/other/pr28114.C @@ -5,5 +5,5 @@ template<int> void foo(struct {}*); // { dg-error "" } void bar() { - foo<0>(0); // { dg-error "" } + foo<0>(0); } diff --git a/gcc/testsuite/g++.dg/template/crash79.C b/gcc/testsuite/g++.dg/template/crash79.C new file mode 100644 index 00000000000..be71848fe83 --- /dev/null +++ b/gcc/testsuite/g++.dg/template/crash79.C @@ -0,0 +1,9 @@ +// PR c++/36404 + +struct A +{ + A(int); + template<int> enum { e }; // { dg-error "template" } +}; + +A a(A::e); // { dg-error "not a member" } diff --git a/gcc/testsuite/g++.dg/warn/Wenum-compare-no.C b/gcc/testsuite/g++.dg/warn/Wenum-compare-no.C new file mode 100644 index 00000000000..7dc27d3fe72 --- /dev/null +++ b/gcc/testsuite/g++.dg/warn/Wenum-compare-no.C @@ -0,0 +1,10 @@ +/* Test disabling -Wenum-compare (on by default). See PR27975. */ +/* { dg-do compile } */ +/* { dg-options "-Wno-enum-compare" } */ +enum E1 { a }; +enum E2 { b }; + +int foo (E1 e1, E2 e2) +{ + return e1 == e2; /* { dg-bogus "comparison between" } */ +} diff --git a/gcc/testsuite/g++.dg/warn/Wenum-compare.C b/gcc/testsuite/g++.dg/warn/Wenum-compare.C new file mode 100644 index 00000000000..f60080039fb --- /dev/null +++ b/gcc/testsuite/g++.dg/warn/Wenum-compare.C @@ -0,0 +1,10 @@ +/* Test that we get the -Wenum-compare by default. See PR27975. */ +/* { dg-do compile } */ +/* { dg-options "" } */ +enum E1 { a }; +enum E2 { b }; + +int foo (E1 e1, E2 e2) +{ + return e1 == e2; /* { dg-warning "comparison between" } */ +} diff --git a/gcc/testsuite/gcc.c-torture/execute/ieee/ieee.exp b/gcc/testsuite/gcc.c-torture/execute/ieee/ieee.exp index 3d7e56c6b30..2541d402c4c 100644 --- a/gcc/testsuite/gcc.c-torture/execute/ieee/ieee.exp +++ b/gcc/testsuite/gcc.c-torture/execute/ieee/ieee.exp @@ -22,6 +22,7 @@ # Load support procs. load_lib gcc-dg.exp load_lib torture-options.exp +load_lib c-torture.exp # These tests come from Torbjorn Granlund's (tege@cygnus.com) # C torture test suite, and other contributors. diff --git a/gcc/testsuite/gcc.c-torture/execute/pr36339.c b/gcc/testsuite/gcc.c-torture/execute/pr36339.c new file mode 100644 index 00000000000..c4f36ddcace --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr36339.c @@ -0,0 +1,32 @@ +extern void abort (void); + +typedef unsigned long my_uintptr_t; + +int check_a(my_uintptr_t tagged_ptr); + +int __attribute__((noinline)) try_a(my_uintptr_t x) +{ + my_uintptr_t heap[2]; + my_uintptr_t *hp = heap; + + hp[0] = x; + hp[1] = 0; + return check_a((my_uintptr_t)(void*)((char*)hp + 1)); +} + +int __attribute__((noinline)) check_a(my_uintptr_t tagged_ptr) +{ + my_uintptr_t *hp = (my_uintptr_t*)(void*)((char*)tagged_ptr - 1); + + if (hp[0] == 42 && hp[1] == 0) + return 0; + return -1; +} + +int main(void) +{ + if (try_a(42) < 0) + abort (); + return 0; +} + diff --git a/gcc/testsuite/gcc.c-torture/execute/pr36343.c b/gcc/testsuite/gcc.c-torture/execute/pr36343.c new file mode 100644 index 00000000000..44b9fb34075 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr36343.c @@ -0,0 +1,32 @@ +extern void abort (void); + +void __attribute__((noinline)) +bar (int **p) +{ + float *q = (float *)p; + *q = 0.0; +} + +float __attribute__((noinline)) +foo (int b) +{ + int *i = 0; + float f = 1.0; + int **p; + if (b) + p = &i; + else + p = (int **)&f; + bar (p); + if (b) + return **p; + return f; +} + +int main() +{ + if (foo(0) != 0.0) + abort (); + return 0; +} + diff --git a/gcc/testsuite/gcc.dg/20080528-1.c b/gcc/testsuite/gcc.dg/20080528-1.c new file mode 100644 index 00000000000..9fe978051eb --- /dev/null +++ b/gcc/testsuite/gcc.dg/20080528-1.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fsee" } */ + +unsigned long g(int a, int b) { + return a / b; +} +unsigned long f(long int a) { + return g(a, 1<<13); +} diff --git a/gcc/testsuite/gcc.dg/cpp/pr36320.c b/gcc/testsuite/gcc.dg/cpp/pr36320.c new file mode 100644 index 00000000000..d136a69b6b2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/cpp/pr36320.c @@ -0,0 +1,8 @@ +/* PR 36320 - #elif still requires valid expression. */ + +/* { dg-do preprocess } */ + +int z; +#if 1 +#elif /* { dg-error "with no expression" } */ +#endif diff --git a/gcc/testsuite/gcc.dg/nested-func-6.c b/gcc/testsuite/gcc.dg/nested-func-6.c new file mode 100644 index 00000000000..3bae4db352e --- /dev/null +++ b/gcc/testsuite/gcc.dg/nested-func-6.c @@ -0,0 +1,14 @@ +/* { dg-do compile } */ +/* { dg-options "-O -Winline" } */ + +static inline int foo1 (int a) +{ /* { dg-bogus "function not inlinable" } */ + void bar1 (int b) + {} + return a; +} + +int foo2 (int a) +{ + return foo1 (a); +} diff --git a/gcc/testsuite/gcc.dg/pr18241-1.c b/gcc/testsuite/gcc.dg/pr18241-1.c index d6bdbccf8de..a37e77dac64 100644 --- a/gcc/testsuite/gcc.dg/pr18241-1.c +++ b/gcc/testsuite/gcc.dg/pr18241-1.c @@ -27,7 +27,11 @@ static inline void tag_clear(struct radix_tree_node *node, int tag, int offset) { int nr; volatile unsigned long *addr; +#if(__SIZEOF_INT__ >= 4) int mask; +#else + long mask; +#endif nr = offset; addr = &node->tags[tag][0]; diff --git a/gcc/testsuite/gcc.dg/pr19340.c b/gcc/testsuite/gcc.dg/pr19340.c index a5ff410ff48..844d80677d0 100644 --- a/gcc/testsuite/gcc.dg/pr19340.c +++ b/gcc/testsuite/gcc.dg/pr19340.c @@ -1,6 +1,6 @@ /* { dg-do compile } */ /* { dg-options "-O1 -fschedule-insns2 -fsched2-use-traces" } */ -/* { dg-skip-if "No scheduling" { mmix-*-* cris-*-* crisv32-*-* fido-*-* m68k-*-* m32c-*-* } { "*" } { "" } } */ +/* { dg-skip-if "No scheduling" { mmix-*-* cris-*-* crisv32-*-* fido-*-* m68k-*-* m32c-*-* avr-*-* } { "*" } { "" } } */ extern double f (double x); diff --git a/gcc/testsuite/gcc.dg/pr27639.c b/gcc/testsuite/gcc.dg/pr27639.c index 28e4223d81d..cb7b1429d4d 100644 --- a/gcc/testsuite/gcc.dg/pr27639.c +++ b/gcc/testsuite/gcc.dg/pr27639.c @@ -1,8 +1,10 @@ /* { dg-do compile } */ /* { dg-options "-O2 -std=c99" } */ - +#if(__SIZEOF_INT__ >= 4) char heap[50000]; - +#else +char heap[32000]; +#endif int main () { diff --git a/gcc/testsuite/gcc.dg/pr28755.c b/gcc/testsuite/gcc.dg/pr28755.c index 9a01f88d0d9..9cd1330d1dd 100644 --- a/gcc/testsuite/gcc.dg/pr28755.c +++ b/gcc/testsuite/gcc.dg/pr28755.c @@ -1,5 +1,6 @@ /* PR middle-end/28755 */ /* { dg-do compile } */ +/* { dg-require-effective-target ptr32plus } */ /* { dg-options "-Os" } */ /* { dg-final { scan-assembler-times "2112543726\|7deadbee" 2 } } */ diff --git a/gcc/testsuite/gcc.dg/pr32912-2.c b/gcc/testsuite/gcc.dg/pr32912-2.c index 6f028744c60..f3c754cc346 100644 --- a/gcc/testsuite/gcc.dg/pr32912-2.c +++ b/gcc/testsuite/gcc.dg/pr32912-2.c @@ -3,8 +3,11 @@ extern void abort (void); +#if(__SIZEOF_INT__ >= 4) typedef int __m128i __attribute__ ((__vector_size__ (16))); - +#else +typedef long __m128i __attribute__ ((__vector_size__ (16))); +#endif __m128i foo (void) { @@ -22,7 +25,11 @@ bar (void) int main (void) { +#if(__SIZEOF_INT__ >= 4) union { __m128i v; int i[sizeof (__m128i) / sizeof (int)]; } u, v; +#else + union { __m128i v; long i[sizeof (__m128i) / sizeof (long)]; } u, v; +#endif int i; u.v = foo (); diff --git a/gcc/testsuite/gcc.dg/pr35065.c b/gcc/testsuite/gcc.dg/pr35065.c index 3ed46642ffc..e5984ab0f82 100644 --- a/gcc/testsuite/gcc.dg/pr35065.c +++ b/gcc/testsuite/gcc.dg/pr35065.c @@ -5,7 +5,11 @@ typedef int vlc_bool_t; typedef __SIZE_TYPE__ size_t; typedef struct vlc_object_t vlc_object_t; typedef long long int64_t; +#if(__SIZEOF_INT__ >= 4) typedef unsigned int uint32_t; +#else +typedef unsigned long uint32_t; +#endif typedef unsigned char uint8_t; typedef int64_t mtime_t; typedef uint32_t vlc_fourcc_t; diff --git a/gcc/testsuite/gcc.dg/pr36194.c b/gcc/testsuite/gcc.dg/pr36194.c index 3d2195b03d4..070a944e97f 100644 --- a/gcc/testsuite/gcc.dg/pr36194.c +++ b/gcc/testsuite/gcc.dg/pr36194.c @@ -6,7 +6,11 @@ void abort (void); __attribute__ ((noinline)) void f (int i) { +#if(__SIZEOF_INT__ >= 4) if (i != 0x87654321) +#else + if (i != 0x4321) +#endif abort (); asm (""); } diff --git a/gcc/testsuite/gcc.dg/pr36300-1.c b/gcc/testsuite/gcc.dg/pr36300-1.c index 466522f8b79..e737ab7ff0c 100644 --- a/gcc/testsuite/gcc.dg/pr36300-1.c +++ b/gcc/testsuite/gcc.dg/pr36300-1.c @@ -7,10 +7,13 @@ extern void abort (void); int main(void) { - int U1; long long Y, Y2; +#if(__SIZEOF_INT__ >= 4) + int U1; +#else + long U1; +#endif int t; - U1 = -2147483647-1; Y = ((long long)(VALUE * VALUE) * 3); diff --git a/gcc/testsuite/gcc.dg/pr36300-2.c b/gcc/testsuite/gcc.dg/pr36300-2.c index 7e7cfa2b7eb..9543332683e 100644 --- a/gcc/testsuite/gcc.dg/pr36300-2.c +++ b/gcc/testsuite/gcc.dg/pr36300-2.c @@ -7,8 +7,12 @@ extern void abort (void); int main(void) { - int U1; long long Y, Y2; +#if(__SIZEOF_INT__ >= 4) + int U1; +#else + long U1; +#endif unsigned int t; U1 = -2147483647-1; diff --git a/gcc/testsuite/gcc.dg/section1.c b/gcc/testsuite/gcc.dg/section1.c index e907f193b0f..39ca969a572 100644 --- a/gcc/testsuite/gcc.dg/section1.c +++ b/gcc/testsuite/gcc.dg/section1.c @@ -1,5 +1,5 @@ /* PR optimization/6871 */ /* Constant variables belong in .rodata, not .bss. */ -/* { dg-final { scan-assembler-not "\.bss" } } */ +/* { dg-final { scan-assembler-not "\.bss" { xfail avr-*-*} } } */ const int i = 0; diff --git a/gcc/testsuite/gcc.dg/torture/builtin-frexp-1.c b/gcc/testsuite/gcc.dg/torture/builtin-frexp-1.c index cb97e8e4e16..2225f825b82 100644 --- a/gcc/testsuite/gcc.dg/torture/builtin-frexp-1.c +++ b/gcc/testsuite/gcc.dg/torture/builtin-frexp-1.c @@ -34,17 +34,17 @@ extern void link_error(int); /* Test that frexp(ARG,&i) == RES && i == EXP. Check the sign in case we get -0.0. */ #define TESTIT_FREXP(ARG,RES,EXP) do { \ - int i = 123456; \ + int i = 12345; \ if (__builtin_frexpf(ARG##f,&i) != RES##f \ || CKEXP(i,EXP) \ || CKSGN_F(__builtin_frexpf(ARG##f,&i),RES##f)) \ link_error(__LINE__); \ - i = 123456; \ + i = 12345; \ if (__builtin_frexp(ARG,&i) != RES \ || CKEXP(i,EXP) \ || CKSGN(__builtin_frexp(ARG,&i),RES)) \ link_error(__LINE__); \ - i = 123456; \ + i = 12345; \ if (__builtin_frexpl(ARG##l,&i) != RES##l \ || CKEXP(i,EXP) \ || CKSGN_L(__builtin_frexpl(ARG##l,&i),RES##l)) \ diff --git a/gcc/testsuite/gcc.dg/torture/pr34330.c b/gcc/testsuite/gcc.dg/torture/pr34330.c index 85cfe37e8ad..0ed2f9fb395 100644 --- a/gcc/testsuite/gcc.dg/torture/pr34330.c +++ b/gcc/testsuite/gcc.dg/torture/pr34330.c @@ -1,4 +1,5 @@ /* { dg-do compile } */ +/* { dg-require-effective-target pthread } */ /* { dg-options "-ftree-parallelize-loops=4 -ftree-vectorize" } */ struct T diff --git a/gcc/testsuite/gcc.dg/torture/pr35771-1.c b/gcc/testsuite/gcc.dg/torture/pr35771-1.c new file mode 100644 index 00000000000..c88241bcb97 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr35771-1.c @@ -0,0 +1,8 @@ +/* { dg-do run { target i?86-*-* x86_64-*-* } } */ +/* { dg-options "-msse2" } */ + +typedef float __m128 __attribute__ ((__vector_size__ (16), __may_alias__)); + +#define TYPE __m128 + +#include "pr35771.h" diff --git a/gcc/testsuite/gcc.dg/torture/pr35771-2.c b/gcc/testsuite/gcc.dg/torture/pr35771-2.c new file mode 100644 index 00000000000..d036f396e77 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr35771-2.c @@ -0,0 +1,8 @@ +/* { dg-do run { target i?86-*-* x86_64-*-* } } */ +/* { dg-options "-msse2" } */ + +typedef double __m128d __attribute__ ((__vector_size__ (16), __may_alias__)); + +#define TYPE __m128d + +#include "pr35771.h" diff --git a/gcc/testsuite/gcc.dg/torture/pr35771-3.c b/gcc/testsuite/gcc.dg/torture/pr35771-3.c new file mode 100644 index 00000000000..b76c569f499 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr35771-3.c @@ -0,0 +1,8 @@ +/* { dg-do run { target i?86-*-* x86_64-*-* } } */ +/* { dg-options "-msse2" } */ + +typedef long long __m128i __attribute__ ((__vector_size__ (16), __may_alias__)); + +#define TYPE __m128i + +#include "pr35771.h" diff --git a/gcc/testsuite/gcc.dg/torture/pr35771.h b/gcc/testsuite/gcc.dg/torture/pr35771.h new file mode 100644 index 00000000000..01c248751c1 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr35771.h @@ -0,0 +1,40 @@ +typedef TYPE __attribute__((aligned(1))) unaligned; + +#include "cpuid.h" + +extern void abort (void); + + +TYPE __attribute__((noinline)) +foo (TYPE a1, TYPE a2, TYPE a3, TYPE a4, + TYPE a5, TYPE a6, TYPE a7, TYPE a8, + int b1, int b2, int b3, int b4, int b5, int b6, int b7, unaligned y) +{ + return y; +} + +void +do_test (void) +{ + unaligned x; + TYPE y = { 0 }; + x = y; + y = foo (y, y, y, y, y, y, y, y, 1, 2, 3, 4, 5, 6, -1, x); + if (__builtin_memcmp (&y, &x, sizeof (y)) != 0) + abort (); +} + +int +main (void) +{ + unsigned int eax, ebx, ecx, edx; + + if (!__get_cpuid (1, &eax, &ebx, &ecx, &edx)) + return 0; + + /* Run SSE2 test only if host has SSE2 support. */ + if (edx & bit_SSE2) + do_test (); + + return 0; +} diff --git a/gcc/testsuite/gcc.dg/torture/pr36244.c b/gcc/testsuite/gcc.dg/torture/pr36244.c index 9daa29e2f10..b1b14be1891 100644 --- a/gcc/testsuite/gcc.dg/torture/pr36244.c +++ b/gcc/testsuite/gcc.dg/torture/pr36244.c @@ -1,4 +1,5 @@ /* { dg-do compile } */ +/* { dg-require-effective-target pthread } */ /* { dg-options "-O3 -ftree-parallelize-loops=4" } */ struct p7prior_s { diff --git a/gcc/testsuite/gcc.dg/tree-prof/ic-misattribution-1.c b/gcc/testsuite/gcc.dg/tree-prof/ic-misattribution-1.c new file mode 100644 index 00000000000..c36dd8dd052 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-prof/ic-misattribution-1.c @@ -0,0 +1,19 @@ +/* { dg-options "-O2 -fdump-tree-tree_profile" } */ +/* { dg-additional-sources "ic-misattribution-1a.c" } */ + +extern void other_caller (void); + +void +callee (void) +{ + return; +} + +void +caller(void (*func) (void)) +{ + func (); +} + +/* { dg-final-use { scan-tree-dump "hist->count 1 hist->all 1" "tree_profile" } } */ +/* { dg-final-use { cleanup-tree-dump "tree_profile" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-prof/ic-misattribution-1a.c b/gcc/testsuite/gcc.dg/tree-prof/ic-misattribution-1a.c new file mode 100644 index 00000000000..ac54ab13851 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-prof/ic-misattribution-1a.c @@ -0,0 +1,20 @@ +/* { dg-options "-DEMPTY" } */ +/* This file is only needed in combination with ic-misattribution-1.c + but there's no easy way to make this file ignored. */ +extern void callee (void); +extern void caller (void (*func) (void)); + +typedef void (*func_t) (void); +func_t func; + +int +main () +{ +#ifdef EMPTY +#else + func = callee; + caller (callee); + func (); +#endif + return 0; +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/data-dep-1.c b/gcc/testsuite/gcc.dg/tree-ssa/data-dep-1.c index b0225e13ebc..5eb71d9be9e 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/data-dep-1.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/data-dep-1.c @@ -1,4 +1,5 @@ /* { dg-do compile } */ +/* { dg-skip-if "too much code for avr" { "avr-*-*" } { "*" } { "" } } */ /* { dg-options "-O2 -ftree-loop-linear -fdump-tree-ltrans-all" } */ int foo (int n, int m) diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ifc-20040816-2.c b/gcc/testsuite/gcc.dg/tree-ssa/ifc-20040816-2.c index 49cca20857d..f37a4d3361a 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ifc-20040816-2.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ifc-20040816-2.c @@ -11,7 +11,11 @@ void foo(const int * __restrict__ zr_in, { unsigned int pi; int tmp_r, tmp_i, tmp_k; +#if __SIZEOF_INT__ >= 4 for (pi = 0; pi < (512)*(512); pi++) { +#else + for (pi = 0; pi < (32)*(32); pi++) { +#endif int zr = zr_in[pi]; int zi = zi_in[pi]; int zk = zk_in[pi]; diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-3.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-3.c index 524fb4542b8..a76f36fb196 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ldist-3.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-3.c @@ -1,4 +1,5 @@ /* { dg-do compile } */ +/* { dg-skip-if "too much code for avr" { "avr-*-*" } { "*" } { "" } } */ /* { dg-options "-O2 -ftree-loop-distribution -fdump-tree-ldist-all" } */ int loop1 (int k) diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ldist-5.c b/gcc/testsuite/gcc.dg/tree-ssa/ldist-5.c index af74557024e..39b52607179 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ldist-5.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ldist-5.c @@ -1,4 +1,5 @@ /* { dg-do compile } */ +/* { dg-skip-if "too much code for avr" { "avr-*-*" } { "*" } { "" } } */ /* { dg-options "-O2 -ftree-loop-distribution -fdump-tree-ldist-all" } */ int loop1 (int k) diff --git a/gcc/testsuite/gcc.dg/tree-ssa/loadpre8.c b/gcc/testsuite/gcc.dg/tree-ssa/loadpre8.c index a4d2e50c461..6be2b3ec7fd 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/loadpre8.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/loadpre8.c @@ -93,5 +93,5 @@ rewrite_add_phi_arguments (basic_block bb) get_reaching_def ((get_def_from_ptr (get_phi_result_ptr (phi)))->ssa_name.var); } } -/* { dg-final { scan-tree-dump-times "Eliminated: 1" 1 "pre"} } */ +/* { dg-final { scan-tree-dump-times "Eliminated: 1" 1 "pre" { xfail *-*-* } } } */ /* { dg-final { cleanup-tree-dump "pre" } } */ diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr23115.c b/gcc/testsuite/gcc.dg/tree-ssa/pr23115.c index 6a52aafb458..61408e47a80 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/pr23115.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr23115.c @@ -12,9 +12,13 @@ int main() { long j; double R, n, x; - +#if __SIZEOF_DOUBLE__ >= 8 n = 1.e300; x = -1.e300; +#else + n = 1.e30; + x = -1.e30; +#endif for( j=0; j < 2; j++ ) { x = MAX2(x,p[j]); diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr32540-1.c b/gcc/testsuite/gcc.dg/tree-ssa/pr32540-1.c index ce8e0ae824f..f5a444806a1 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/pr32540-1.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr32540-1.c @@ -19,6 +19,7 @@ void acceptloop_th(int *t) { if (f()) options |= 0x1 << 13; if (f()) options |= 0x1 << 14; if (f()) options |= 0x1 << 15; +#if(__SIZEOF_INT__ >= 4) if (f()) options |= 0x1 << 16; if (f()) options |= 0x1 << 17; if (f()) options |= 0x1 << 18; @@ -30,5 +31,6 @@ void acceptloop_th(int *t) { if (f()) options |= 0x1 << 24; if (f()) options |= 0x1 << 25; if (f()) options |= 0x1 << 26; +#endif if (f()) *t = options; } diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr32540-2.c b/gcc/testsuite/gcc.dg/tree-ssa/pr32540-2.c index 29a5e3c55d0..f7fa38de114 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/pr32540-2.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr32540-2.c @@ -19,6 +19,7 @@ void acceptloop_th(int *t, int options) { if (f()) options |= 0x1 << 13; if (f()) options |= 0x1 << 14; if (f()) options |= 0x1 << 15; +#if(__SIZEOF_INT__ >= 4) if (f()) options |= 0x1 << 16; if (f()) options |= 0x1 << 17; if (f()) options |= 0x1 << 18; @@ -30,6 +31,8 @@ void acceptloop_th(int *t, int options) { if (f()) options |= 0x1 << 24; if (f()) options |= 0x1 << 25; if (f()) options |= 0x1 << 26; +#endif if (f()) *t = options; } + diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr36181.c b/gcc/testsuite/gcc.dg/tree-ssa/pr36181.c index 6eda0a4270a..7294c07b14b 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/pr36181.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr36181.c @@ -1,4 +1,5 @@ /* { dg-do compile } */ +/* { dg-require-effective-target pthread } */ /* { dg-options "-O3 -ftree-parallelize-loops=2" } */ int foo () diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-lim-5.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-lim-5.c index 18ca905bf8e..4a428515dd9 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ssa-lim-5.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-lim-5.c @@ -13,10 +13,14 @@ void link_error(); int foo(struct BUF1 * p) { - int i = 0; +#if(__SIZEOF_INT__ >= 4) for (i = 0; i < 1024*1024; i++) +#else + for (i = 0; i < 128*128; i++) +#endif p->b1 = 1; + if (p->b1 != 1) link_error (); return 0; diff --git a/gcc/testsuite/gcc.target/avr/avr.exp b/gcc/testsuite/gcc.target/avr/avr.exp new file mode 100644 index 00000000000..90aeed41e1f --- /dev/null +++ b/gcc/testsuite/gcc.target/avr/avr.exp @@ -0,0 +1,41 @@ +# Copyright (C) 2008 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 testsuite that uses the `dg.exp' driver.
+
+# Exit immediately if this isn't an AVR target.
+if ![istarget avr-*-*] then {
+ return
+}
+
+# Load support procs.
+load_lib gcc-dg.exp
+
+# If a testcase doesn't have special options, use these.
+global DEFAULT_CFLAGS
+if ![info exists DEFAULT_CFLAGS] then {
+ set DEFAULT_CFLAGS " -ansi -pedantic-errors"
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.\[cCS\]]] \
+ "" $DEFAULT_CFLAGS
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gcc.target/avr/torture/avr-torture.exp b/gcc/testsuite/gcc.target/avr/torture/avr-torture.exp new file mode 100644 index 00000000000..355b3ad88bd --- /dev/null +++ b/gcc/testsuite/gcc.target/avr/torture/avr-torture.exp @@ -0,0 +1,61 @@ +# Copyright (C) 2008 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 testsuite that uses the `gcc-dg.exp' driver, looping over
+# optimization options.
+
+# Exit immediately if this isn't a AVR target.
+if { ![istarget avr-*-*] } then {
+ return
+}
+
+# Load support procs.
+load_lib gcc-dg.exp
+
+# If a testcase doesn't have special options, use these.
+global DEFAULT_CFLAGS
+if ![info exists DEFAULT_CFLAGS] then {
+ set DEFAULT_CFLAGS " -ansi -pedantic-errors"
+}
+
+# Initialize `dg'.
+dg-init
+
+ set AVR_TORTURE_OPTIONS [list \
+ { -O0 } \
+ { -O1 } \
+ { -O2 } \
+ { -O2 -mcall-prologues } \
+ { -Os -fomit-frame-pointer } \
+ { -Os -fomit-frame-pointer -finline-functions } \
+ { -O3 -g } \
+ { -Os -mcall-prologues} ]
+
+
+#Initialize use of torture lists.
+torture-init
+
+set-torture-options $AVR_TORTURE_OPTIONS
+
+
+# Main loop.
+gcc-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.\[cS\]]] $DEFAULT_CFLAGS
+
+# Finalize use of torture lists.
+torture-finish
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gcc.target/avr/torture/trivial.c b/gcc/testsuite/gcc.target/avr/torture/trivial.c new file mode 100644 index 00000000000..91163f9226e --- /dev/null +++ b/gcc/testsuite/gcc.target/avr/torture/trivial.c @@ -0,0 +1,14 @@ +/* { dg-do run } */
+#include <stdio.h>
+
+#define __ATTR_PROGMEM__ __attribute__((__progmem__))
+
+#define PROGMEM __ATTR_PROGMEM__
+char PROGMEM a1 = 0x12;
+int PROGMEM a2 = 0x2345;
+long PROGMEM a3 = 0x12345678;
+int main(void)
+{
+ printf("Hello World\n");
+ return 0;
+}
diff --git a/gcc/testsuite/gcc.target/avr/trivial.c b/gcc/testsuite/gcc.target/avr/trivial.c new file mode 100644 index 00000000000..91163f9226e --- /dev/null +++ b/gcc/testsuite/gcc.target/avr/trivial.c @@ -0,0 +1,14 @@ +/* { dg-do run } */
+#include <stdio.h>
+
+#define __ATTR_PROGMEM__ __attribute__((__progmem__))
+
+#define PROGMEM __ATTR_PROGMEM__
+char PROGMEM a1 = 0x12;
+int PROGMEM a2 = 0x2345;
+long PROGMEM a3 = 0x12345678;
+int main(void)
+{
+ printf("Hello World\n");
+ return 0;
+}
diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf522.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf522.c index 5674cab6244..205e37f3651 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf522.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf522.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf523.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf523.c index 09129e94ed2..eb21e6733e4 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf523.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf523.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf524.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf524.c index 6a58061b90e..7be63553889 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf524.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf524.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf525.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf525.c index 1be53666945..21dc2be96fb 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf525.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf525.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf526.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf526.c index bb84afe4a21..bd1197e357b 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf526.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf526.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf527.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf527.c index 50edb81eb3c..d419dd71cfa 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf527.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf527.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf531.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf531.c index efacc5a0ade..9adf99e08e1 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf531.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf531.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf532.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf532.c index 85cad2e87e9..002535a5a15 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf532.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf532.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf533.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf533.c index 9c0478ffb96..a7cf0c6efd7 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf533.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf533.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf534.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf534.c index 89c087ec5ed..cd354596d05 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf534.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf534.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf536.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf536.c index 034296b5433..0ac9ebf9a1b 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf536.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf536.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf537.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf537.c index 9f3d605a86f..66a87c045bf 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf537.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf537.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf538.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf538.c index 57c9be6f308..4baac1a0469 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf538.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf538.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf539.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf539.c index 602bd3a2d0a..756c14d1114 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf539.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf539.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf542.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf542.c index 9ea90c3e82c..f36b16370b4 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf542.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf542.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf544.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf544.c index e76c7cb94e0..d1a0045d503 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf544.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf544.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf547.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf547.c index 9418fd887bb..cdf1995c920 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf547.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf547.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf548.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf548.c index f9ed8b34e34..2689eb21596 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf548.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf548.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf549.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf549.c index 68ad9175983..01e068a3db8 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf549.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf549.c @@ -18,6 +18,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-bf561.c b/gcc/testsuite/gcc.target/bfin/mcpu-bf561.c index 3eb5d4b6ce4..e2eab3ba32a 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-bf561.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-bf561.c @@ -10,8 +10,12 @@ #error "__SILICON_REVISION__ is not 0x0005" #endif -#ifdef __WORKAROUNDS_ENABLED -#error "__WORKAROUNDS_ENABLED is defined" +#ifndef __WORKAROUNDS_ENABLED +#error "__WORKAROUNDS_ENABLED is not defined" +#endif + +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" #endif #ifdef __WORKAROUND_SPECULATIVE_LOADS diff --git a/gcc/testsuite/gcc.target/bfin/mcpu-default.c b/gcc/testsuite/gcc.target/bfin/mcpu-default.c index 5362035b440..9109701cbb8 100644 --- a/gcc/testsuite/gcc.target/bfin/mcpu-default.c +++ b/gcc/testsuite/gcc.target/bfin/mcpu-default.c @@ -2,22 +2,92 @@ /* { dg-do preprocess } */ /* { dg-bfin-options "" } */ -#ifndef __ADSPBF532__ -#error "__ADSPBF532__ is not defined" +#ifdef __ADSPBF522__ +#error "__ADSPBF522__ is defined" #endif +#ifdef __ADSPBF523__ +#error "__ADSPBF523__ is defined" +#endif +#ifdef __ADSPBF524__ +#error "__ADSPBF524__ is defined" +#endif +#ifdef __ADSPBF525__ +#error "__ADSPBF525__ is defined" +#endif +#ifdef __ADSPBF526__ +#error "__ADSPBF526__ is defined" +#endif +#ifdef __ADSPBF527__ +#error "__ADSPBF527__ is defined" +#endif + -#if __SILICON_REVISION__ != 0x0005 -#error "__SILICON_REVISION__ is not 0x0005" +#ifdef __ADSPBF531__ +#error "__ADSPBF531__ is defined" +#endif +#ifdef __ADSPBF532__ +#error "__ADSPBF532__ is defined" +#endif +#ifdef __ADSPBF533__ +#error "__ADSPBF533__ is defined" +#endif +#ifdef __ADSPBF534__ +#error "__ADSPBF534__ is defined" +#endif +#ifdef __ADSPBF536__ +#error "__ADSPBF536__ is defined" +#endif +#ifdef __ADSPBF537__ +#error "__ADSPBF537__ is defined" +#endif +#ifdef __ADSPBF538__ +#error "__ADSPBF538__ is defined" +#endif +#ifdef __ADSPBF539__ +#error "__ADSPBF539__ is defined" +#endif + +#ifdef __ADSPBF542__ +#error "__ADSPBF542__ is defined" +#endif +#ifdef __ADSPBF544__ +#error "__ADSPBF544__ is defined" +#endif +#ifdef __ADSPBF547__ +#error "__ADSPBF547__ is defined" +#endif +#ifdef __ADSPBF548__ +#error "__ADSPBF548__ is defined" +#endif +#ifdef __ADSPBF549__ +#error "__ADSPBF548__ is defined" +#endif + +#ifdef __ADSPBF561__ +#error "__ADSPBF561__ is defined" +#endif + + +#ifndef __SILICON_REVISION__ +#error "__SILICON_REVISION__ is not defined" +#else +#if __SILICON_REVISION__ != 0xffff +#error "__SILICON_REVISION__ is not 0xFFFF" +#endif #endif #ifndef __WORKAROUNDS_ENABLED #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif -#ifdef __WORKAROUND_SPECULATIVE_SYNCS -#error "__WORKAROUND_SPECULATIVE_SYNCS is defined" +#ifndef __WORKAROUND_SPECULATIVE_SYNCS +#error "__WORKAROUND_SPECULATIVE_SYNCS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/workarounds-1.c b/gcc/testsuite/gcc.target/bfin/workarounds-1.c index cf9a8779480..53ca1d7b7e5 100644 --- a/gcc/testsuite/gcc.target/bfin/workarounds-1.c +++ b/gcc/testsuite/gcc.target/bfin/workarounds-1.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/workarounds-2.c b/gcc/testsuite/gcc.target/bfin/workarounds-2.c index b00a6884cdc..c639a204e86 100644 --- a/gcc/testsuite/gcc.target/bfin/workarounds-2.c +++ b/gcc/testsuite/gcc.target/bfin/workarounds-2.c @@ -10,8 +10,12 @@ #error "__SILICON_REVISION__ is not 0x0003" #endif -#ifdef __WORKAROUNDS_ENABLED -#error "__WORKAROUNDS_ENABLED is defined" +#ifndef __WORKAROUNDS_ENABLED +#error "__WORKAROUNDS_ENABLED is not defined" +#endif + +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" #endif #ifdef __WORKAROUND_SPECULATIVE_LOADS diff --git a/gcc/testsuite/gcc.target/bfin/workarounds-3.c b/gcc/testsuite/gcc.target/bfin/workarounds-3.c index d9781bae2fd..3209f234891 100644 --- a/gcc/testsuite/gcc.target/bfin/workarounds-3.c +++ b/gcc/testsuite/gcc.target/bfin/workarounds-3.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is defined" #endif +#ifdef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is defined" +#endif + #ifdef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/workarounds-4.c b/gcc/testsuite/gcc.target/bfin/workarounds-4.c index 50cec9ca7e4..62bd382b7cb 100644 --- a/gcc/testsuite/gcc.target/bfin/workarounds-4.c +++ b/gcc/testsuite/gcc.target/bfin/workarounds-4.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/workarounds-any.c b/gcc/testsuite/gcc.target/bfin/workarounds-any.c index 50cec9ca7e4..62bd382b7cb 100644 --- a/gcc/testsuite/gcc.target/bfin/workarounds-any.c +++ b/gcc/testsuite/gcc.target/bfin/workarounds-any.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is not defined" #endif +#ifndef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is not defined" +#endif + #ifndef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is not defined" #endif diff --git a/gcc/testsuite/gcc.target/bfin/workarounds-none.c b/gcc/testsuite/gcc.target/bfin/workarounds-none.c index d9781bae2fd..3209f234891 100644 --- a/gcc/testsuite/gcc.target/bfin/workarounds-none.c +++ b/gcc/testsuite/gcc.target/bfin/workarounds-none.c @@ -14,6 +14,10 @@ #error "__WORKAROUNDS_ENABLED is defined" #endif +#ifdef __WORKAROUND_RETS +#error "__WORKAROUND_RETS is defined" +#endif + #ifdef __WORKAROUND_SPECULATIVE_LOADS #error "__WORKAROUND_SPECULATIVE_LOADS is defined" #endif diff --git a/gcc/testsuite/gcc.target/i386/pr35767-1.c b/gcc/testsuite/gcc.target/i386/pr35767-1.c new file mode 100644 index 00000000000..5ed5b858866 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr35767-1.c @@ -0,0 +1,25 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -msse2" } */ + +#include "sse2-check.h" + +typedef struct { __m128 f __attribute__((packed)); } packed; + +__m128 __attribute__((noinline)) +foo (__m128 a1, __m128 a2, __m128 a3, __m128 a4, + __m128 a5, __m128 a6, __m128 a7, __m128 a8, + int b1, int b2, int b3, int b4, int b5, int b6, int b7, packed y) +{ + return y.f; +} + +void +sse2_test (void) +{ + packed x; + __m128 y = { 0 }; + x.f = y; + y = foo (y, y, y, y, y, y, y, y, 1, 2, 3, 4, 5, 6, -1, x); + if (__builtin_memcmp (&y, &x.f, sizeof (y)) != 0) + abort (); +} diff --git a/gcc/testsuite/gcc.target/i386/pr35767-1d.c b/gcc/testsuite/gcc.target/i386/pr35767-1d.c new file mode 100644 index 00000000000..cdf17fa61b3 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr35767-1d.c @@ -0,0 +1,25 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -msse2" } */ + +#include "sse2-check.h" + +typedef struct { __m128d f __attribute__((packed)); } packed; + +__m128d __attribute__((noinline)) +foo (__m128d a1, __m128d a2, __m128d a3, __m128d a4, + __m128d a5, __m128d a6, __m128d a7, __m128d a8, + int b1, int b2, int b3, int b4, int b5, int b6, int b7, packed y) +{ + return y.f; +} + +void +sse2_test (void) +{ + packed x; + __m128d y = { 0 }; + x.f = y; + y = foo (y, y, y, y, y, y, y, y, 1, 2, 3, 4, 5, 6, -1, x); + if (__builtin_memcmp (&y, &x.f, sizeof (y)) != 0) + abort (); +} diff --git a/gcc/testsuite/gcc.target/i386/pr35767-1i.c b/gcc/testsuite/gcc.target/i386/pr35767-1i.c new file mode 100644 index 00000000000..188e8e737bd --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr35767-1i.c @@ -0,0 +1,25 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -msse2" } */ + +#include "sse2-check.h" + +typedef struct { __m128i f __attribute__((packed)); } packed; + +__m128i __attribute__((noinline)) +foo (__m128i a1, __m128i a2, __m128i a3, __m128i a4, + __m128i a5, __m128i a6, __m128i a7, __m128i a8, + int b1, int b2, int b3, int b4, int b5, int b6, int b7, packed y) +{ + return y.f; +} + +void +sse2_test (void) +{ + packed x; + __m128i y = { 0 }; + x.f = y; + y = foo (y, y, y, y, y, y, y, y, 1, 2, 3, 4, 5, 6, -1, x); + if (__builtin_memcmp (&y, &x.f, sizeof (y)) != 0) + abort (); +} diff --git a/gcc/testsuite/gcc.target/i386/pr35767-2.c b/gcc/testsuite/gcc.target/i386/pr35767-2.c new file mode 100644 index 00000000000..82062ff9ee7 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr35767-2.c @@ -0,0 +1,25 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -msse2" } */ + +#include "sse2-check.h" + +typedef __m128 __attribute__((aligned(1))) unaligned; + +__m128 __attribute__((noinline)) +foo (__m128 a1, __m128 a2, __m128 a3, __m128 a4, + __m128 a5, __m128 a6, __m128 a7, __m128 a8, + int b1, int b2, int b3, int b4, int b5, int b6, int b7, unaligned y) +{ + return y; +} + +void +sse2_test (void) +{ + unaligned x; + __m128 y = { 0 }; + x = y; + y = foo (y, y, y, y, y, y, y, y, 1, 2, 3, 4, 5, 6, -1, x); + if (__builtin_memcmp (&y, &x, sizeof (y)) != 0) + abort (); +} diff --git a/gcc/testsuite/gcc.target/i386/pr35767-2d.c b/gcc/testsuite/gcc.target/i386/pr35767-2d.c new file mode 100644 index 00000000000..ae96cd852d0 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr35767-2d.c @@ -0,0 +1,25 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -msse2" } */ + +#include "sse2-check.h" + +typedef __m128d __attribute__((aligned(1))) unaligned; + +__m128d __attribute__((noinline)) +foo (__m128d a1, __m128d a2, __m128d a3, __m128d a4, + __m128d a5, __m128d a6, __m128d a7, __m128d a8, + int b1, int b2, int b3, int b4, int b5, int b6, int b7, unaligned y) +{ + return y; +} + +void +sse2_test (void) +{ + unaligned x; + __m128d y = { 0 }; + x = y; + y = foo (y, y, y, y, y, y, y, y, 1, 2, 3, 4, 5, 6, -1, x); + if (__builtin_memcmp (&y, &x, sizeof (y)) != 0) + abort (); +} diff --git a/gcc/testsuite/gcc.target/i386/pr35767-2i.c b/gcc/testsuite/gcc.target/i386/pr35767-2i.c new file mode 100644 index 00000000000..d241644b62b --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr35767-2i.c @@ -0,0 +1,25 @@ +/* { dg-do run } */ +/* { dg-options "-O2 -msse2" } */ + +#include "sse2-check.h" + +typedef __m128i __attribute__((aligned(1))) unaligned; + +__m128i __attribute__((noinline)) +foo (__m128i a1, __m128i a2, __m128i a3, __m128i a4, + __m128i a5, __m128i a6, __m128i a7, __m128i a8, + int b1, int b2, int b3, int b4, int b5, int b6, int b7, unaligned y) +{ + return y; +} + +void +sse2_test (void) +{ + unaligned x; + __m128i y = { 0 }; + x = y; + y = foo (y, y, y, y, y, y, y, y, 1, 2, 3, 4, 5, 6, -1, x); + if (__builtin_memcmp (&y, &x, sizeof (y)) != 0) + abort (); +} diff --git a/gcc/testsuite/gcc.target/i386/pr35767-3.c b/gcc/testsuite/gcc.target/i386/pr35767-3.c new file mode 100644 index 00000000000..e7592ff7bcb --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr35767-3.c @@ -0,0 +1,26 @@ +/* { dg-do run } */ +/* { dg-require-effective-target dfp } */ +/* { dg-options "-O -msse2 -std=gnu99" } */ + +#include "sse2-check.h" + +typedef _Decimal128 unaligned __attribute__((aligned(1))); + +_Decimal128 __attribute__((noinline)) +foo (_Decimal128 a1, _Decimal128 a2, _Decimal128 a3, _Decimal128 a4, + _Decimal128 a5, _Decimal128 a6, _Decimal128 a7, _Decimal128 a8, + int b1, int b2, int b3, int b4, int b5, int b6, int b7, unaligned y) +{ + return y; +} + +void +sse2_test (void) +{ + unaligned x; + _Decimal128 y = -1; + x = y; + y = foo (0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, -1, x); + if (__builtin_memcmp (&y, &x, sizeof (y))) + abort (); +} diff --git a/gcc/testsuite/gcc.target/i386/pr35767-4.c b/gcc/testsuite/gcc.target/i386/pr35767-4.c new file mode 100644 index 00000000000..e12f64ffe98 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr35767-4.c @@ -0,0 +1,14 @@ +/* Test that we generate aligned load when memory is aligned. */ +/* { dg-do compile } */ +/* { dg-require-effective-target dfp } */ +/* { dg-options "-O -march=x86-64 -mtune=generic -std=gnu99" } */ +/* { dg-final { scan-assembler-not "movdqu" } } */ +/* { dg-final { scan-assembler "movdqa" } } */ + +extern _Decimal128 foo (_Decimal128, _Decimal128, _Decimal128); + +void +bar (void) +{ + foo (0, 0, 0); +} diff --git a/gcc/testsuite/gcc.target/i386/pr35767-5.c b/gcc/testsuite/gcc.target/i386/pr35767-5.c new file mode 100644 index 00000000000..4372d2e5746 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr35767-5.c @@ -0,0 +1,17 @@ +/* Test that we generate aligned load when memory is aligned. */ +/* { dg-do compile } */ +/* { dg-options "-O -msse2 -mtune=generic" } */ +/* { dg-final { scan-assembler-not "movups" } } */ +/* { dg-final { scan-assembler "movaps" } } */ + +typedef float v4sf __attribute__ ((__vector_size__ (16))); + +extern void foo(v4sf, v4sf, v4sf, v4sf, v4sf, v4sf, v4sf, v4sf, v4sf); + +int test(void) +{ + v4sf x = { 0.0, 1.0, 2.0, 3.0 }; + + foo (x, x, x, x, x, x, x, x, x); + return 0; +} diff --git a/gcc/testsuite/gcc.target/mips/fpr-moves-7.c b/gcc/testsuite/gcc.target/mips/fpr-moves-7.c new file mode 100644 index 00000000000..4736edd24ee --- /dev/null +++ b/gcc/testsuite/gcc.target/mips/fpr-moves-7.c @@ -0,0 +1,38 @@ +/* { dg-do compile { target mips16_attribute } } */ +/* { dg-mips-options "-mabi=64 -msoft-float -O2 -EL" } */ +/* { dg-add-options mips16_attribute } */ + +extern long double g[16]; +extern unsigned char gstuff[0x10000]; + +NOMIPS16 long double +foo (long double i1, long double i2, long double i3, long double i4, + long double *x, unsigned char *lstuff) +{ + g[0] = i1; + g[1] = i2; + g[2] = i3; + g[3] = i4; + x[0] = x[4]; + x[1] = 0; + x[2] = 1.0; + x[3] = g[4]; + x[4] = *(long double *) (lstuff + 0x7fff); + return *(long double *) (gstuff + 0x7fff); +} + +MIPS16 long double +bar (long double i1, long double i2, long double i3, long double i4, + long double *x, unsigned char *lstuff) +{ + g[0] = i1; + g[1] = i2; + g[2] = i3; + g[3] = i4; + x[0] = x[4]; + x[1] = 0; + x[2] = 1.0; + x[3] = g[4]; + x[4] = *(long double *) (lstuff + 0x7fff); + return *(long double *) (gstuff + 0x7fff); +} diff --git a/gcc/testsuite/gcc.target/mips/fpr-moves-8.c b/gcc/testsuite/gcc.target/mips/fpr-moves-8.c new file mode 100644 index 00000000000..ade9e5e9c0a --- /dev/null +++ b/gcc/testsuite/gcc.target/mips/fpr-moves-8.c @@ -0,0 +1,38 @@ +/* { dg-do compile { target mips16_attribute } } */ +/* { dg-mips-options "-mabi=64 -msoft-float -O2 -EB" } */ +/* { dg-add-options mips16_attribute } */ + +extern long double g[16]; +extern unsigned char gstuff[0x10000]; + +NOMIPS16 long double +foo (long double i1, long double i2, long double i3, long double i4, + long double *x, unsigned char *lstuff) +{ + g[0] = i1; + g[1] = i2; + g[2] = i3; + g[3] = i4; + x[0] = x[4]; + x[1] = 0; + x[2] = 1.0; + x[3] = g[4]; + x[4] = *(long double *) (lstuff + 0x7fff); + return *(long double *) (gstuff + 0x7fff); +} + +MIPS16 long double +bar (long double i1, long double i2, long double i3, long double i4, + long double *x, unsigned char *lstuff) +{ + g[0] = i1; + g[1] = i2; + g[2] = i3; + g[3] = i4; + x[0] = x[4]; + x[1] = 0; + x[2] = 1.0; + x[3] = g[4]; + x[4] = *(long double *) (lstuff + 0x7fff); + return *(long double *) (gstuff + 0x7fff); +} diff --git a/gcc/testsuite/gfortran.dg/assignment_3.f90 b/gcc/testsuite/gfortran.dg/assignment_3.f90 new file mode 100644 index 00000000000..cdaaa8c5a4f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assignment_3.f90 @@ -0,0 +1,63 @@ +! { dg-do compile } +! PR fortran/36316 +! +! gfortran generated a mismatching tree ("type mismatch in binary expression") +! for array bounds (mixing integer kind=4/kind=8 without fold_convert). +! +MODULE YOMCAIN + +IMPLICIT NONE +SAVE + +TYPE distributed_vector +REAL, pointer :: local(:) +INTEGER(4) :: global_length,local_start +INTEGER(8) :: local_end +END TYPE distributed_vector + +INTERFACE ASSIGNMENT (=) +MODULE PROCEDURE assign_ar_dv +END INTERFACE + +INTERFACE OPERATOR (*) +MODULE PROCEDURE multiply_dv_dv +END INTERFACE + +CONTAINS + +SUBROUTINE assign_ar_dv (handle,pvec) + +! copy array to the distributed_vector + +REAL, INTENT(IN) :: pvec(:) +TYPE (distributed_vector), INTENT(INOUT) :: handle + +handle%local(:) = pvec(:) + +RETURN +END SUBROUTINE assign_ar_dv + +FUNCTION multiply_dv_dv (handle1,handle2) + +! multiply two distributed_vectors + +TYPE (distributed_vector), INTENT(IN) :: handle2 +TYPE (distributed_vector), INTENT(IN) :: handle1 +REAL :: multiply_dv_dv(handle1%local_start:handle1%local_end) + +multiply_dv_dv = handle1%local(:) * handle2%local(:) + +RETURN +END FUNCTION multiply_dv_dv + + +SUBROUTINE CAININAD_SCALE_DISTVEC () +TYPE (distributed_vector) :: PVAZG +TYPE (distributed_vector) :: ZTEMP +TYPE (distributed_vector) :: SCALP_DV + +ZTEMP = PVAZG * SCALP_DV +END SUBROUTINE CAININAD_SCALE_DISTVEC +END MODULE YOMCAIN + +! { dg-final { cleanup-modules "yomcain" } } diff --git a/gcc/testsuite/gfortran.dg/external_procedures_1.f90 b/gcc/testsuite/gfortran.dg/external_procedures_1.f90 index 95d0212353e..6e833be16e2 100644 --- a/gcc/testsuite/gfortran.dg/external_procedures_1.f90 +++ b/gcc/testsuite/gfortran.dg/external_procedures_1.f90 @@ -24,7 +24,7 @@ program main interface function ext1 (y) real ext1, y - external ext1 ! { dg-error "EXTERNAL attribute conflicts with FUNCTION" } + external ext1 ! { dg-error "Duplicate EXTERNAL attribute" } end function ext1 end interface inval = 1.0 @@ -38,4 +38,4 @@ contains inv = y * y * y end function inv end program main -
+ diff --git a/gcc/testsuite/gfortran.dg/finalize_1.f08 b/gcc/testsuite/gfortran.dg/finalize_1.f08 new file mode 100644 index 00000000000..e1501ef66b8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_1.f08 @@ -0,0 +1,31 @@ +! { dg-do compile } + +! Parsing of finalizer procedure definitions. +! Check that CONTAINS is allowed in TYPE definition; but empty only for F2008 + +MODULE final_type + IMPLICIT NONE + + TYPE :: mytype + INTEGER, ALLOCATABLE :: fooarr(:) + REAL :: foobar + CONTAINS + END TYPE mytype + +CONTAINS + + SUBROUTINE bar + TYPE :: t + CONTAINS ! This is ok + END TYPE t + ! Nothing + END SUBROUTINE bar + +END MODULE final_type + +PROGRAM finalizer + IMPLICIT NONE + ! Do nothing here +END PROGRAM finalizer + +! { dg-final { cleanup-modules "final_type" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_2.f03 b/gcc/testsuite/gfortran.dg/finalize_2.f03 new file mode 100644 index 00000000000..b91bedff81f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_2.f03 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } + +! Parsing of finalizer procedure definitions. +! Check empty CONTAINS errors out for F2003. + +MODULE final_type + IMPLICIT NONE + + TYPE :: mytype + INTEGER, ALLOCATABLE :: fooarr(:) + REAL :: foobar + CONTAINS + END TYPE mytype ! { dg-error "Fortran 2008" } + +END MODULE final_type + +PROGRAM finalizer + IMPLICIT NONE + ! Do nothing here +END PROGRAM finalizer + +! { dg-final { cleanup-modules "final_type" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_3.f03 b/gcc/testsuite/gfortran.dg/finalize_3.f03 new file mode 100644 index 00000000000..edc493bfca5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_3.f03 @@ -0,0 +1,25 @@ +! { dg-do compile } + +! Parsing of finalizer procedure definitions. +! Check that CONTAINS disallows further components and no double CONTAINS +! is allowed. + +MODULE final_type + IMPLICIT NONE + + TYPE :: mytype + INTEGER, ALLOCATABLE :: fooarr(:) + REAL :: foobar + CONTAINS + CONTAINS ! { dg-error "Already inside a CONTAINS block" } + INTEGER :: x ! { dg-error "must precede CONTAINS" } + END TYPE mytype + +END MODULE final_type + +PROGRAM finalizer + IMPLICIT NONE + ! Do nothing here +END PROGRAM finalizer + +! { dg-final { cleanup-modules "final_type" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_4.f03 b/gcc/testsuite/gfortran.dg/finalize_4.f03 new file mode 100644 index 00000000000..6e99256c252 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_4.f03 @@ -0,0 +1,55 @@ +! { dg-do compile } + +! Parsing of finalizer procedure definitions. +! Check parsing of valid finalizer definitions. + +MODULE final_type + IMPLICIT NONE + + TYPE :: mytype + INTEGER, ALLOCATABLE :: fooarr(:) + REAL :: foobar + CONTAINS + FINAL :: finalize_single + FINAL finalize_vector, finalize_matrix + ! TODO: Test with different kind type parameters once they are implemented. + END TYPE mytype + +CONTAINS + + ELEMENTAL SUBROUTINE finalize_single (el) + IMPLICIT NONE + TYPE(mytype), INTENT(IN) :: el + ! Do nothing in this test + END SUBROUTINE finalize_single + + SUBROUTINE finalize_vector (el) + IMPLICIT NONE + TYPE(mytype), INTENT(INOUT) :: el(:) + ! Do nothing in this test + END SUBROUTINE finalize_vector + + SUBROUTINE finalize_matrix (el) + IMPLICIT NONE + TYPE(mytype) :: el(:, :) + ! Do nothing in this test + END SUBROUTINE finalize_matrix + +END MODULE final_type + +PROGRAM finalizer + USE final_type, ONLY: mytype + IMPLICIT NONE + + TYPE(mytype) :: el, vec(42) + TYPE(mytype), ALLOCATABLE :: mat(:, :) + + ALLOCATE(mat(2, 3)) + DEALLOCATE(mat) + +END PROGRAM finalizer + +! TODO: Remove this once finalization is implemented. +! { dg-excess-errors "not yet implemented" } + +! { dg-final { cleanup-modules "final_type" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_5.f03 b/gcc/testsuite/gfortran.dg/finalize_5.f03 new file mode 100644 index 00000000000..9f5dc1784d0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_5.f03 @@ -0,0 +1,114 @@ +! { dg-do compile } + +! Parsing of finalizer procedure definitions. +! Check for appropriate errors on invalid final procedures. + +MODULE final_type + IMPLICIT NONE + + TYPE :: mytype + INTEGER, ALLOCATABLE :: fooarr(:) + REAL :: foobar + FINAL :: finalize_matrix ! { dg-error "must be inside CONTAINS" } + CONTAINS + FINAL :: ! { dg-error "Empty FINAL" } + FINAL ! { dg-error "Empty FINAL" } + FINAL :: + ! { dg-error "Expected module procedure name" } + FINAL :: iamnot ! { dg-error "is not a SUBROUTINE" } + FINAL :: finalize_single finalize_vector ! { dg-error "Expected ','" } + FINAL :: finalize_single, finalize_vector + FINAL :: finalize_single ! { dg-error "is already defined" } + FINAL :: finalize_vector_2 ! { dg-error "has the same rank" } + FINAL :: finalize_single_2 ! { dg-error "has the same rank" } + FINAL :: bad_function ! { dg-error "is not a SUBROUTINE" } + FINAL bad_num_args_1 ! { dg-error "must have exactly one argument" } + FINAL bad_num_args_2 ! { dg-error "must have exactly one argument" } + FINAL bad_arg_type + FINAL :: bad_pointer + FINAL :: bad_alloc + FINAL :: bad_optional + FINAL :: bad_intent_out + + ! TODO: Test for polymorphism, kind parameters once those are implemented. + END TYPE mytype + +CONTAINS + + SUBROUTINE finalize_single (el) + IMPLICIT NONE + TYPE(mytype) :: el + END SUBROUTINE finalize_single + + ELEMENTAL SUBROUTINE finalize_single_2 (el) + IMPLICIT NONE + TYPE(mytype), INTENT(IN) :: el + END SUBROUTINE finalize_single_2 + + SUBROUTINE finalize_vector (el) + IMPLICIT NONE + TYPE(mytype), INTENT(INOUT) :: el(:) + END SUBROUTINE finalize_vector + + SUBROUTINE finalize_vector_2 (el) + IMPLICIT NONE + TYPE(mytype), INTENT(IN) :: el(:) + END SUBROUTINE finalize_vector_2 + + SUBROUTINE finalize_matrix (el) + IMPLICIT NONE + TYPE(mytype) :: el(:, :) + END SUBROUTINE finalize_matrix + + INTEGER FUNCTION bad_function (el) + IMPLICIT NONE + TYPE(mytype) :: el + + bad_function = 42 + END FUNCTION bad_function + + SUBROUTINE bad_num_args_1 () + IMPLICIT NONE + END SUBROUTINE bad_num_args_1 + + SUBROUTINE bad_num_args_2 (el, x) + IMPLICIT NONE + TYPE(mytype) :: el + COMPLEX :: x + END SUBROUTINE bad_num_args_2 + + SUBROUTINE bad_arg_type (el) ! { dg-error "must be of type 'mytype'" } + IMPLICIT NONE + REAL :: el + END SUBROUTINE bad_arg_type + + SUBROUTINE bad_pointer (el) ! { dg-error "must not be a POINTER" } + IMPLICIT NONE + TYPE(mytype), POINTER :: el + END SUBROUTINE bad_pointer + + SUBROUTINE bad_alloc (el) ! { dg-error "must not be ALLOCATABLE" } + IMPLICIT NONE + TYPE(mytype), ALLOCATABLE :: el(:) + END SUBROUTINE bad_alloc + + SUBROUTINE bad_optional (el) ! { dg-error "must not be OPTIONAL" } + IMPLICIT NONE + TYPE(mytype), OPTIONAL :: el + END SUBROUTINE bad_optional + + SUBROUTINE bad_intent_out (el) ! { dg-error "must not be INTENT\\(OUT\\)" } + IMPLICIT NONE + TYPE(mytype), INTENT(OUT) :: el + END SUBROUTINE bad_intent_out + +END MODULE final_type + +PROGRAM finalizer + IMPLICIT NONE + ! Nothing here, errors above +END PROGRAM finalizer + +! TODO: Remove this once finalization is implemented. +! { dg-excess-errors "not yet implemented" } + +! { dg-final { cleanup-modules "final_type" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_6.f90 b/gcc/testsuite/gfortran.dg/finalize_6.f90 new file mode 100644 index 00000000000..e790f4efb10 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_6.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! { dg-options "-std=f95" } + +! Parsing of finalizer procedure definitions. +! Check that CONTAINS/FINAL in derived types is rejected for F95. + +MODULE final_type + IMPLICIT NONE + + TYPE :: mytype + INTEGER :: fooarr(42) + REAL :: foobar + CONTAINS ! { dg-error "Fortran 2003" } + FINAL :: finalize_single ! { dg-error "Fortran 2003" } + END TYPE mytype + +CONTAINS + + SUBROUTINE finalize_single (el) + IMPLICIT NONE + TYPE(mytype) :: el + ! Do nothing in this test + END SUBROUTINE finalize_single + +END MODULE final_type + +PROGRAM finalizer + IMPLICIT NONE + ! Do nothing +END PROGRAM finalizer + +! TODO: Remove this once finalization is implemented. +! { dg-excess-errors "not yet implemented" } + +! { dg-final { cleanup-modules "final_type" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_7.f03 b/gcc/testsuite/gfortran.dg/finalize_7.f03 new file mode 100644 index 00000000000..db6b4bea948 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_7.f03 @@ -0,0 +1,59 @@ +! { dg-do compile } +! { dg-options "-Wsurprising" } + +! Implementation of finalizer procedures. +! Check for expected warnings on dubious FINAL constructs. + +MODULE final_type + IMPLICIT NONE + + TYPE :: type_1 + INTEGER, ALLOCATABLE :: fooarr(:) + REAL :: foobar + CONTAINS + ! Non-scalar procedures should be assumed shape + FINAL :: fin1_scalar + FINAL :: fin1_shape_1 + FINAL :: fin1_shape_2 + END TYPE type_1 + + TYPE :: type_2 ! { dg-warning "Only array FINAL procedures" } + REAL :: x + CONTAINS + ! No scalar finalizer, only array ones + FINAL :: fin2_vector + END TYPE type_2 + +CONTAINS + + SUBROUTINE fin1_scalar (el) + IMPLICIT NONE + TYPE(type_1) :: el + END SUBROUTINE fin1_scalar + + SUBROUTINE fin1_shape_1 (v) ! { dg-warning "assumed shape" } + IMPLICIT NONE + TYPE(type_1) :: v(*) + END SUBROUTINE fin1_shape_1 + + SUBROUTINE fin1_shape_2 (v) ! { dg-warning "assumed shape" } + IMPLICIT NONE + TYPE(type_1) :: v(42, 5) + END SUBROUTINE fin1_shape_2 + + SUBROUTINE fin2_vector (v) + IMPLICIT NONE + TYPE(type_2) :: v(:) + END SUBROUTINE fin2_vector + +END MODULE final_type + +PROGRAM finalizer + IMPLICIT NONE + ! Nothing here +END PROGRAM finalizer + +! TODO: Remove this once finalization is implemented. +! { dg-excess-errors "not yet implemented" } + +! { dg-final { cleanup-modules "final_type" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_8.f03 b/gcc/testsuite/gfortran.dg/finalize_8.f03 new file mode 100644 index 00000000000..6a4a135e0da --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_8.f03 @@ -0,0 +1,37 @@ +! { dg-do compile } + +! Parsing of finalizer procedure definitions. +! Check that FINAL-declarations are only allowed on types defined in the +! specification part of a module. + +MODULE final_type + IMPLICIT NONE + +CONTAINS + + SUBROUTINE bar + IMPLICIT NONE + + TYPE :: mytype + INTEGER, ALLOCATABLE :: fooarr(:) + REAL :: foobar + CONTAINS + FINAL :: myfinal ! { dg-error "in the specification part of a MODULE" } + END TYPE mytype + + CONTAINS + + SUBROUTINE myfinal (el) + TYPE(mytype) :: el + END SUBROUTINE myfinal + + END SUBROUTINE bar + +END MODULE final_type + +PROGRAM finalizer + IMPLICIT NONE + ! Do nothing here +END PROGRAM finalizer + +! { dg-final { cleanup-modules "final_type" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 index abd6d04415d..0272a741596 100644 --- a/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 @@ -33,11 +33,6 @@ subroutine f2 end subroutine f2 subroutine f3 integer :: i - interface - function ior (a, b) - integer :: ior, a, b - end function - end interface intrinsic ior i = 6 !$omp parallel reduction (ior:i) diff --git a/gcc/testsuite/gfortran.dg/interface_23.f90 b/gcc/testsuite/gfortran.dg/interface_23.f90 new file mode 100644 index 00000000000..60b6e796908 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_23.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! +! This tests the fix for PR36325, which corrected for the fact that a +! specific or generic INTERFACE statement implies the EXTERNAL attibute. +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + +module a + interface + subroutine foo + end subroutine + end interface + external foo ! { dg-error "Duplicate EXTERNAL attribute" } +end module + +module b + interface + function sin (x) + real :: sin, x + end function + end interface + intrinsic sin ! { dg-error "EXTERNAL attribute conflicts with INTRINSIC attribute" } +end module + +! argument checking was not done for external procedures with explicit interface +program c + interface + subroutine bar(x) + real :: x + end subroutine + end interface + call bar() ! { dg-error "Missing actual argument" } +end program + +! { dg-final { cleanup-modules "a b" } } diff --git a/gcc/testsuite/gfortran.dg/interface_24.f90 b/gcc/testsuite/gfortran.dg/interface_24.f90 new file mode 100644 index 00000000000..1afc5ef2fba --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_24.f90 @@ -0,0 +1,66 @@ +! { dg-do compile } +! +! This tests the fix for PR36361: If a function was declared in an INTERFACE +! statement, no attributes may be declared outside of the INTERFACE body. +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + +module m1 + interface + real function f1() + end function + end interface + dimension :: f1(4) ! { dg-error "outside its INTERFACE body" } +end module + + +module m2 + dimension :: f2(4) + interface + real function f2() ! { dg-error "outside its INTERFACE body" } + !end function + end interface +end module + + +! valid +module m3 + interface + real function f3() + dimension :: f3(4) + end function + end interface +end module + + +module m4 + interface + function f4() ! { dg-error "cannot have a deferred shape" } + real :: f4(:) + end function + end interface + allocatable :: f4 ! { dg-error "outside of INTERFACE body" } +end module + + +module m5 + allocatable :: f5(:) + interface + function f5() ! { dg-error "outside its INTERFACE body" } + !real f5(:) + !end function + end interface +end module + + +!valid +module m6 + interface + function f6() + real f6(:) + allocatable :: f6 + end function + end interface +end module + +! { dg-final { cleanup-modules "m1 m2 m3 m4 m5 m6" } } diff --git a/gcc/testsuite/gfortran.dg/proc_decl_12.f90 b/gcc/testsuite/gfortran.dg/proc_decl_12.f90 new file mode 100644 index 00000000000..092c24d3614 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_decl_12.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! +! This tests the (partial) fix for PR35830, i.e. handling array arguments +! with the PROCEDURE statement. +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + +module m +contains + subroutine one(a) + integer a(1:3) + if (any(a /= [1,2,3])) call abort() + end subroutine one +end module m + +program test + use m + implicit none + call foo(one) +contains + subroutine foo(f) + procedure(one) :: f + call f([1,2,3]) + end subroutine foo +end program test + +! { dg-final { cleanup-modules "m" } } diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_8.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_8.f03 index 995fd806a96..4b0bce779db 100644 --- a/gcc/testsuite/gfortran.dg/structure_constructor_8.f03 +++ b/gcc/testsuite/gfortran.dg/structure_constructor_8.f03 @@ -58,4 +58,4 @@ PROGRAM test WRITE (*,*) ispriv_t (5) ! { dg-error "has no IMPLICIT type" } END PROGRAM test -! { dg-final { cleanup-modules privmod } } +! { dg-final { cleanup-modules "privmod" } } diff --git a/gcc/testsuite/gfortran.dg/widechar_5.f90 b/gcc/testsuite/gfortran.dg/widechar_5.f90 new file mode 100644 index 00000000000..ed2f32fbd09 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/widechar_5.f90 @@ -0,0 +1,59 @@ +! { dg-do run } +! { dg-options "-fbackslash" } + +module kinds + implicit none + integer, parameter :: one = 1, four = 4 +end module kinds + +module inner + use kinds + implicit none + character(kind=one,len=*), parameter :: inner1 = "abcdefg \xEF kl" + character(kind=four,len=*), parameter :: & + inner4 = 4_"\u9317x \U001298cef dea\u10De" +end module inner + +module middle + use inner + implicit none + character(kind=one,len=len(inner1)), dimension(2,2), parameter :: middle1 & + = reshape ([ character(kind=one,len=len(inner1)) :: inner1, ""], & + [ 2, 2 ], & + [ character(kind=one,len=len(inner1)) :: "foo", "ba " ]) + character(kind=four,len=len(inner4)), dimension(2,2), parameter :: middle4 & + = reshape ([ character(kind=four,len=len(inner4)) :: inner4, 4_""], & + [ 2, 2 ], & + [ character(kind=four,len=len(inner4)) :: 4_"foo", 4_"ba " ]) +end module middle + +module outer + use middle + implicit none + character(kind=one,len=*), parameter :: my1(2) = middle1(1,:) + character(kind=four,len=*), parameter :: my4(2) = middle4(1,:) +end module outer + +program test_modules + use outer, outer1 => my1, outer4 => my4 + implicit none + + if (len (inner1) /= len(inner4)) call abort + if (len (inner1) /= len_trim(inner1)) call abort + if (len (inner4) /= len_trim(inner4)) call abort + + if (len(middle1) /= len(inner1)) call abort + if (len(outer1) /= len(inner1)) call abort + if (len(middle4) /= len(inner4)) call abort + if (len(outer4) /= len(inner4)) call abort + + if (any (len_trim (middle1) /= reshape([len(middle1), 0, 3, 2], [2,2]))) & + call abort + if (any (len_trim (middle4) /= reshape([len(middle4), 0, 3, 2], [2,2]))) & + call abort + if (any (len_trim (outer1) /= [len(outer1), 3])) call abort + if (any (len_trim (outer4) /= [len(outer4), 3])) call abort + +end program test_modules + +! { dg-final { cleanup-modules "kinds inner middle outer" } } diff --git a/gcc/testsuite/gfortran.dg/widechar_6.f90 b/gcc/testsuite/gfortran.dg/widechar_6.f90 new file mode 100644 index 00000000000..9151adba418 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/widechar_6.f90 @@ -0,0 +1,64 @@ +! { dg-do run } + +module mod + + interface cut + module procedure cut1 + module procedure cut4 + end interface cut + +contains + + function cut1 (s) + character(kind=1,len=*), intent(in) :: s + character(kind=1,len=max(0,len(s)-3)) :: cut1 + + cut1 = s(4:) + end function cut1 + + function cut4 (s) + character(kind=4,len=*), intent(in) :: s + character(kind=4,len=max(0,len(s)-3)) :: cut4 + + cut4 = s(4:) + end function cut4 + +end module mod + +program test + use mod + + if (len (cut1("")) /= 0 .or. cut1("") /= "") call abort + if (len (cut1("1")) /= 0 .or. cut1("") /= "") call abort + if (len (cut1("12")) /= 0 .or. cut1("") /= "") call abort + if (len (cut1("123")) /= 0 .or. cut1("") /= "") call abort + if (len (cut1("1234")) /= 1 .or. cut1("4") /= "") call abort + if (len (cut1("12345")) /= 2 .or. cut1("45") /= "") call abort + + if (len (cut4(4_"")) /= 0 .or. cut4(4_"") /= 4_"") call abort + if (len (cut4(4_"1")) /= 0 .or. cut4(4_"") /= 4_"") call abort + if (len (cut4(4_"12")) /= 0 .or. cut4(4_"") /= 4_"") call abort + if (len (cut4(4_"123")) /= 0 .or. cut4(4_"") /= 4_"") call abort + if (len (cut4(4_"1234")) /= 1 .or. cut4(4_"4") /= 4_"") call abort + if (len (cut4(4_"12345")) /= 2 .or. cut4(4_"45") /= 4_"") call abort + + if (kind (cut("")) /= kind("")) call abort + if (kind (cut(4_"")) /= kind(4_"")) call abort + + if (len (cut("")) /= 0 .or. cut("") /= "") call abort + if (len (cut("1")) /= 0 .or. cut("") /= "") call abort + if (len (cut("12")) /= 0 .or. cut("") /= "") call abort + if (len (cut("123")) /= 0 .or. cut("") /= "") call abort + if (len (cut("1234")) /= 1 .or. cut("4") /= "") call abort + if (len (cut("12345")) /= 2 .or. cut("45") /= "") call abort + + if (len (cut(4_"")) /= 0 .or. cut(4_"") /= 4_"") call abort + if (len (cut(4_"1")) /= 0 .or. cut(4_"") /= 4_"") call abort + if (len (cut(4_"12")) /= 0 .or. cut(4_"") /= 4_"") call abort + if (len (cut(4_"123")) /= 0 .or. cut(4_"") /= 4_"") call abort + if (len (cut(4_"1234")) /= 1 .or. cut(4_"4") /= 4_"") call abort + if (len (cut(4_"12345")) /= 2 .or. cut(4_"45") /= 4_"") call abort + +end program test + +! { dg-final { cleanup-modules "mod" } } diff --git a/gcc/testsuite/gfortran.dg/widechar_7.f90 b/gcc/testsuite/gfortran.dg/widechar_7.f90 new file mode 100644 index 00000000000..4368321170b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/widechar_7.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } + +program test + + character(kind=1,len=10) :: s1 = 4_"foobargee", t1 = 4_"" + character(kind=4,len=10) :: s4 = "foobargee", t4 = "" + + t1(5:5) = s1(6:6) + t4(5:5) = s4(6:6) + t4(5:5) = s1(6:6) + t1(5:5) = s4(6:6) + + call sub (t1, t4) + +end program test + +! { dg-final { scan-tree-dump-times "memmove" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_10.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_10.f90 new file mode 100644 index 00000000000..c961d93cfd6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_10.f90 @@ -0,0 +1,89 @@ +! { dg-do run } +! { dg-options "-fbackslash" } + + implicit none + character(kind=1,len=3) :: s1(3) + character(kind=4,len=3) :: s4(3) + + s1 = [ "abc", "def", "ghi" ] + s4 = s1 + s4 = [ "abc", "def", "ghi" ] + + if (any (cshift (s1, 0) /= s1)) call abort + if (any (cshift (s4, 0) /= s4)) call abort + if (any (cshift (s1, 3) /= s1)) call abort + if (any (cshift (s4, 3) /= s4)) call abort + if (any (cshift (s1, 6) /= s1)) call abort + if (any (cshift (s4, 6) /= s4)) call abort + if (any (cshift (s1, -3) /= s1)) call abort + if (any (cshift (s4, -3) /= s4)) call abort + if (any (cshift (s1, -6) /= s1)) call abort + if (any (cshift (s4, -6) /= s4)) call abort + + if (any (cshift (s1, 1) /= [ s1(2:3), s1(1) ])) call abort + if (any (cshift (s1, -1) /= [ s1(3), s1(1:2) ])) call abort + if (any (cshift (s1, 4) /= [ s1(2:3), s1(1) ])) call abort + if (any (cshift (s1, -4) /= [ s1(3), s1(1:2) ])) call abort + + if (any (cshift (s4, 1) /= [ s4(2:3), s4(1) ])) call abort + if (any (cshift (s4, -1) /= [ s4(3), s4(1:2) ])) call abort + if (any (cshift (s4, 4) /= [ s4(2:3), s4(1) ])) call abort + if (any (cshift (s4, -4) /= [ s4(3), s4(1:2) ])) call abort + + if (any (cshift (s1, 2) /= [ s1(3), s1(1:2) ])) call abort + if (any (cshift (s1, -2) /= [ s1(2:3), s1(1) ])) call abort + if (any (cshift (s1, 5) /= [ s1(3), s1(1:2) ])) call abort + if (any (cshift (s1, -5) /= [ s1(2:3), s1(1) ])) call abort + + if (any (cshift (s4, 2) /= [ s4(3), s4(1:2) ])) call abort + if (any (cshift (s4, -2) /= [ s4(2:3), s4(1) ])) call abort + if (any (cshift (s4, 5) /= [ s4(3), s4(1:2) ])) call abort + if (any (cshift (s4, -5) /= [ s4(2:3), s4(1) ])) call abort + + + if (any (eoshift (s1, 0) /= s1)) call abort + if (any (eoshift (s4, 0) /= s4)) call abort + if (any (eoshift (s1, 3) /= "")) call abort + if (any (eoshift (s4, 3) /= 4_"")) call abort + if (any (eoshift (s1, 3, " ") /= "")) call abort + if (any (eoshift (s4, 3, 4_" ") /= 4_"")) call abort + if (any (eoshift (s1, 3, " x ") /= " x")) call abort + if (any (eoshift (s4, 3, 4_" x ") /= 4_" x")) call abort + if (any (eoshift (s1, -3) /= "")) call abort + if (any (eoshift (s4, -3) /= 4_"")) call abort + if (any (eoshift (s1, -3, " ") /= "")) call abort + if (any (eoshift (s4, -3, 4_" ") /= 4_"")) call abort + if (any (eoshift (s1, -3, " x ") /= " x")) call abort + if (any (eoshift (s4, -3, 4_" x ") /= 4_" x")) call abort + if (any (eoshift (s1, 4) /= "")) call abort + if (any (eoshift (s4, 4) /= 4_"")) call abort + if (any (eoshift (s1, 4, " ") /= "")) call abort + if (any (eoshift (s4, 4, 4_" ") /= 4_"")) call abort + if (any (eoshift (s1, 4, " x ") /= " x")) call abort + if (any (eoshift (s4, 4, 4_" x ") /= 4_" x")) call abort + if (any (eoshift (s1, -4) /= "")) call abort + if (any (eoshift (s4, -4) /= 4_"")) call abort + if (any (eoshift (s1, -4, " ") /= "")) call abort + if (any (eoshift (s4, -4, 4_" ") /= 4_"")) call abort + if (any (eoshift (s1, -4, " x ") /= " x")) call abort + if (any (eoshift (s4, -4, 4_" x ") /= 4_" x")) call abort + + if (any (eoshift (s1, 1) /= [ s1(2:3), " " ])) call abort + if (any (eoshift (s1, -1) /= [ " ", s1(1:2) ])) call abort + if (any (eoshift (s1, 1, " x ") /= [ s1(2:3), " x " ])) call abort + if (any (eoshift (s1, -1, " x ") /= [ " x ", s1(1:2) ])) call abort + if (any (eoshift (s4, 1) /= [ s4(2:3), 4_" " ])) call abort + if (any (eoshift (s4, -1) /= [ 4_" ", s4(1:2) ])) call abort + if (any (eoshift (s4, 1, 4_" x ") /= [ s4(2:3), 4_" x " ])) call abort + if (any (eoshift (s4, -1, 4_" x ") /= [ 4_" x ", s4(1:2) ])) call abort + + if (any (eoshift (s1, 2) /= [ s1(3), " ", " " ])) call abort + if (any (eoshift (s1, -2) /= [ " ", " ", s1(1) ])) call abort + if (any (eoshift (s1, 2, " x ") /= [ s1(3), " x ", " x " ])) call abort + if (any (eoshift (s1, -2, " x ") /= [ " x ", " x ", s1(1) ])) call abort + if (any (eoshift (s4, 2) /= [ s4(3), 4_" ", 4_" " ])) call abort + if (any (eoshift (s4, -2) /= [ 4_" ", 4_" ", s4(1) ])) call abort + if (any (eoshift (s4, 2, 4_" x ") /= [ s4(3), 4_" x ", 4_" x " ])) call abort + if (any (eoshift (s4, -2, 4_" x ") /= [ 4_" x ", 4_" x ", s4(1) ])) call abort + +end diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90 index 5c989cc25b3..e388685adf6 100644 --- a/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90 +++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90 @@ -70,15 +70,13 @@ if (any(transpose(m2) /= transpose(m1))) call abort deallocate (m2) - ! Tests below should be uncommented when PR36257 is fixed. - ! - !allocate (m2(3,3)) - !m2 = p - !m1 = m2 - !if (any (spread ( p, 1, 2) /= spread (m1, 1, 2))) call abort - !if (any (spread ( p, 1, 2) /= spread (m2, 1, 2))) call abort - !if (any (spread (m1, 1, 2) /= spread (m2, 1, 2))) call abort - !deallocate (m2) + allocate (m2(3,3)) + m2 = p + m1 = m2 + if (any (spread ( p, 1, 2) /= spread (m1, 1, 2))) call abort + if (any (spread ( p, 1, 2) /= spread (m2, 1, 2))) call abort + if (any (spread (m1, 1, 2) /= spread (m2, 1, 2))) call abort + deallocate (m2) allocate (m2(3,3)) m2 = p diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_6.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_6.f90 new file mode 100644 index 00000000000..68b46d8f608 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_6.f90 @@ -0,0 +1,109 @@ +! { dg-do run } +! { dg-options "-fbackslash" } + + character(kind=1, len=3) :: s1 + character(kind=4, len=3) :: s4 + integer :: i + + s1 = "fo " + s4 = 4_"fo " + i = 3 + + ! Check the REPEAT intrinsic + + if (repeat (1_"foo", 2) /= 1_"foofoo") call abort + if (repeat (1_"fo ", 2) /= 1_"fo fo ") call abort + if (repeat (1_"fo ", 2) /= 1_"fo fo") call abort + if (repeat (1_"fo ", 0) /= 1_"") call abort + if (repeat (s1, 2) /= 1_"fo fo ") call abort + if (repeat (s1, 2) /= 1_"fo fo") call abort + if (repeat (s1, 2) /= s1 // s1) call abort + if (repeat (s1, 3) /= s1 // s1 // s1) call abort + if (repeat (s1, 1) /= s1) call abort + if (repeat (s1, 0) /= "") call abort + + if (repeat (4_"foo", 2) /= 4_"foofoo") call abort + if (repeat (4_"fo ", 2) /= 4_"fo fo ") call abort + if (repeat (4_"fo ", 2) /= 4_"fo fo") call abort + if (repeat (4_"fo ", 0) /= 4_"") call abort + if (repeat (s4, 2) /= 4_"fo fo ") call abort + if (repeat (s4, 2) /= 4_"fo fo") call abort + if (repeat (s4, 3) /= s4 // s4 // s4) call abort + if (repeat (s4, 1) /= s4) call abort + if (repeat (s4, 0) /= 4_"") call abort + + call check_repeat (s1, s4) + call check_repeat ("", 4_"") + call check_repeat ("truc", 4_"truc") + call check_repeat ("truc ", 4_"truc ") + + ! Check NEW_LINE + + if (ichar(new_line ("")) /= 10) call abort + if (len(new_line ("")) /= 1) call abort + if (ichar(new_line (s1)) /= 10) call abort + if (len(new_line (s1)) /= 1) call abort + if (ichar(new_line (["",""])) /= 10) call abort + if (len(new_line (["",""])) /= 1) call abort + if (ichar(new_line ([s1,s1])) /= 10) call abort + if (len(new_line ([s1,s1])) /= 1) call abort + + if (ichar(new_line (4_"")) /= 10) call abort + if (len(new_line (4_"")) /= 1) call abort + if (ichar(new_line (s4)) /= 10) call abort + if (len(new_line (s4)) /= 1) call abort + if (ichar(new_line ([4_"",4_""])) /= 10) call abort + if (len(new_line ([4_"",4_""])) /= 1) call abort + if (ichar(new_line ([s4,s4])) /= 10) call abort + if (len(new_line ([s4,s4])) /= 1) call abort + + ! Check SIZEOF + + if (sizeof ("") /= 0) call abort + if (sizeof (4_"") /= 0) call abort + if (sizeof ("x") /= 1) call abort + if (sizeof ("\xFF") /= 1) call abort + if (sizeof (4_"x") /= 4) call abort + if (sizeof (4_"\UFFFFFFFF") /= 4) call abort + if (sizeof (s1) /= 3) call abort + if (sizeof (s4) /= 12) call abort + + if (sizeof (["a", "x", "z"]) / sizeof ("a") /= 3) call abort + if (sizeof ([4_"a", 4_"x", 4_"z"]) / sizeof (4_"a") /= 3) call abort + + call check_sizeof ("", 4_"", 0) + call check_sizeof ("x", 4_"x", 1) + call check_sizeof ("\xFF", 4_"\UFEBCE19E", 1) + call check_sizeof ("\xFF ", 4_"\UFEBCE19E ", 2) + call check_sizeof (s1, s4, 3) + +contains + + subroutine check_repeat (s1, s4) + character(kind=1, len=*), intent(in) :: s1 + character(kind=4, len=*), intent(in) :: s4 + integer :: i + + do i = 0, 10 + if (len (repeat(s1, i)) /= i * len(s1)) call abort + if (len (repeat(s4, i)) /= i * len(s4)) call abort + + if (len_trim (repeat(s1, i)) & + /= max(0, (i - 1) * len(s1) + len_trim (s1))) call abort + if (len_trim (repeat(s4, i)) & + /= max(0, (i - 1) * len(s4) + len_trim (s4))) call abort + end do + end subroutine check_repeat + + subroutine check_sizeof (s1, s4, i) + character(kind=1, len=*), intent(in) :: s1 + character(kind=4, len=*), intent(in) :: s4 + character(kind=4, len=len(s4)) :: t4 + integer, intent(in) :: i + + if (sizeof (s1) /= i) call abort + if (sizeof (s4) / sizeof (4_" ") /= i) call abort + if (sizeof (t4) / sizeof (4_" ") /= i) call abort + end subroutine check_sizeof + +end diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_7.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_7.f90 new file mode 100644 index 00000000000..7971af3963e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_7.f90 @@ -0,0 +1,125 @@ +! { dg-do run } +! { dg-options "-fbackslash" } + + character(kind=1, len=10) :: s1, t1 + character(kind=4, len=10) :: s4, t4 + + call check1("foobargeefoobargee", "arg", & + [ index ("foobargeefoobargee", "arg", .true.), & + index ("foobargeefoobargee", "arg", .false.), & + scan ("foobargeefoobargee", "arg", .true.), & + scan ("foobargeefoobargee", "arg", .false.), & + verify ("foobargeefoobargee", "arg", .true.), & + verify ("foobargeefoobargee", "arg", .false.) ], & + 4_"foobargeefoobargee", 4_"arg", & + [ index (4_"foobargeefoobargee", 4_"arg", .true.), & + index (4_"foobargeefoobargee", 4_"arg", .false.), & + scan (4_"foobargeefoobargee", 4_"arg", .true.), & + scan (4_"foobargeefoobargee", 4_"arg", .false.), & + verify (4_"foobargeefoobargee", 4_"arg", .true.), & + verify (4_"foobargeefoobargee", 4_"arg", .false.) ]) + + call check1("foobargeefoobargee", "", & + [ index ("foobargeefoobargee", "", .true.), & + index ("foobargeefoobargee", "", .false.), & + scan ("foobargeefoobargee", "", .true.), & + scan ("foobargeefoobargee", "", .false.), & + verify ("foobargeefoobargee", "", .true.), & + verify ("foobargeefoobargee", "", .false.) ], & + 4_"foobargeefoobargee", 4_"", & + [ index (4_"foobargeefoobargee", 4_"", .true.), & + index (4_"foobargeefoobargee", 4_"", .false.), & + scan (4_"foobargeefoobargee", 4_"", .true.), & + scan (4_"foobargeefoobargee", 4_"", .false.), & + verify (4_"foobargeefoobargee", 4_"", .true.), & + verify (4_"foobargeefoobargee", 4_"", .false.) ]) + call check1("foobargeefoobargee", "klm", & + [ index ("foobargeefoobargee", "klm", .true.), & + index ("foobargeefoobargee", "klm", .false.), & + scan ("foobargeefoobargee", "klm", .true.), & + scan ("foobargeefoobargee", "klm", .false.), & + verify ("foobargeefoobargee", "klm", .true.), & + verify ("foobargeefoobargee", "klm", .false.) ], & + 4_"foobargeefoobargee", 4_"klm", & + [ index (4_"foobargeefoobargee", 4_"klm", .true.), & + index (4_"foobargeefoobargee", 4_"klm", .false.), & + scan (4_"foobargeefoobargee", 4_"klm", .true.), & + scan (4_"foobargeefoobargee", 4_"klm", .false.), & + verify (4_"foobargeefoobargee", 4_"klm", .true.), & + verify (4_"foobargeefoobargee", 4_"klm", .false.) ]) + call check1("foobargeefoobargee", "gee", & + [ index ("foobargeefoobargee", "gee", .true.), & + index ("foobargeefoobargee", "gee", .false.), & + scan ("foobargeefoobargee", "gee", .true.), & + scan ("foobargeefoobargee", "gee", .false.), & + verify ("foobargeefoobargee", "gee", .true.), & + verify ("foobargeefoobargee", "gee", .false.) ], & + 4_"foobargeefoobargee", 4_"gee", & + [ index (4_"foobargeefoobargee", 4_"gee", .true.), & + index (4_"foobargeefoobargee", 4_"gee", .false.), & + scan (4_"foobargeefoobargee", 4_"gee", .true.), & + scan (4_"foobargeefoobargee", 4_"gee", .false.), & + verify (4_"foobargeefoobargee", 4_"gee", .true.), & + verify (4_"foobargeefoobargee", 4_"gee", .false.) ]) + call check1("foobargeefoobargee", "foo", & + [ index ("foobargeefoobargee", "foo", .true.), & + index ("foobargeefoobargee", "foo", .false.), & + scan ("foobargeefoobargee", "foo", .true.), & + scan ("foobargeefoobargee", "foo", .false.), & + verify ("foobargeefoobargee", "foo", .true.), & + verify ("foobargeefoobargee", "foo", .false.) ], & + 4_"foobargeefoobargee", 4_"foo", & + [ index (4_"foobargeefoobargee", 4_"foo", .true.), & + index (4_"foobargeefoobargee", 4_"foo", .false.), & + scan (4_"foobargeefoobargee", 4_"foo", .true.), & + scan (4_"foobargeefoobargee", 4_"foo", .false.), & + verify (4_"foobargeefoobargee", 4_"foo", .true.), & + verify (4_"foobargeefoobargee", 4_"foo", .false.) ]) + + call check1(" \b fe \b\0 bar cad", " \b\0", & + [ index (" \b fe \b\0 bar cad", " \b\0", .true.), & + index (" \b fe \b\0 bar cad", " \b\0", .false.), & + scan (" \b fe \b\0 bar cad", " \b\0", .true.), & + scan (" \b fe \b\0 bar cad", " \b\0", .false.), & + verify (" \b fe \b\0 bar cad", " \b\0", .true.), & + verify (" \b fe \b\0 bar cad", " \b\0", .false.) ], & + 4_" \uC096 fe \uC096\uB8DE bar cad", 4_" \uC096\uB8DE", & + [ index (4_" \uC096 fe \uC096\uB8DE bar cad", & + 4_" \uC096\uB8DE", .true.), & + index (4_" \uC096 fe \uC096\uB8DE bar cad", & + 4_" \uC096\uB8DE", .false.), & + scan (4_" \uC096 fe \uC096\uB8DE bar cad", & + 4_" \uC096\uB8DE", .true.), & + scan (4_" \uC096 fe \uC096\uB8DE bar cad", & + 4_" \uC096\uB8DE", .false.), & + verify (4_" \uC096 fe \uC096\uB8DE bar cad", & + 4_" \uC096\uB8DE", .true.), & + verify (4_" \uC096 fe \uC096\uB8DE bar cad", & + 4_" \uC096\uB8DE", .false.) ]) + +contains + + subroutine check1 (s1, t1, res1, s4, t4, res4) + character(kind=1, len=*) :: s1, t1 + character(kind=4, len=*) :: s4, t4 + integer :: res1(6), res4(6) + + if (any (res1 /= res4)) call abort + + if (index (s1, t1, .true.) /= res1(1)) call abort + if (index (s1, t1, .false.) /= res1(2)) call abort + if (scan (s1, t1, .true.) /= res1(3)) call abort + if (scan (s1, t1, .false.) /= res1(4)) call abort + if (verify (s1, t1, .true.) /= res1(5)) call abort + if (verify (s1, t1, .false.) /= res1(6)) call abort + + if (index (s4, t4, .true.) /= res4(1)) call abort + if (index (s4, t4, .false.) /= res4(2)) call abort + if (scan (s4, t4, .true.) /= res4(3)) call abort + if (scan (s4, t4, .false.) /= res4(4)) call abort + if (verify (s4, t4, .true.) /= res4(5)) call abort + if (verify (s4, t4, .false.) /= res4(6)) call abort + + end subroutine check1 + +end diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_8.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_8.f90 new file mode 100644 index 00000000000..eeeabbca5af --- /dev/null +++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_8.f90 @@ -0,0 +1,85 @@ +! { dg-do run } +! { dg-options "-fbackslash" } + + logical, parameter :: bigendian = transfer ((/1_1,0_1,0_1,0_1/), 0_4) /= 1 + + character(kind=1,len=3) :: s1, t1, u1 + character(kind=4,len=3) :: s4, t4, u4 + + ! Test MERGE intrinsic + + call check_merge1 ("foo", "gee", .true., .false.) + call check_merge4 (4_"foo", 4_"gee", .true., .false.) + + if (merge ("foo", "gee", .true.) /= "foo") call abort + if (merge ("foo", "gee", .false.) /= "gee") call abort + if (merge (4_"foo", 4_"gee", .true.) /= 4_"foo") call abort + if (merge (4_"foo", 4_"gee", .false.) /= 4_"gee") call abort + + ! Test TRANSFER intrinsic + + if (bigendian) then + if (transfer (4_"x", " ") /= "\0\0\0x") call abort + else + if (transfer (4_"x", " ") /= "x\0\0\0") call abort + endif + if (transfer (4_"\U44444444", " ") /= "\x44\x44\x44\x44") call abort + if (transfer (4_"\U3FE91B5A", 0_4) /= int(z'3FE91B5A', 4)) call abort + + call check_transfer_i (4_"\U3FE91B5A", [int(z'3FE91B5A', 4)]) + call check_transfer_i (4_"\u1B5A", [int(z'1B5A', 4)]) + +contains + + subroutine check_merge1 (s1, t1, t, f) + character(kind=1,len=*) :: s1, t1 + logical :: t, f + + if (merge (s1, t1, .true.) /= s1) call abort + if (merge (s1, t1, .false.) /= t1) call abort + if (len (merge (s1, t1, .true.)) /= len (s1)) call abort + if (len (merge (s1, t1, .false.)) /= len (t1)) call abort + if (len_trim (merge (s1, t1, .true.)) /= len_trim (s1)) call abort + if (len_trim (merge (s1, t1, .false.)) /= len_trim (t1)) call abort + + if (merge (s1, t1, t) /= s1) call abort + if (merge (s1, t1, f) /= t1) call abort + if (len (merge (s1, t1, t)) /= len (s1)) call abort + if (len (merge (s1, t1, f)) /= len (t1)) call abort + if (len_trim (merge (s1, t1, t)) /= len_trim (s1)) call abort + if (len_trim (merge (s1, t1, f)) /= len_trim (t1)) call abort + + end subroutine check_merge1 + + subroutine check_merge4 (s4, t4, t, f) + character(kind=4,len=*) :: s4, t4 + logical :: t, f + + if (merge (s4, t4, .true.) /= s4) call abort + if (merge (s4, t4, .false.) /= t4) call abort + if (len (merge (s4, t4, .true.)) /= len (s4)) call abort + if (len (merge (s4, t4, .false.)) /= len (t4)) call abort + if (len_trim (merge (s4, t4, .true.)) /= len_trim (s4)) call abort + if (len_trim (merge (s4, t4, .false.)) /= len_trim (t4)) call abort + + if (merge (s4, t4, t) /= s4) call abort + if (merge (s4, t4, f) /= t4) call abort + if (len (merge (s4, t4, t)) /= len (s4)) call abort + if (len (merge (s4, t4, f)) /= len (t4)) call abort + if (len_trim (merge (s4, t4, t)) /= len_trim (s4)) call abort + if (len_trim (merge (s4, t4, f)) /= len_trim (t4)) call abort + + end subroutine check_merge4 + + subroutine check_transfer_i (s, i) + character(kind=4,len=*) :: s + integer(kind=4), dimension(len(s)) :: i + + if (transfer (s, 0_4) /= ichar (s(1:1))) call abort + if (transfer (s, 0_4) /= i(1)) call abort + if (any (transfer (s, [0_4]) /= i)) call abort + if (any (transfer (s, 0_4, len(s)) /= i)) call abort + + end subroutine check_transfer_i + +end diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_9.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_9.f90 new file mode 100644 index 00000000000..ca6fa58184e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_9.f90 @@ -0,0 +1,70 @@ +! { dg-do run } +! { dg-options "-fbackslash" } + + implicit none + character(kind=1,len=3) :: s1, t1 + character(kind=4,len=3) :: s4, t4 + + s1 = "foo" ; t1 = "bar" + call check_minmax_1 ("foo", "bar", min("foo","bar"), max("foo","bar")) + call check_minmax_1 ("bar", "foo", min("foo","bar"), max("foo","bar")) + call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1)) + call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1)) + + s1 = " " ; t1 = "bar" + call check_minmax_1 (" ", "bar", min(" ","bar"), max(" ","bar")) + call check_minmax_1 ("bar", " ", min(" ","bar"), max(" ","bar")) + call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1)) + call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1)) + + s1 = " " ; t1 = " " + call check_minmax_1 (" ", " ", min(" "," "), max(" "," ")) + call check_minmax_1 (" ", " ", min(" "," "), max(" "," ")) + call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1)) + call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1)) + + s1 = "d\xFF " ; t1 = "d " + call check_minmax_1 ("d\xFF ", "d ", min("d\xFF ","d "), max("d\xFF ","d ")) + call check_minmax_1 ("d ", "d\xFF ", min("d\xFF ","d "), max("d\xFF ","d ")) + call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1)) + call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1)) + + s4 = 4_" " ; t4 = 4_"xxx" + call check_minmax_2 (4_" ", 4_"xxx", min(4_" ", 4_"xxx"), & + max(4_" ", 4_"xxx")) + call check_minmax_2 (4_"xxx", 4_" ", min(4_" ", 4_"xxx"), & + max(4_" ", 4_"xxx")) + call check_minmax_2 (s4, t4, min(s4,t4), max(s4,t4)) + call check_minmax_2 (t4, s4, min(s4,t4), max(s4,t4)) + + s4 = 4_" \u1be3m" ; t4 = 4_"xxx" + call check_minmax_2 (4_" \u1be3m", 4_"xxx", min(4_" \u1be3m", 4_"xxx"), & + max(4_" \u1be3m", 4_"xxx")) + call check_minmax_2 (4_"xxx", 4_" \u1be3m", min(4_" \u1be3m", 4_"xxx"), & + max(4_" \u1be3m", 4_"xxx")) + call check_minmax_2 (s4, t4, min(s4,t4), max(s4,t4)) + call check_minmax_2 (t4, s4, min(s4,t4), max(s4,t4)) + +contains + + subroutine check_minmax_1 (s1, s2, smin, smax) + implicit none + character(kind=1,len=*), intent(in) :: s1, s2, smin, smax + character(kind=4,len=len(s1)) :: w1, w2, wmin, wmax + + w1 = s1 ; w2 = s2 ; wmin = smin ; wmax = smax + if (min (w1, w2) /= wmin) call abort + if (max (w1, w2) /= wmax) call abort + if (min (s1, s2) /= smin) call abort + if (max (s1, s2) /= smax) call abort + end subroutine check_minmax_1 + + subroutine check_minmax_2 (s1, s2, smin, smax) + implicit none + character(kind=4,len=*), intent(in) :: s1, s2, smin, smax + + if (min (s1, s2) /= smin) call abort + if (max (s1, s2) /= smax) call abort + end subroutine check_minmax_2 + +end diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/compile.exp b/gcc/testsuite/gfortran.fortran-torture/compile/compile.exp index b18e25c5f6f..6c4890d7b72 100644 --- a/gcc/testsuite/gfortran.fortran-torture/compile/compile.exp +++ b/gcc/testsuite/gfortran.fortran-torture/compile/compile.exp @@ -26,7 +26,7 @@ load_lib fortran-torture.exp load_lib torture-options.exp torture-init -set-torture-options $FORTRAN_TORTURE_OPTIONS +set-torture-options [get-fortran-torture-options] foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f]] { # If we're only testing specific files and this isn't one of them, skip it. diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/execute.exp b/gcc/testsuite/gfortran.fortran-torture/execute/execute.exp index 157c2404601..2dd408df2d6 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/execute.exp +++ b/gcc/testsuite/gfortran.fortran-torture/execute/execute.exp @@ -30,7 +30,7 @@ load_lib fortran-torture.exp load_lib torture-options.exp torture-init -set-torture-options $FORTRAN_TORTURE_OPTIONS +set-torture-options [get-fortran-torture-options] foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f]] { # If we're only testing specific files and this isn't one of them, skip it. diff --git a/gcc/testsuite/gnat.dg/abstract1.adb b/gcc/testsuite/gnat.dg/abstract1.adb new file mode 100644 index 00000000000..97508fac2b8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/abstract1.adb @@ -0,0 +1,31 @@ +-- { dg-do compile } +with Ada.Tags.Generic_Dispatching_Constructor; use Ada.Tags; +package body abstract1 is + + function New_T (Stream : not null access Root_Stream_Type'Class) + return T'Class is + function Construct is + new Generic_Dispatching_Constructor (T, Root_Stream_Type'Class, Input); + E : constant String := String'Input (Stream); + I : constant Tag := Internal_Tag (E); + + begin + return Construct (I, Stream); + end New_T; + + function Input (Stream : not null access Root_Stream_Type'Class) + return IT is + begin + return O : IT do + Integer'Read (Stream, O.I); + end return; + end Input; + + function Input (Stream : not null access Root_Stream_Type'Class) + return FT is + begin + return O : FT do + Float'Read (Stream, O.F); + end return; + end Input; +end abstract1; diff --git a/gcc/testsuite/gnat.dg/abstract1.ads b/gcc/testsuite/gnat.dg/abstract1.ads new file mode 100644 index 00000000000..bad9ee69874 --- /dev/null +++ b/gcc/testsuite/gnat.dg/abstract1.ads @@ -0,0 +1,19 @@ +with Ada.Streams; use Ada.Streams; +package abstract1 is + type T is abstract tagged limited null record; + function Input (Stream : not null access Root_Stream_Type'Class) return T + is abstract; + + function New_T (Stream : not null access Root_Stream_Type'Class) + return T'Class; + + type IT is limited new T with record + I : Integer; + end record; + function Input (Stream : not null access Root_Stream_Type'Class) return IT; + + type FT is limited new T with record + F : Float; + end record; + function Input (Stream : not null access Root_Stream_Type'Class) return FT; +end abstract1; diff --git a/gcc/testsuite/gnat.dg/deep_old.adb b/gcc/testsuite/gnat.dg/deep_old.adb index 6aca027f4ac..d7818ff9686 100644 --- a/gcc/testsuite/gnat.dg/deep_old.adb +++ b/gcc/testsuite/gnat.dg/deep_old.adb @@ -1,3 +1,5 @@ +-- { dg-options "-gnatws" } + procedure Deep_Old (X : Integer) is begin begin diff --git a/gcc/testsuite/gnat.dg/fixce.adb b/gcc/testsuite/gnat.dg/fixce.adb new file mode 100644 index 00000000000..91e02e79383 --- /dev/null +++ b/gcc/testsuite/gnat.dg/fixce.adb @@ -0,0 +1,13 @@ +-- { dg-do run } + +procedure fixce is + type D is delta 128.0 / (2 ** 15) range 0.0 .. 256.0; + type R is range 0 .. 200; + dd : D; + RA : constant array (1 .. 3) of R := (127, 128, 200); +begin + dd := D (RA (2)); + for i in RA'range loop + dd := D (RA (i)); + end loop; +end fixce; diff --git a/gcc/testsuite/gnat.dg/frunaligned.adb b/gcc/testsuite/gnat.dg/frunaligned.adb new file mode 100644 index 00000000000..a57e87227e0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/frunaligned.adb @@ -0,0 +1,8 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } +with FRUnaligned1; use FRUnaligned1; +function FRUnaligned return r is + ss : s; +begin + return ss.y; +end; diff --git a/gcc/testsuite/gnat.dg/frunaligned1.ads b/gcc/testsuite/gnat.dg/frunaligned1.ads new file mode 100644 index 00000000000..4a8db361b48 --- /dev/null +++ b/gcc/testsuite/gnat.dg/frunaligned1.ads @@ -0,0 +1,12 @@ +package FRUnaligned1 is + type r is array (1 .. 72) of Boolean; + pragma Pack (r); + type s is record + x : Boolean; + y : r; + end record; + for s use record + x at 0 range 0 .. 0; + y at 0 range 1 .. 72; + end record; +end FRUnaligned1; diff --git a/gcc/testsuite/gnat.dg/old_errors.adb b/gcc/testsuite/gnat.dg/old_errors.adb index 846c6c61f25..a5e4d42177f 100644 --- a/gcc/testsuite/gnat.dg/old_errors.adb +++ b/gcc/testsuite/gnat.dg/old_errors.adb @@ -37,7 +37,7 @@ package body Old_Errors is begin Y := Z'Old; -- { dg-error "cannot refer to local variable" } end; - Y := I'Old; -- OK + Y := I'Old; -- { dg-warning "Old applied to constant has no effect" } Y := O'Old; -- OK Y := IO'Old; -- OK Y := G; -- OK, error has been signalled at G declaration diff --git a/gcc/testsuite/gnat.dg/specs/iface_eq_test-child.ads b/gcc/testsuite/gnat.dg/specs/iface_eq_test-child.ads new file mode 100644 index 00000000000..028bb1be053 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/iface_eq_test-child.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } +-- { dg-options "-gnatc" } +generic +package Iface_Eq_Test.Child is + protected type PO is new Iface with + procedure Dummy; + end; + overriding function "=" (L, R : access PO) return Boolean; +end; diff --git a/gcc/testsuite/gnat.dg/specs/iface_eq_test.ads b/gcc/testsuite/gnat.dg/specs/iface_eq_test.ads new file mode 100644 index 00000000000..36f9031ada4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/iface_eq_test.ads @@ -0,0 +1,6 @@ +-- { dg-do compile } +generic +package Iface_Eq_Test is + type Iface is limited interface; + function "=" (L, R : access Iface) return Boolean is abstract; +end; diff --git a/gcc/testsuite/gnat.dg/specs/self_class.ads b/gcc/testsuite/gnat.dg/specs/self_class.ads new file mode 100644 index 00000000000..56c7ab4760c --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/self_class.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } + +package Self_Class is + type P6 is private; +private + type P6 is tagged record + Self : access P6'Class; + end record; +end Self_Class; diff --git a/gcc/testsuite/lib/fortran-torture.exp b/gcc/testsuite/lib/fortran-torture.exp index 3286ad91e8a..6e49fac834c 100644 --- a/gcc/testsuite/lib/fortran-torture.exp +++ b/gcc/testsuite/lib/fortran-torture.exp @@ -22,12 +22,16 @@ load_lib target-supports.exp +# Return the list of options to use for fortran torture tests. # The default option list can be overridden by # TORTURE_OPTIONS="{ { list1 } ... { listN } }" +proc get-fortran-torture-options { } { + global TORTURE_OPTIONS + + if [info exists TORTURE_OPTIONS] { + return $TORTURE_OPTIONS + } -if [info exists TORTURE_OPTIONS] { - set FORTRAN_TORTURE_OPTIONS $TORTURE_OPTIONS -} else { # determine if host supports vectorization, and the necessary set # of options, based on code from testsuite/vect/vect.exp @@ -61,17 +65,22 @@ if [info exists TORTURE_OPTIONS] { set test_tree_vectorize 0 } - set FORTRAN_TORTURE_OPTIONS [list \ - { -O0 } { -O1 } { -O2 } \ + set options {} + + lappend options \ + { -O0 } \ + { -O1 } \ + { -O2 } \ { -O2 -fomit-frame-pointer -finline-functions } \ { -O2 -fomit-frame-pointer -finline-functions -funroll-loops } \ { -O2 -fbounds-check } \ { -O3 -g } \ - { -Os }] - + { -Os } if { $test_tree_vectorize } { - lappend FORTRAN_TORTURE_OPTIONS $vectorizer_options + lappend options $vectorizer_options } + + return $options } diff --git a/gcc/testsuite/lib/profopt.exp b/gcc/testsuite/lib/profopt.exp index 92e6660b756..967b7906f0e 100644 --- a/gcc/testsuite/lib/profopt.exp +++ b/gcc/testsuite/lib/profopt.exp @@ -184,6 +184,7 @@ proc profopt-get-options { src } { || ![string compare "dg-skip-if" $cmd] \ || ![string compare "dg-final-generate" $cmd] \ || ![string compare "dg-final-use" $cmd] \ + || ![string compare "dg-additional-sources" $cmd] \ || [string match "dg-require-*" $cmd] } { set status [catch "$op" errmsg] if { $status != 0 } { @@ -266,9 +267,11 @@ proc profopt-execute { src } { return } + set extra_options [dg-additional-files-options "" "$src"] + # Compile for profiling. - set options "" + set options "$extra_options" lappend options "additional_flags=$option $extra_flags $profile_option" set optstr "$option $profile_option" set comp_output [${tool}_target_compile "$src" "$execname1" executable $options] @@ -317,7 +320,7 @@ proc profopt-execute { src } { # Compile with feedback-directed optimizations. - set options "" + set options "$extra_options" lappend options "additional_flags=$option $extra_flags $feedback_option" set optstr "$option $feedback_option" set comp_output [${tool}_target_compile "$src" "$execname2" "executable" $options] @@ -364,7 +367,7 @@ proc profopt-execute { src } { # Compile with normal optimizations. - set options "" + set options "$extra_options" lappend options "additional_flags=$option" set optstr "$option" set comp_output [${tool}_target_compile "$src" "$execname3" "executable" $options] diff --git a/gcc/tree-dfa.c b/gcc/tree-dfa.c index 7e4bb7681b7..af167492de6 100644 --- a/gcc/tree-dfa.c +++ b/gcc/tree-dfa.c @@ -142,33 +142,14 @@ var_ann_t create_var_ann (tree t) { var_ann_t ann; - struct static_var_ann_d *sann = NULL; gcc_assert (t); gcc_assert (DECL_P (t)); gcc_assert (!t->base.ann || t->base.ann->common.type == VAR_ANN); - if (!MTAG_P (t) && (TREE_STATIC (t) || DECL_EXTERNAL (t))) - { - sann = GGC_CNEW (struct static_var_ann_d); - ann = &sann->ann; - } - else - ann = GGC_CNEW (struct var_ann_d); - + ann = GGC_CNEW (struct var_ann_d); ann->common.type = VAR_ANN; - - if (!MTAG_P (t) && (TREE_STATIC (t) || DECL_EXTERNAL (t))) - { - void **slot; - sann->uid = DECL_UID (t); - slot = htab_find_slot_with_hash (gimple_var_anns (cfun), - t, DECL_UID (t), INSERT); - gcc_assert (!*slot); - *slot = sann; - } - else - t->base.ann = (tree_ann_t) ann; + t->base.ann = (tree_ann_t) ann; return ann; } @@ -765,8 +746,20 @@ remove_referenced_var (tree var) clear_call_clobbered (var); if ((v_ann = var_ann (var))) - ggc_free (v_ann); - var->base.ann = NULL; + { + /* Preserve var_anns of globals, but clear their alias info. */ + if (MTAG_P (var) + || (!TREE_STATIC (var) && !DECL_EXTERNAL (var))) + { + ggc_free (v_ann); + var->base.ann = NULL; + } + else + { + v_ann->mpt = NULL_TREE; + v_ann->symbol_mem_tag = NULL_TREE; + } + } gcc_assert (DECL_P (var)); in.uid = uid; loc = htab_find_slot_with_hash (gimple_referenced_vars (cfun), &in, uid, diff --git a/gcc/tree-flow-inline.h b/gcc/tree-flow-inline.h index a41ee9ac2eb..95ddfb5b130 100644 --- a/gcc/tree-flow-inline.h +++ b/gcc/tree-flow-inline.h @@ -91,14 +91,6 @@ gimple_nonlocal_all (const struct function *fun) return fun->gimple_df->nonlocal_all; } -/* Hashtable of variables annotations. Used for static variables only; - local variables have direct pointer in the tree node. */ -static inline htab_t -gimple_var_anns (const struct function *fun) -{ - return fun->gimple_df->var_anns; -} - /* Initialize the hashtable iterator HTI to point to hashtable TABLE */ static inline void * @@ -192,22 +184,9 @@ var_ann (const_tree t) { var_ann_t ann; - if (!MTAG_P (t) - && (TREE_STATIC (t) || DECL_EXTERNAL (t))) - { - struct static_var_ann_d *sann - = ((struct static_var_ann_d *) - htab_find_with_hash (gimple_var_anns (cfun), t, DECL_UID (t))); - if (!sann) - return NULL; - ann = &sann->ann; - } - else - { - if (!t->base.ann) - return NULL; - ann = (var_ann_t) t->base.ann; - } + if (!t->base.ann) + return NULL; + ann = (var_ann_t) t->base.ann; gcc_assert (ann->common.type == VAR_ANN); diff --git a/gcc/tree-flow.h b/gcc/tree-flow.h index bd1f87ab396..94d5a69f69c 100644 --- a/gcc/tree-flow.h +++ b/gcc/tree-flow.h @@ -188,10 +188,6 @@ struct gimple_df GTY(()) struct ssa_operands ssa_operands; - /* Hashtable of variables annotations. Used for static variables only; - local variables have direct pointer in the tree node. */ - htab_t GTY((param_is (struct static_var_ann_d))) var_anns; - /* Memory reference statistics collected during alias analysis. This information is used to drive the memory partitioning heuristics in compute_memory_partitions. */ @@ -1171,6 +1167,7 @@ tree gimple_fold_indirect_ref (tree); /* In tree-ssa-structalias.c */ bool find_what_p_points_to (tree); +bool clobber_what_p_points_to (tree); /* In tree-ssa-live.c */ extern void remove_unused_locals (void); diff --git a/gcc/tree-gimple.c b/gcc/tree-gimple.c index b5092ecc492..8b05f93d505 100644 --- a/gcc/tree-gimple.c +++ b/gcc/tree-gimple.c @@ -113,13 +113,8 @@ bool is_gimple_mem_rhs (tree t) { /* If we're dealing with a renamable type, either source or dest must be - a renamed variable. Also force a temporary if the type doesn't need - to be stored in memory, since it's cheap and prevents erroneous - tailcalls (PR 17526). */ - if (is_gimple_reg_type (TREE_TYPE (t)) - || (TYPE_MODE (TREE_TYPE (t)) != BLKmode - && (TREE_CODE (t) != CALL_EXPR - || ! aggregate_value_p (t, t)))) + a renamed variable. */ + if (is_gimple_reg_type (TREE_TYPE (t))) return is_gimple_val (t); else return is_gimple_formal_tmp_rhs (t); diff --git a/gcc/tree-nested.c b/gcc/tree-nested.c index 53822010ce4..966da3d77ac 100644 --- a/gcc/tree-nested.c +++ b/gcc/tree-nested.c @@ -774,7 +774,7 @@ check_for_nested_with_variably_modified (tree fndecl, tree orig_fndecl) for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested) { for (arg = DECL_ARGUMENTS (cgn->decl); arg; arg = TREE_CHAIN (arg)) - if (variably_modified_type_p (TREE_TYPE (arg), 0), orig_fndecl) + if (variably_modified_type_p (TREE_TYPE (arg), orig_fndecl)) return true; if (check_for_nested_with_variably_modified (cgn->decl, orig_fndecl)) diff --git a/gcc/tree-profile.c b/gcc/tree-profile.c index 7a70cefad19..6121837e496 100644 --- a/gcc/tree-profile.c +++ b/gcc/tree-profile.c @@ -308,7 +308,7 @@ tree_gen_ic_func_profiler (void) edge e; basic_block bb; edge_iterator ei; - tree stmt1; + tree stmt1, stmt2; tree tree_uid, cur_func; if (flag_unit_at_a_time) @@ -321,8 +321,11 @@ tree_gen_ic_func_profiler (void) FOR_EACH_EDGE (e, ei, ENTRY_BLOCK_PTR->succs) { + tree void0; + bb = split_edge (e); bsi = bsi_start (bb); + cur_func = force_gimple_operand_bsi (&bsi, build_addr (current_function_decl, current_function_decl), @@ -335,6 +338,16 @@ tree_gen_ic_func_profiler (void) cur_func, ic_void_ptr_var); bsi_insert_after (&bsi, stmt1, BSI_NEW_STMT); + + gcc_assert (EDGE_COUNT (bb->succs) == 1); + bb = split_edge (EDGE_I (bb->succs, 0)); + bsi = bsi_start (bb); + /* Set __gcov_indirect_call_callee to 0, + so that calls from other modules won't get misattributed + to the last caller of the current callee. */ + void0 = build_int_cst (build_pointer_type (void_type_node), 0); + stmt2 = build_gimple_modify_stmt (ic_void_ptr_var, void0); + bsi_insert_after (&bsi, stmt2, BSI_NEW_STMT); } } diff --git a/gcc/tree-scalar-evolution.c b/gcc/tree-scalar-evolution.c index 7c9736a3b02..2cc008020e2 100644 --- a/gcc/tree-scalar-evolution.c +++ b/gcc/tree-scalar-evolution.c @@ -2645,16 +2645,6 @@ scev_initialize (void) } } -/* Clean the scalar evolution analysis cache, but preserve the cached - numbers of iterations for the loops. */ - -void -scev_reset_except_niters (void) -{ - if (scalar_evolution_info) - htab_empty (scalar_evolution_info); -} - /* Cleans up the information cached by the scalar evolutions analysis. */ void @@ -2666,8 +2656,7 @@ scev_reset (void) if (!scalar_evolution_info || !current_loops) return; - scev_reset_except_niters (); - + htab_empty (scalar_evolution_info); FOR_EACH_LOOP (li, loop, 0) { loop->nb_iterations = NULL_TREE; diff --git a/gcc/tree-scalar-evolution.h b/gcc/tree-scalar-evolution.h index 54e543ceccc..472b194d307 100644 --- a/gcc/tree-scalar-evolution.h +++ b/gcc/tree-scalar-evolution.h @@ -27,7 +27,6 @@ extern tree get_loop_exit_condition (const struct loop *); extern void scev_initialize (void); extern void scev_reset (void); -extern void scev_reset_except_niters (void); extern void scev_finalize (void); extern tree analyze_scalar_evolution (struct loop *, tree); extern tree instantiate_scev (struct loop *, struct loop *, tree); diff --git a/gcc/tree-ssa-address.c b/gcc/tree-ssa-address.c index a5119d8c2bd..55d43a5e362 100644 --- a/gcc/tree-ssa-address.c +++ b/gcc/tree-ssa-address.c @@ -423,9 +423,13 @@ add_to_parts (struct mem_address *parts, tree elt) /* Add ELT to base. */ type = TREE_TYPE (parts->base); - parts->base = fold_build2 (POINTER_PLUS_EXPR, type, - parts->base, - fold_convert (sizetype, elt)); + if (POINTER_TYPE_P (type)) + parts->base = fold_build2 (POINTER_PLUS_EXPR, type, + parts->base, + fold_convert (sizetype, elt)); + else + parts->base = fold_build2 (PLUS_EXPR, type, + parts->base, elt); } /* Finds the most expensive multiplication in ADDR that can be diff --git a/gcc/tree-ssa-alias.c b/gcc/tree-ssa-alias.c index 7ce016b9096..1523aebac17 100644 --- a/gcc/tree-ssa-alias.c +++ b/gcc/tree-ssa-alias.c @@ -521,6 +521,8 @@ set_initial_properties (struct alias_info *ai) referenced_var_iterator rvi; tree var; tree ptr; + bool any_pt_anything = false; + enum escape_type pt_anything_mask = 0; FOR_EACH_REFERENCED_VAR (var, rvi) { @@ -543,8 +545,14 @@ set_initial_properties (struct alias_info *ai) { struct ptr_info_def *pi = SSA_NAME_PTR_INFO (ptr); tree tag = symbol_mem_tag (SSA_NAME_VAR (ptr)); - - if (pi->value_escapes_p) + + /* A pointer that only escapes via a function return does not + add to the call clobber or call used solution. + To exclude ESCAPE_TO_PURE_CONST we would need to track + call used variables separately or compute those properly + in the operand scanner. */ + if (pi->value_escapes_p + && pi->escape_mask & ~ESCAPE_TO_RETURN) { /* If PTR escapes then its associated memory tags and pointed-to variables are call-clobbered. */ @@ -554,22 +562,16 @@ set_initial_properties (struct alias_info *ai) if (tag) mark_call_clobbered (tag, pi->escape_mask); - if (pi->pt_vars) + /* Defer to points-to analysis if possible, otherwise + clobber all addressable variables. Parameters cannot + point to local memory though. + ??? Properly tracking which pointers point to non-local + memory only would make a big difference here. */ + if (!clobber_what_p_points_to (ptr) + && !(pi->escape_mask & ESCAPE_IS_PARM)) { - bitmap_iterator bi; - unsigned int j; - EXECUTE_IF_SET_IN_BITMAP (pi->pt_vars, 0, j, bi) - { - tree alias = referenced_var (j); - - /* If you clobber one part of a structure, you - clobber the entire thing. While this does not make - the world a particularly nice place, it is necessary - in order to allow C/C++ tricks that involve - pointer arithmetic to work. */ - if (!unmodifiable_var_p (alias)) - mark_call_clobbered (alias, pi->escape_mask); - } + any_pt_anything = true; + pt_anything_mask |= pi->escape_mask; } } @@ -603,6 +605,21 @@ set_initial_properties (struct alias_info *ai) MTAG_GLOBAL (tag) = true; } } + + /* If a pt_anything pointer escaped we need to mark all addressable + variables call clobbered. */ + if (any_pt_anything) + { + bitmap_iterator bi; + unsigned int j; + + EXECUTE_IF_SET_IN_BITMAP (gimple_addressable_vars (cfun), 0, j, bi) + { + tree var = referenced_var (j); + if (!unmodifiable_var_p (var)) + mark_call_clobbered (var, pt_anything_mask); + } + } } /* Compute which variables need to be marked call clobbered because diff --git a/gcc/tree-ssa-coalesce.c b/gcc/tree-ssa-coalesce.c index ef1ebcab4a9..172f1a2f829 100644 --- a/gcc/tree-ssa-coalesce.c +++ b/gcc/tree-ssa-coalesce.c @@ -114,7 +114,7 @@ coalesce_cost_edge (edge e) return MUST_COALESCE_COST; return coalesce_cost (EDGE_FREQUENCY (e), - maybe_hot_bb_p (e->src), + maybe_hot_edge_p (e), EDGE_CRITICAL_P (e)); } diff --git a/gcc/tree-ssa-ifcombine.c b/gcc/tree-ssa-ifcombine.c index 4dbe7503c9e..93e7810cb3b 100644 --- a/gcc/tree-ssa-ifcombine.c +++ b/gcc/tree-ssa-ifcombine.c @@ -148,8 +148,7 @@ get_name_for_bit_test (tree candidate) { tree def_stmt = SSA_NAME_DEF_STMT (candidate); if (TREE_CODE (def_stmt) == GIMPLE_MODIFY_STMT - && (TREE_CODE (GIMPLE_STMT_OPERAND (def_stmt, 1)) == NOP_EXPR - || TREE_CODE (GIMPLE_STMT_OPERAND (def_stmt, 1)) == CONVERT_EXPR)) + && CONVERT_EXPR_P (GIMPLE_STMT_OPERAND (def_stmt, 1))) { tree rhs = GIMPLE_STMT_OPERAND (def_stmt, 1); if (TYPE_PRECISION (TREE_TYPE (rhs)) diff --git a/gcc/tree-ssa-propagate.c b/gcc/tree-ssa-propagate.c index ae7fe848213..b0371805568 100644 --- a/gcc/tree-ssa-propagate.c +++ b/gcc/tree-ssa-propagate.c @@ -40,6 +40,7 @@ #include "langhooks.h" #include "varray.h" #include "vec.h" +#include "value-prof.h" /* This file implements a generic value propagation engine based on the same propagation used by the SSA-CCP algorithm [1]. @@ -680,9 +681,10 @@ bool set_rhs (tree *stmt_p, tree expr) { tree stmt = *stmt_p, op; - stmt_ann_t ann; + tree new_stmt; tree var; ssa_op_iter iter; + int eh_region; if (!valid_gimple_expression_p (expr)) return false; @@ -733,9 +735,22 @@ set_rhs (tree *stmt_p, tree expr) default: /* Replace the whole statement with EXPR. If EXPR has no side effects, then replace *STMT_P with an empty statement. */ - ann = stmt_ann (stmt); - *stmt_p = TREE_SIDE_EFFECTS (expr) ? expr : build_empty_stmt (); - (*stmt_p)->base.ann = (tree_ann_t) ann; + new_stmt = TREE_SIDE_EFFECTS (expr) ? expr : build_empty_stmt (); + *stmt_p = new_stmt; + + /* Preserve the annotation, the histograms and the EH region information + associated with the original statement. The EH information + needs to be preserved only if the new statement still can throw. */ + new_stmt->base.ann = (tree_ann_t) stmt_ann (stmt); + gimple_move_stmt_histograms (cfun, new_stmt, stmt); + if (tree_could_throw_p (new_stmt)) + { + eh_region = lookup_stmt_eh_region (stmt); + /* We couldn't possibly turn a nothrow into a throw statement. */ + gcc_assert (eh_region >= 0); + remove_stmt_from_eh_region (stmt); + add_stmt_to_eh_region (new_stmt, eh_region); + } if (gimple_in_ssa_p (cfun) && TREE_SIDE_EFFECTS (expr)) diff --git a/gcc/tree-ssa-structalias.c b/gcc/tree-ssa-structalias.c index 7c79a3df68d..b6d73ce66f4 100644 --- a/gcc/tree-ssa-structalias.c +++ b/gcc/tree-ssa-structalias.c @@ -4664,17 +4664,19 @@ set_uids_in_ptset (tree ptr, bitmap into, bitmap from, bool is_derefed, || TREE_CODE (vi->decl) == RESULT_DECL) { /* Just add VI->DECL to the alias set. - Don't type prune artificial vars. */ - if (vi->is_artificial_var) + Don't type prune artificial vars or points-to sets + for pointers that have not been dereferenced or with + type-based pruning disabled. */ + if (vi->is_artificial_var + || !is_derefed + || no_tbaa_pruning) bitmap_set_bit (into, DECL_UID (vi->decl)); else { alias_set_type var_alias_set, ptr_alias_set; var_alias_set = get_alias_set (vi->decl); ptr_alias_set = get_alias_set (TREE_TYPE (TREE_TYPE (ptr))); - if (no_tbaa_pruning - || (!is_derefed && !vi->directly_dereferenced) - || alias_sets_conflict_p (ptr_alias_set, var_alias_set)) + if (alias_sets_conflict_p (ptr_alias_set, var_alias_set)) bitmap_set_bit (into, DECL_UID (vi->decl)); } } @@ -4885,7 +4887,71 @@ find_what_p_points_to (tree p) return false; } +/* Mark everything that p points to as call clobbered. Returns true + if everything is done and false if all addressable variables need to + be clobbered because p points to anything. */ +bool +clobber_what_p_points_to (tree p) +{ + tree lookup_p = p; + varinfo_t vi; + struct ptr_info_def *pi; + unsigned int i; + bitmap_iterator bi; + + if (!have_alias_info) + return false; + + /* For parameters, get at the points-to set for the actual parm + decl. */ + if (TREE_CODE (p) == SSA_NAME + && TREE_CODE (SSA_NAME_VAR (p)) == PARM_DECL + && SSA_NAME_IS_DEFAULT_DEF (p)) + lookup_p = SSA_NAME_VAR (p); + + vi = lookup_vi_for_tree (lookup_p); + if (!vi) + return false; + + /* We are asking for the points-to solution of pointers. */ + gcc_assert (!vi->is_artificial_var + && vi->size == vi->fullsize); + + pi = get_ptr_info (p); + + /* This variable may have been collapsed, let's get the real + variable. */ + vi = get_varinfo (find (vi->id)); + + /* Mark variables in the solution call-clobbered. */ + EXECUTE_IF_SET_IN_BITMAP (vi->solution, 0, i, bi) + { + varinfo_t vi = get_varinfo (i); + + if (vi->is_artificial_var) + { + /* nothing_id and readonly_id do not cause any + call clobber ops. For anything_id and integer_id + we need to clobber all addressable vars. */ + if (vi->id == anything_id + || vi->id == integer_id) + return false; + } + + /* Only artificial heap-vars are further interesting. */ + if (vi->is_artificial_var && !vi->is_heap_var) + continue; + + if ((TREE_CODE (vi->decl) == VAR_DECL + || TREE_CODE (vi->decl) == PARM_DECL + || TREE_CODE (vi->decl) == RESULT_DECL) + && !unmodifiable_var_p (vi->decl)) + mark_call_clobbered (vi->decl, pi->escape_mask); + } + + return true; +} /* Dump points-to information to OUTFILE. */ diff --git a/gcc/tree-ssa.c b/gcc/tree-ssa.c index 150074f7c23..f71e3af7ff9 100644 --- a/gcc/tree-ssa.c +++ b/gcc/tree-ssa.c @@ -571,7 +571,9 @@ verify_flow_sensitive_alias_info (void) goto err; } - if (pi->value_escapes_p && pi->name_mem_tag) + if (pi->value_escapes_p + && pi->escape_mask & ~ESCAPE_TO_RETURN + && pi->name_mem_tag) { tree t = memory_partition (pi->name_mem_tag); if (t == NULL_TREE) @@ -904,24 +906,6 @@ uid_decl_map_hash (const void *item) return ((const_tree)item)->decl_minimal.uid; } -/* Return true if the uid in both int tree maps are equal. */ - -static int -var_ann_eq (const void *va, const void *vb) -{ - const struct static_var_ann_d *a = (const struct static_var_ann_d *) va; - const_tree const b = (const_tree) vb; - return (a->uid == DECL_UID (b)); -} - -/* Hash a UID in a int_tree_map. */ - -static unsigned int -var_ann_hash (const void *item) -{ - return ((const struct static_var_ann_d *)item)->uid; -} - /* Return true if the DECL_UID in both trees are equal. */ static int @@ -951,8 +935,6 @@ init_tree_ssa (struct function *fn) uid_decl_map_eq, NULL); fn->gimple_df->default_defs = htab_create_ggc (20, uid_ssaname_map_hash, uid_ssaname_map_eq, NULL); - fn->gimple_df->var_anns = htab_create_ggc (20, var_ann_hash, - var_ann_eq, NULL); fn->gimple_df->call_clobbered_vars = BITMAP_GGC_ALLOC (); fn->gimple_df->addressable_vars = BITMAP_GGC_ALLOC (); init_ssanames (fn, 0); @@ -998,9 +980,16 @@ delete_tree_ssa (void) set_phi_nodes (bb, NULL); } - /* Remove annotations from every referenced variable. */ + /* Remove annotations from every referenced local variable. */ FOR_EACH_REFERENCED_VAR (var, rvi) { + if (!MTAG_P (var) + && (TREE_STATIC (var) || DECL_EXTERNAL (var))) + { + var_ann (var)->mpt = NULL_TREE; + var_ann (var)->symbol_mem_tag = NULL_TREE; + continue; + } if (var->base.ann) ggc_free (var->base.ann); var->base.ann = NULL; @@ -1018,8 +1007,6 @@ delete_tree_ssa (void) htab_delete (cfun->gimple_df->default_defs); cfun->gimple_df->default_defs = NULL; - htab_delete (cfun->gimple_df->var_anns); - cfun->gimple_df->var_anns = NULL; cfun->gimple_df->call_clobbered_vars = NULL; cfun->gimple_df->addressable_vars = NULL; cfun->gimple_df->modified_noreturn_calls = NULL; diff --git a/gcc/tree-tailcall.c b/gcc/tree-tailcall.c index 7481de59325..09a2eafe119 100644 --- a/gcc/tree-tailcall.c +++ b/gcc/tree-tailcall.c @@ -429,6 +429,20 @@ find_tail_calls (basic_block bb, struct tailcall **ret) return; } + /* If the LHS of our call is not just a simple register, we can't + transform this into a tail or sibling call. This situation happens, + in (e.g.) "*p = foo()" where foo returns a struct. In this case + we won't have a temporary here, but we need to carry out the side + effect anyway, so tailcall is impossible. + + ??? In some situations (when the struct is returned in memory via + invisible argument) we could deal with this, e.g. by passing 'p' + itself as that argument to foo, but it's too early to do this here, + and expand_call() will not handle it anyway. If it ever can, then + we need to revisit this here, to allow that situation. */ + if (ass_var && !is_gimple_reg (ass_var)) + return; + /* We found the call, check whether it is suitable. */ tail_recursion = false; func = get_callee_fndecl (call); diff --git a/gcc/tree-vrp.c b/gcc/tree-vrp.c index 15e7ee57dd6..fe39a24f096 100644 --- a/gcc/tree-vrp.c +++ b/gcc/tree-vrp.c @@ -772,7 +772,9 @@ usable_range_p (value_range_t *vr, bool *strict_overflow_p) static bool vrp_expr_computes_nonnegative (tree expr, bool *strict_overflow_p) { - return tree_expr_nonnegative_warnv_p (expr, strict_overflow_p); + return (tree_expr_nonnegative_warnv_p (expr, strict_overflow_p) + || (TREE_CODE (expr) == SSA_NAME + && ssa_name_nonnegative_p (expr))); } /* Like tree_expr_nonzero_warnv_p, but this function uses value ranges @@ -781,7 +783,9 @@ vrp_expr_computes_nonnegative (tree expr, bool *strict_overflow_p) static bool vrp_expr_computes_nonzero (tree expr, bool *strict_overflow_p) { - if (tree_expr_nonzero_warnv_p (expr, strict_overflow_p)) + if (tree_expr_nonzero_warnv_p (expr, strict_overflow_p) + || (TREE_CODE (expr) == SSA_NAME + && ssa_name_nonzero_p (expr))) return true; /* If we have an expression of the form &X->a, then the expression @@ -2799,13 +2803,6 @@ adjust_range_with_scev (value_range_t *vr, struct loop *loop, tree stmt, if (vr->type == VR_ANTI_RANGE) return; - /* Ensure that there are not values in the scev cache based on assumptions - on ranges of ssa names that were changed - (in set_value_range/set_value_range_to_varying). Preserve cached numbers - of iterations, that were computed before the start of VRP (we do not - recompute these each time to save the compile time). */ - scev_reset_except_niters (); - chrec = instantiate_parameters (loop, analyze_scalar_evolution (loop, var)); /* Like in PR19590, scev can return a constant function. */ @@ -6636,20 +6633,6 @@ vrp_finalize (void) vr_phi_edge_counts = NULL; } -/* Calculates number of iterations for all loops, to ensure that they are - cached. */ - -static void -record_numbers_of_iterations (void) -{ - loop_iterator li; - struct loop *loop; - - FOR_EACH_LOOP (li, loop, 0) - { - number_of_latch_executions (loop); - } -} /* Main entry point to VRP (Value Range Propagation). This pass is loosely based on J. R. C. Patterson, ``Accurate Static Branch @@ -6708,17 +6691,6 @@ execute_vrp (void) insert_range_assertions (); - /* Compute the # of iterations for each loop before we start the VRP - analysis. The value ranges determined by VRP are used in expression - simplification, that is also used by the # of iterations analysis. - However, in the middle of the VRP analysis, the value ranges do not take - all the possible paths in CFG into account, so they do not have to be - correct, and the # of iterations analysis can obtain wrong results. - This is a problem, since the results of the # of iterations analysis - are cached, so these mistakes would not be corrected when the value - ranges are corrected. */ - record_numbers_of_iterations (); - to_remove_edges = VEC_alloc (edge, heap, 10); to_update_switch_stmts = VEC_alloc (switch_update, heap, 5); diff --git a/gcc/value-prof.c b/gcc/value-prof.c index 33ecded88c3..fbefc97a46d 100644 --- a/gcc/value-prof.c +++ b/gcc/value-prof.c @@ -336,6 +336,25 @@ gimple_duplicate_stmt_histograms (struct function *fun, tree stmt, } } + +/* Move all histograms associated with OSTMT to STMT. */ + +void +gimple_move_stmt_histograms (struct function *fun, tree stmt, tree ostmt) +{ + histogram_value val = gimple_histogram_value (fun, ostmt); + if (val) + { + /* The following three statements can't be reordered, + because histogram hashtab relies on stmt field value + for finding the exact slot. */ + set_histogram_value (fun, ostmt, NULL); + for (; val != NULL; val = val->hvalue.next) + val->hvalue.stmt = stmt; + set_histogram_value (fun, stmt, val); + } +} + static bool error_found = false; /* Helper function for verify_histograms. For each histogram reachable via htab @@ -1198,6 +1217,8 @@ tree_ic_transform (tree stmt) print_generic_stmt (dump_file, stmt, TDF_SLIM); fprintf (dump_file, " to "); print_generic_stmt (dump_file, modify, TDF_SLIM); + fprintf (dump_file, "hist->count "HOST_WIDEST_INT_PRINT_DEC + " hist->all "HOST_WIDEST_INT_PRINT_DEC"\n", count, all); } return true; diff --git a/gcc/value-prof.h b/gcc/value-prof.h index a01919bb3f9..2ab9df1cb53 100644 --- a/gcc/value-prof.h +++ b/gcc/value-prof.h @@ -116,6 +116,7 @@ void dump_histograms_for_stmt (struct function *, FILE *, tree); void gimple_remove_histogram_value (struct function *, tree, histogram_value); void gimple_remove_stmt_histograms (struct function *, tree); void gimple_duplicate_stmt_histograms (struct function *, tree, struct function *, tree); +void gimple_move_stmt_histograms (struct function *, tree, tree); void verify_histograms (void); void free_histograms (void); void stringop_block_profile (tree, unsigned int *, HOST_WIDE_INT *); diff --git a/libcpp/ChangeLog b/libcpp/ChangeLog index 7f31ff4e79a..3935dff57ac 100644 --- a/libcpp/ChangeLog +++ b/libcpp/ChangeLog @@ -1,3 +1,16 @@ +2008-05-30 Tom Tromey <tromey@redhat.com> + + PR preprocessor/36320: + * internal.h (_cpp_parse_expr): Update. + * expr.c (_cpp_parse_expr): Add 'is_if' argument. Update error + messages. + * directives.c (do_if): Update. + (do_elif): Require expression if processing group. + +2008-05-30 Danny Smith <dannysmith@users.sourceforge.net> + + * include/cpplib.h (struct cpp_dir): Add new field, canonical_name. + 2008-05-21 Tom Tromey <tromey@redhat.com> PR preprocessor/27777: diff --git a/libcpp/directives.c b/libcpp/directives.c index 8e7778d12e2..370f4ff5b0d 100644 --- a/libcpp/directives.c +++ b/libcpp/directives.c @@ -1737,7 +1737,7 @@ do_if (cpp_reader *pfile) int skip = 1; if (! pfile->state.skipping) - skip = _cpp_parse_expr (pfile) == false; + skip = _cpp_parse_expr (pfile, true) == false; push_conditional (pfile, skip, T_IF, pfile->mi_ind_cmacro); } @@ -1796,15 +1796,23 @@ do_elif (cpp_reader *pfile) } ifs->type = T_ELIF; - /* Only evaluate this if we aren't skipping elses. During - evaluation, set skipping to false to get lexer warnings. */ - if (ifs->skip_elses) - pfile->state.skipping = 1; - else + if (! ifs->was_skipping) { + bool value; + /* The standard mandates that the expression be parsed even + if we are skipping elses at this point -- the lexical + restrictions on #elif only apply to skipped groups, but + this group is not being skipped. Temporarily set + skipping to false to get lexer warnings. */ pfile->state.skipping = 0; - pfile->state.skipping = ! _cpp_parse_expr (pfile); - ifs->skip_elses = ! pfile->state.skipping; + value = _cpp_parse_expr (pfile, false); + if (ifs->skip_elses) + pfile->state.skipping = 1; + else + { + pfile->state.skipping = ! value; + ifs->skip_elses = value; + } } /* Invalidate any controlling macro. */ diff --git a/libcpp/expr.c b/libcpp/expr.c index 2e52617a656..c0e3cbd8006 100644 --- a/libcpp/expr.c +++ b/libcpp/expr.c @@ -852,7 +852,7 @@ static const struct cpp_operator stored in the 'value' field of the stack element of the operator that precedes it. */ bool -_cpp_parse_expr (cpp_reader *pfile) +_cpp_parse_expr (cpp_reader *pfile, bool is_if) { struct op *top = pfile->op_stack; unsigned int lex_count; @@ -927,7 +927,7 @@ _cpp_parse_expr (cpp_reader *pfile) SYNTAX_ERROR ("missing expression between '(' and ')'"); if (op.op == CPP_EOF && top->op == CPP_EOF) - SYNTAX_ERROR ("#if with no expression"); + SYNTAX_ERROR2 ("%s with no expression", is_if ? "#if" : "#elif"); if (top->op != CPP_EOF && top->op != CPP_OPEN_PAREN) SYNTAX_ERROR2 ("operator '%s' has no right operand", @@ -988,7 +988,8 @@ _cpp_parse_expr (cpp_reader *pfile) if (top != pfile->op_stack) { - cpp_error (pfile, CPP_DL_ICE, "unbalanced stack in #if"); + cpp_error (pfile, CPP_DL_ICE, "unbalanced stack in %s", + is_if ? "#if" : "#elif"); syntax_error: return false; /* Return false on syntax error. */ } diff --git a/libcpp/include/cpplib.h b/libcpp/include/cpplib.h index 76288a9068c..92ab291db2c 100644 --- a/libcpp/include/cpplib.h +++ b/libcpp/include/cpplib.h @@ -508,6 +508,10 @@ struct cpp_dir char *name; unsigned int len; + /* The canonicalized NAME as determined by lrealpath. This field + is only used by hosts that lack reliable inode numbers. */ + char *canonical_name; + /* One if a system header, two if a system header that has extern "C" guards for C++. */ unsigned char sysp; diff --git a/libcpp/internal.h b/libcpp/internal.h index 187b31140f3..65cac325186 100644 --- a/libcpp/internal.h +++ b/libcpp/internal.h @@ -557,7 +557,7 @@ extern bool _cpp_read_file_entries (cpp_reader *, FILE *); extern struct stat *_cpp_get_file_stat (_cpp_file *); /* In expr.c */ -extern bool _cpp_parse_expr (cpp_reader *); +extern bool _cpp_parse_expr (cpp_reader *, bool); extern struct op *_cpp_expand_op_stack (cpp_reader *); /* In lex.c */ diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 877ab624351..9a25ecd5cee 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,37 @@ +2008-05-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/36319 + * intrinsics/string_intrinsics_inc.c (string_index): Return + correct value for zero-length substring. + * intrinsics/cshift0.c: Add _char4 variant. + * intrinsics/eoshift0.c (eoshift0): Allow filler to be a pattern + wider than a single byte. Add _char4 variant and use above + functionality. + * intrinsics/eoshift2.c (eoshift2): Likewise. + * m4/eoshift1.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * m4/cshift1.m4: Add _char4 variants. + * gfortran.map (GFORTRAN_1.1): Add _gfortran_cshift0_1_char4, + _gfortran_cshift0_2_char4, _gfortran_cshift0_4_char4, + _gfortran_cshift0_8_char4, _gfortran_cshift1_16_char4, + _gfortran_cshift1_4_char4, _gfortran_cshift1_8_char4, + _gfortran_eoshift0_1_char4, _gfortran_eoshift0_2_char4, + _gfortran_eoshift0_4_char4, _gfortran_eoshift0_8_char4, + _gfortran_eoshift1_16_char4, _gfortran_eoshift1_4_char4, + _gfortran_eoshift1_8_char4, _gfortran_eoshift2_1_char4, + _gfortran_eoshift2_2_char4, _gfortran_eoshift2_4_char4, + _gfortran_eoshift2_8_char4, _gfortran_eoshift3_16_char4, + _gfortran_eoshift3_4_char4 and _gfortran_eoshift3_8_char4. + * generated/eoshift3_4.c: Regenerate. + * generated/eoshift1_8.c: Regenerate. + * generated/eoshift1_16.c: Regenerate. + * generated/cshift1_4.c: Regenerate. + * generated/eoshift1_4.c: Regenerate. + * generated/eoshift3_8.c: Regenerate. + * generated/eoshift3_16.c: Regenerate. + * generated/cshift1_8.c: Regenerate. + * generated/cshift1_16.c: Regenerate. + 2008-05-25 Tobias Burnus <burnus@net-b.de> PR fortran/32600 diff --git a/libgfortran/generated/cshift1_16.c b/libgfortran/generated/cshift1_16.c index a29bf79ce72..2943c3ed86d 100644 --- a/libgfortran/generated/cshift1_16.c +++ b/libgfortran/generated/cshift1_16.c @@ -212,6 +212,7 @@ cshift1_16 (gfc_array_char * const restrict ret, cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); } + void cshift1_16_char (gfc_array_char * const restrict ret, GFC_INTEGER_4, const gfc_array_char * const restrict array, @@ -231,4 +232,24 @@ cshift1_16_char (gfc_array_char * const restrict ret, cshift1 (ret, array, h, pwhich, array_length); } + +void cshift1_16_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_16_char4); + +void +cshift1_16_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4 array_length) +{ + cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); +} + #endif diff --git a/libgfortran/generated/cshift1_4.c b/libgfortran/generated/cshift1_4.c index 0525873b563..3f4f9e0bf25 100644 --- a/libgfortran/generated/cshift1_4.c +++ b/libgfortran/generated/cshift1_4.c @@ -212,6 +212,7 @@ cshift1_4 (gfc_array_char * const restrict ret, cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); } + void cshift1_4_char (gfc_array_char * const restrict ret, GFC_INTEGER_4, const gfc_array_char * const restrict array, @@ -231,4 +232,24 @@ cshift1_4_char (gfc_array_char * const restrict ret, cshift1 (ret, array, h, pwhich, array_length); } + +void cshift1_4_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_4_char4); + +void +cshift1_4_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4 array_length) +{ + cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); +} + #endif diff --git a/libgfortran/generated/cshift1_8.c b/libgfortran/generated/cshift1_8.c index 624b662cea7..4d246e54d95 100644 --- a/libgfortran/generated/cshift1_8.c +++ b/libgfortran/generated/cshift1_8.c @@ -212,6 +212,7 @@ cshift1_8 (gfc_array_char * const restrict ret, cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); } + void cshift1_8_char (gfc_array_char * const restrict ret, GFC_INTEGER_4, const gfc_array_char * const restrict array, @@ -231,4 +232,24 @@ cshift1_8_char (gfc_array_char * const restrict ret, cshift1 (ret, array, h, pwhich, array_length); } + +void cshift1_8_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_8_char4); + +void +cshift1_8_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4 array_length) +{ + cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); +} + #endif diff --git a/libgfortran/generated/eoshift1_16.c b/libgfortran/generated/eoshift1_16.c index e16db209e3d..63b75bdbd6b 100644 --- a/libgfortran/generated/eoshift1_16.c +++ b/libgfortran/generated/eoshift1_16.c @@ -42,7 +42,7 @@ eoshift1 (gfc_array_char * const restrict ret, const gfc_array_i16 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_16 * const restrict pwhich, - index_type size, char filler) + index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -183,7 +183,14 @@ eoshift1 (gfc_array_char * const restrict ret, else while (n--) { - memset (dest, filler, size); + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + dest += roffset; } @@ -234,9 +241,11 @@ eoshift1_16 (gfc_array_char * const restrict ret, const char * const restrict pbound, const GFC_INTEGER_16 * const restrict pwhich) { - eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), + "\0", 1); } + void eoshift1_16_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, @@ -256,7 +265,32 @@ eoshift1_16_char (gfc_array_char * const restrict ret, GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift1 (ret, array, h, pbound, pwhich, array_length, ' '); + eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); +} + + +void eoshift1_16_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i16 * const restrict, + const char * const restrict, + const GFC_INTEGER_16 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_16_char4); + +void +eoshift1_16_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), + (const char *) &space, sizeof (gfc_char4_t)); } #endif diff --git a/libgfortran/generated/eoshift1_4.c b/libgfortran/generated/eoshift1_4.c index 11cc71fc917..58ce7e9f5dd 100644 --- a/libgfortran/generated/eoshift1_4.c +++ b/libgfortran/generated/eoshift1_4.c @@ -42,7 +42,7 @@ eoshift1 (gfc_array_char * const restrict ret, const gfc_array_i4 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_4 * const restrict pwhich, - index_type size, char filler) + index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -183,7 +183,14 @@ eoshift1 (gfc_array_char * const restrict ret, else while (n--) { - memset (dest, filler, size); + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + dest += roffset; } @@ -234,9 +241,11 @@ eoshift1_4 (gfc_array_char * const restrict ret, const char * const restrict pbound, const GFC_INTEGER_4 * const restrict pwhich) { - eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), + "\0", 1); } + void eoshift1_4_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, @@ -256,7 +265,32 @@ eoshift1_4_char (gfc_array_char * const restrict ret, GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift1 (ret, array, h, pbound, pwhich, array_length, ' '); + eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); +} + + +void eoshift1_4_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i4 * const restrict, + const char * const restrict, + const GFC_INTEGER_4 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_4_char4); + +void +eoshift1_4_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), + (const char *) &space, sizeof (gfc_char4_t)); } #endif diff --git a/libgfortran/generated/eoshift1_8.c b/libgfortran/generated/eoshift1_8.c index 4b7d0e04f31..0e9c2f1442a 100644 --- a/libgfortran/generated/eoshift1_8.c +++ b/libgfortran/generated/eoshift1_8.c @@ -42,7 +42,7 @@ eoshift1 (gfc_array_char * const restrict ret, const gfc_array_i8 * const restrict h, const char * const restrict pbound, const GFC_INTEGER_8 * const restrict pwhich, - index_type size, char filler) + index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -183,7 +183,14 @@ eoshift1 (gfc_array_char * const restrict ret, else while (n--) { - memset (dest, filler, size); + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + dest += roffset; } @@ -234,9 +241,11 @@ eoshift1_8 (gfc_array_char * const restrict ret, const char * const restrict pbound, const GFC_INTEGER_8 * const restrict pwhich) { - eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), + "\0", 1); } + void eoshift1_8_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, @@ -256,7 +265,32 @@ eoshift1_8_char (gfc_array_char * const restrict ret, GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift1 (ret, array, h, pbound, pwhich, array_length, ' '); + eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); +} + + +void eoshift1_8_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i8 * const restrict, + const char * const restrict, + const GFC_INTEGER_8 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_8_char4); + +void +eoshift1_8_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const char * const restrict pbound, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), + (const char *) &space, sizeof (gfc_char4_t)); } #endif diff --git a/libgfortran/generated/eoshift3_16.c b/libgfortran/generated/eoshift3_16.c index 1dda668d47b..214f3783d4f 100644 --- a/libgfortran/generated/eoshift3_16.c +++ b/libgfortran/generated/eoshift3_16.c @@ -42,7 +42,7 @@ eoshift3 (gfc_array_char * const restrict ret, const gfc_array_i16 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_16 * const restrict pwhich, - index_type size, char filler) + index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -198,7 +198,14 @@ eoshift3 (gfc_array_char * const restrict ret, else while (n--) { - memset (dest, filler, size); + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + dest += roffset; } @@ -253,9 +260,11 @@ eoshift3_16 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict bound, const GFC_INTEGER_16 * const restrict pwhich) { - eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), + "\0", 1); } + extern void eoshift3_16_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, @@ -275,7 +284,32 @@ eoshift3_16_char (gfc_array_char * const restrict ret, GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift3 (ret, array, h, bound, pwhich, array_length, ' '); + eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); +} + + +extern void eoshift3_16_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i16 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_16 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_16_char4); + +void +eoshift3_16_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i16 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_16 * const restrict pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), + (const char *) &space, sizeof (gfc_char4_t)); } #endif diff --git a/libgfortran/generated/eoshift3_4.c b/libgfortran/generated/eoshift3_4.c index aa46f7c5a10..e96ef2504b0 100644 --- a/libgfortran/generated/eoshift3_4.c +++ b/libgfortran/generated/eoshift3_4.c @@ -42,7 +42,7 @@ eoshift3 (gfc_array_char * const restrict ret, const gfc_array_i4 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_4 * const restrict pwhich, - index_type size, char filler) + index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -198,7 +198,14 @@ eoshift3 (gfc_array_char * const restrict ret, else while (n--) { - memset (dest, filler, size); + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + dest += roffset; } @@ -253,9 +260,11 @@ eoshift3_4 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict bound, const GFC_INTEGER_4 * const restrict pwhich) { - eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), + "\0", 1); } + extern void eoshift3_4_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, @@ -275,7 +284,32 @@ eoshift3_4_char (gfc_array_char * const restrict ret, GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift3 (ret, array, h, bound, pwhich, array_length, ' '); + eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); +} + + +extern void eoshift3_4_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i4 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_4 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_4_char4); + +void +eoshift3_4_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i4 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_4 * const restrict pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), + (const char *) &space, sizeof (gfc_char4_t)); } #endif diff --git a/libgfortran/generated/eoshift3_8.c b/libgfortran/generated/eoshift3_8.c index 04e81b8eb39..dc39b94eb97 100644 --- a/libgfortran/generated/eoshift3_8.c +++ b/libgfortran/generated/eoshift3_8.c @@ -42,7 +42,7 @@ eoshift3 (gfc_array_char * const restrict ret, const gfc_array_i8 * const restrict h, const gfc_array_char * const restrict bound, const GFC_INTEGER_8 * const restrict pwhich, - index_type size, char filler) + index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -198,7 +198,14 @@ eoshift3 (gfc_array_char * const restrict ret, else while (n--) { - memset (dest, filler, size); + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + dest += roffset; } @@ -253,9 +260,11 @@ eoshift3_8 (gfc_array_char * const restrict ret, const gfc_array_char * const restrict bound, const GFC_INTEGER_8 * const restrict pwhich) { - eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), + "\0", 1); } + extern void eoshift3_8_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, @@ -275,7 +284,32 @@ eoshift3_8_char (gfc_array_char * const restrict ret, GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift3 (ret, array, h, bound, pwhich, array_length, ' '); + eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); +} + + +extern void eoshift3_8_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const gfc_array_i8 * const restrict, + const gfc_array_char * const restrict, + const GFC_INTEGER_8 * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_8_char4); + +void +eoshift3_8_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const gfc_array_i8 * const restrict h, + const gfc_array_char * const restrict bound, + const GFC_INTEGER_8 * const restrict pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ' '; + eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), + (const char *) &space, sizeof (gfc_char4_t)); } #endif diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index 4244acab5f8..60ef8532275 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1040,10 +1040,31 @@ GFORTRAN_1.1 { _gfortran_convert_char4_to_char1; _gfortran_cshift0_16; _gfortran_cshift0_16_char; + _gfortran_cshift0_1_char4; + _gfortran_cshift0_2_char4; + _gfortran_cshift0_4_char4; + _gfortran_cshift0_8_char4; + _gfortran_cshift1_16_char4; + _gfortran_cshift1_4_char4; + _gfortran_cshift1_8_char4; _gfortran_eoshift0_16; _gfortran_eoshift0_16_char; + _gfortran_eoshift0_1_char4; + _gfortran_eoshift0_2_char4; + _gfortran_eoshift0_4_char4; + _gfortran_eoshift0_8_char4; + _gfortran_eoshift1_16_char4; + _gfortran_eoshift1_4_char4; + _gfortran_eoshift1_8_char4; _gfortran_eoshift2_16; _gfortran_eoshift2_16_char; + _gfortran_eoshift2_1_char4; + _gfortran_eoshift2_2_char4; + _gfortran_eoshift2_4_char4; + _gfortran_eoshift2_8_char4; + _gfortran_eoshift3_16_char4; + _gfortran_eoshift3_4_char4; + _gfortran_eoshift3_8_char4; _gfortran_erfc_scaled_r10; _gfortran_erfc_scaled_r16; _gfortran_erfc_scaled_r4; @@ -1051,17 +1072,17 @@ GFORTRAN_1.1 { _gfortran_pack_char4; _gfortran_pack_s_char4; _gfortran_reshape_char4; - _gfortran_select_string_char4; _gfortran_selected_char_kind; + _gfortran_select_string_char4; _gfortran_spread_char4; _gfortran_spread_char4_scalar; - _gfortran_st_wait; _gfortran_string_index_char4; _gfortran_string_len_trim_char4; _gfortran_string_minmax_char4; _gfortran_string_scan_char4; _gfortran_string_trim_char4; _gfortran_string_verify_char4; + _gfortran_st_wait; _gfortran_transpose_char4; _gfortran_unpack0_char4; _gfortran_unpack1_char4; diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c index 71574658dda..76ce97e0f10 100644 --- a/libgfortran/intrinsics/cshift0.c +++ b/libgfortran/intrinsics/cshift0.c @@ -334,6 +334,24 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, GFC_INTEGER_4 array_length) \ { \ cshift0 (ret, array, *pshift, pdim ? *pdim : 1, array_length); \ + } \ + \ + extern void cshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + const GFC_INTEGER_##N *, GFC_INTEGER_4); \ + export_proto(cshift0_##N##_char4); \ + \ + void \ + cshift0_##N##_char4 (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length) \ + { \ + cshift0 (ret, array, *pshift, pdim ? *pdim : 1, \ + array_length * sizeof (gfc_char4_t)); \ } DEFINE_CSHIFT (1); diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c index c75199c4a2f..ac7a0ba85b6 100644 --- a/libgfortran/intrinsics/eoshift0.c +++ b/libgfortran/intrinsics/eoshift0.c @@ -39,7 +39,7 @@ Boston, MA 02110-1301, USA. */ static void eoshift0 (gfc_array_char * ret, const gfc_array_char * array, int shift, const char * pbound, int which, index_type size, - char filler) + const char *filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -175,7 +175,14 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, else while (n--) { - memset (dest, filler, size); + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size ; i += filler_len) + memcpy (&dest[i], filler, filler_len); + dest += roffset; } @@ -223,7 +230,7 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, const GFC_INTEGER_##N *pdim) \ { \ eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ - GFC_DESCRIPTOR_SIZE (array), 0); \ + GFC_DESCRIPTOR_SIZE (array), "\0", 1); \ } \ \ extern void eoshift0_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ @@ -244,7 +251,30 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, GFC_INTEGER_4 bound_length __attribute__((unused))) \ { \ eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ - array_length, ' '); \ + array_length, " ", 1); \ + } \ + \ + extern void eoshift0_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, const char *, \ + const GFC_INTEGER_##N *, GFC_INTEGER_4, \ + GFC_INTEGER_4); \ + export_proto(eoshift0_##N##_char4); \ + \ + void \ + eoshift0_##N##_char4 (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const char *pbound, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length, \ + GFC_INTEGER_4 bound_length __attribute__((unused))) \ + { \ + static const gfc_char4_t space = (unsigned char) ' '; \ + eoshift0 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ + array_length * sizeof (gfc_char4_t), (const char *) &space, \ + sizeof (gfc_char4_t)); \ } DEFINE_EOSHIFT (1); diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c index f74cb01fec8..239d9714a99 100644 --- a/libgfortran/intrinsics/eoshift2.c +++ b/libgfortran/intrinsics/eoshift2.c @@ -39,7 +39,7 @@ Boston, MA 02110-1301, USA. */ static void eoshift2 (gfc_array_char *ret, const gfc_array_char *array, int shift, const gfc_array_char *bound, int which, - index_type size, char filler) + index_type size, const char *filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -192,7 +192,14 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, else while (n--) { - memset (dest, filler, size); + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size ; i += filler_len) + memcpy (&dest[i], filler, filler_len); + dest += roffset; } @@ -243,7 +250,7 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, const GFC_INTEGER_##N *pdim) \ { \ eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ - GFC_DESCRIPTOR_SIZE (array), 0); \ + GFC_DESCRIPTOR_SIZE (array), "\0", 1); \ } \ \ extern void eoshift2_##N##_char (gfc_array_char *, GFC_INTEGER_4, \ @@ -265,7 +272,31 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, GFC_INTEGER_4 bound_length __attribute__((unused))) \ { \ eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ - array_length, ' '); \ + array_length, " ", 1); \ + } \ + \ + extern void eoshift2_##N##_char4 (gfc_array_char *, GFC_INTEGER_4, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + const gfc_array_char *, \ + const GFC_INTEGER_##N *, \ + GFC_INTEGER_4, GFC_INTEGER_4); \ + export_proto(eoshift2_##N##_char4); \ + \ + void \ + eoshift2_##N##_char4 (gfc_array_char *ret, \ + GFC_INTEGER_4 ret_length __attribute__((unused)), \ + const gfc_array_char *array, \ + const GFC_INTEGER_##N *pshift, \ + const gfc_array_char *pbound, \ + const GFC_INTEGER_##N *pdim, \ + GFC_INTEGER_4 array_length, \ + GFC_INTEGER_4 bound_length __attribute__((unused))) \ + { \ + static const gfc_char4_t space = (unsigned char) ' '; \ + eoshift2 (ret, array, *pshift, pbound, pdim ? *pdim : 1, \ + array_length * sizeof (gfc_char4_t), (const char *) &space, \ + sizeof (gfc_char4_t)); \ } DEFINE_EOSHIFT (1); diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c index 87e137e8e6c..0008db5b2fc 100644 --- a/libgfortran/intrinsics/string_intrinsics_inc.c +++ b/libgfortran/intrinsics/string_intrinsics_inc.c @@ -214,7 +214,7 @@ string_index (gfc_charlen_type slen, const CHARTYPE *str, gfc_charlen_type start, last, delta, i; if (sslen == 0) - return 1; + return back ? (slen + 1) : 1; if (sslen > slen) return 0; diff --git a/libgfortran/m4/cshift1.m4 b/libgfortran/m4/cshift1.m4 index 735621d4f7b..28fae596bd4 100644 --- a/libgfortran/m4/cshift1.m4 +++ b/libgfortran/m4/cshift1.m4 @@ -213,6 +213,7 @@ cshift1_'atype_kind` (gfc_array_char * const restrict ret, cshift1 (ret, array, h, pwhich, GFC_DESCRIPTOR_SIZE (array)); } + void cshift1_'atype_kind`_char (gfc_array_char * const restrict ret, GFC_INTEGER_4, const gfc_array_char * const restrict array, @@ -232,4 +233,24 @@ cshift1_'atype_kind`_char (gfc_array_char * const restrict ret, cshift1 (ret, array, h, pwhich, array_length); } + +void cshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4, + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4); +export_proto(cshift1_'atype_kind`_char4); + +void +cshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4 array_length) +{ + cshift1 (ret, array, h, pwhich, array_length * sizeof (gfc_char4_t)); +} + #endif' diff --git a/libgfortran/m4/eoshift1.m4 b/libgfortran/m4/eoshift1.m4 index efa38b201af..8ce24eff0f5 100644 --- a/libgfortran/m4/eoshift1.m4 +++ b/libgfortran/m4/eoshift1.m4 @@ -43,7 +43,7 @@ eoshift1 (gfc_array_char * const restrict ret, const 'atype` * const restrict h, const char * const restrict pbound, const 'atype_name` * const restrict pwhich, - index_type size, char filler) + index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -184,7 +184,14 @@ eoshift1 (gfc_array_char * const restrict ret, else while (n--) { - memset (dest, filler, size); + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + dest += roffset; } @@ -235,9 +242,11 @@ eoshift1_'atype_kind` (gfc_array_char * const restrict ret, const char * const restrict pbound, const 'atype_name` * const restrict pwhich) { - eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + eoshift1 (ret, array, h, pbound, pwhich, GFC_DESCRIPTOR_SIZE (array), + "\0", 1); } + void eoshift1_'atype_kind`_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, @@ -257,7 +266,32 @@ eoshift1_'atype_kind`_char (gfc_array_char * const restrict ret, GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift1 (ret, array, h, pbound, pwhich, array_length, ''` ''`); + eoshift1 (ret, array, h, pbound, pwhich, array_length, " ", 1); +} + + +void eoshift1_'atype_kind`_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const 'atype` * const restrict, + const char * const restrict, + const 'atype_name` * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift1_'atype_kind`_char4); + +void +eoshift1_'atype_kind`_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const char * const restrict pbound, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ''` ''`; + eoshift1 (ret, array, h, pbound, pwhich, array_length * sizeof (gfc_char4_t), + (const char *) &space, sizeof (gfc_char4_t)); } #endif' diff --git a/libgfortran/m4/eoshift3.m4 b/libgfortran/m4/eoshift3.m4 index 050f5277822..081ff927277 100644 --- a/libgfortran/m4/eoshift3.m4 +++ b/libgfortran/m4/eoshift3.m4 @@ -43,7 +43,7 @@ eoshift3 (gfc_array_char * const restrict ret, const 'atype` * const restrict h, const gfc_array_char * const restrict bound, const 'atype_name` * const restrict pwhich, - index_type size, char filler) + index_type size, const char * filler, index_type filler_len) { /* r.* indicates the return array. */ index_type rstride[GFC_MAX_DIMENSIONS]; @@ -199,7 +199,14 @@ eoshift3 (gfc_array_char * const restrict ret, else while (n--) { - memset (dest, filler, size); + index_type i; + + if (filler_len == 1) + memset (dest, filler[0], size); + else + for (i = 0; i < size; i += filler_len) + memcpy (&dest[i], filler, filler_len); + dest += roffset; } @@ -254,9 +261,11 @@ eoshift3_'atype_kind` (gfc_array_char * const restrict ret, const gfc_array_char * const restrict bound, const 'atype_name` * const restrict pwhich) { - eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), 0); + eoshift3 (ret, array, h, bound, pwhich, GFC_DESCRIPTOR_SIZE (array), + "\0", 1); } + extern void eoshift3_'atype_kind`_char (gfc_array_char * const restrict, GFC_INTEGER_4, const gfc_array_char * const restrict, @@ -276,7 +285,32 @@ eoshift3_'atype_kind`_char (gfc_array_char * const restrict ret, GFC_INTEGER_4 array_length, GFC_INTEGER_4 bound_length __attribute__((unused))) { - eoshift3 (ret, array, h, bound, pwhich, array_length, ''` ''`); + eoshift3 (ret, array, h, bound, pwhich, array_length, " ", 1); +} + + +extern void eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict, + GFC_INTEGER_4, + const gfc_array_char * const restrict, + const 'atype` * const restrict, + const gfc_array_char * const restrict, + const 'atype_name` * const restrict, + GFC_INTEGER_4, GFC_INTEGER_4); +export_proto(eoshift3_'atype_kind`_char4); + +void +eoshift3_'atype_kind`_char4 (gfc_array_char * const restrict ret, + GFC_INTEGER_4 ret_length __attribute__((unused)), + const gfc_array_char * const restrict array, + const 'atype` * const restrict h, + const gfc_array_char * const restrict bound, + const 'atype_name` * const restrict pwhich, + GFC_INTEGER_4 array_length, + GFC_INTEGER_4 bound_length __attribute__((unused))) +{ + static const gfc_char4_t space = (unsigned char) ''` ''`; + eoshift3 (ret, array, h, bound, pwhich, array_length * sizeof (gfc_char4_t), + (const char *) &space, sizeof (gfc_char4_t)); } #endif' diff --git a/libjava/ChangeLog b/libjava/ChangeLog index 37f12e2c892..d81c6ab7704 100644 --- a/libjava/ChangeLog +++ b/libjava/ChangeLog @@ -1,3 +1,14 @@ +2008-06-02 Ralf Wildenhues <Ralf.Wildenhues@gmx.de> + + * Makefile.am (mostlyclean-local): Use libtool --mode=clean. + * Makefile.in: Regenerate. + +2008-05-28 Andrew Haley <aph@redhat.com> + + * java/lang/Class.java (getSimpleName): Use getEnclosingClass(). + * testsuite/libjava.lang/PR35020.java: New cases. + * testsuite/libjava.lang/PR35020.out: New cases. + 2008-05-22 Andrew Haley <aph@redhat.com> PR libgcj/35020 diff --git a/libjava/Makefile.am b/libjava/Makefile.am index ec05b196c40..559f73ab0d9 100644 --- a/libjava/Makefile.am +++ b/libjava/Makefile.am @@ -372,7 +372,7 @@ DISTCLEANFILES = native.dirs mostlyclean-local: ## Use libtool rm to remove each libtool object - find . -name '*.lo' -print | xargs $(LIBTOOL) rm -f + find . -name '*.lo' -print | xargs $(LIBTOOL) --mode=clean rm -f distclean-local: ## Remove every .d file that was created. diff --git a/libjava/Makefile.in b/libjava/Makefile.in index b2fe1290a0b..ec33ea75912 100644 --- a/libjava/Makefile.in +++ b/libjava/Makefile.in @@ -81,7 +81,6 @@ subdir = . ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/libltdl/acinclude.m4 \ $(top_srcdir)/../config/acx.m4 \ - $(top_srcdir)/../config/confsubdir.m4 \ $(top_srcdir)/../config/depstand.m4 \ $(top_srcdir)/../config/enable.m4 \ $(top_srcdir)/../config/gxx-include-dir.m4 \ @@ -94,6 +93,7 @@ am__aclocal_m4_deps = $(top_srcdir)/libltdl/acinclude.m4 \ $(top_srcdir)/../config/lib-prefix.m4 \ $(top_srcdir)/../config/multi.m4 \ $(top_srcdir)/../config/no-executables.m4 \ + $(top_srcdir)/../config/override.m4 \ $(top_srcdir)/../config/proginstall.m4 \ $(top_srcdir)/../config/tls.m4 \ $(top_srcdir)/../config/unwind_ipinfo.m4 \ @@ -10311,7 +10311,7 @@ libgcj-tools-$(gcc_version).jar: classpath/tools/tools.zip cp $< $@ mostlyclean-local: - find . -name '*.lo' -print | xargs $(LIBTOOL) rm -f + find . -name '*.lo' -print | xargs $(LIBTOOL) --mode=clean rm -f distclean-local: find . -name '*.d' -print | xargs rm -f diff --git a/libjava/classpath/lib/java/lang/Class.class b/libjava/classpath/lib/java/lang/Class.class Binary files differindex ce854558e54..2e4126b71d9 100644 --- a/libjava/classpath/lib/java/lang/Class.class +++ b/libjava/classpath/lib/java/lang/Class.class diff --git a/libjava/java/lang/Class.java b/libjava/java/lang/Class.java index 868e370b819..a4e8ee5929e 100644 --- a/libjava/java/lang/Class.java +++ b/libjava/java/lang/Class.java @@ -1078,26 +1078,24 @@ public final class Class<T> if (isAnonymousClass()) return ""; if (isArray()) - { - return getComponentType().getSimpleName() + "[]"; - } + return getComponentType().getSimpleName() + "[]"; + String fullName = getName(); - int pos = fullName.lastIndexOf("$"); - if (pos == -1) - pos = 0; - else - { - ++pos; - while (Character.isDigit(fullName.charAt(pos))) - ++pos; - fullName = fullName.substring(pos); - } + Class enclosingClass = getEnclosingClass(); + if (enclosingClass == null) + // It's a top level class. + return fullName.substring(fullName.lastIndexOf(".") + 1); - int packagePos = fullName.lastIndexOf("."); - if (packagePos == -1) - return fullName; - else - return fullName.substring(packagePos + 1); + fullName = fullName.substring(enclosingClass.getName().length()); + + // We've carved off the enclosing class name; now we must have '$' + // followed optionally by digits, followed by the class name. + int pos = 1; + while (Character.isDigit(fullName.charAt(pos))) + ++pos; + fullName = fullName.substring(pos); + + return fullName; } /** diff --git a/libjava/testsuite/libjava.lang/PR35020.jar b/libjava/testsuite/libjava.lang/PR35020.jar Binary files differindex bedaed7ecdb..09c4ef4818d 100644 --- a/libjava/testsuite/libjava.lang/PR35020.jar +++ b/libjava/testsuite/libjava.lang/PR35020.jar diff --git a/libjava/testsuite/libjava.lang/PR35020.java b/libjava/testsuite/libjava.lang/PR35020.java index 1850da79683..ff5f6bf06f2 100644 --- a/libjava/testsuite/libjava.lang/PR35020.java +++ b/libjava/testsuite/libjava.lang/PR35020.java @@ -1,21 +1,30 @@ +class outer$inner +{ +}; + public class PR35020 { - class inner - { - } - public static void main(String[] args) - { - System.out.println(inner.class.getSimpleName()); - System.out.println(PR35020.class.getSimpleName()); - System.out.println(Class.class.getSimpleName()); - System.out.println((new int[7]).getClass().getSimpleName()); - System.out.println((new Object[1][1][1][1][1][1][1][1]).getClass().getSimpleName()); - System.out.println((new java.security.PrivilegedAction() - { - public Object run() { - return null; - } - }).getClass().getSimpleName()); - } + class PR35020$Inner + { + }; + class inner + { + } + public static void main(String[] args) + { + System.out.println(inner.class.getSimpleName()); + System.out.println(PR35020.class.getSimpleName()); + System.out.println(Class.class.getSimpleName()); + System.out.println((new int[7]).getClass().getSimpleName()); + System.out.println((new Object[1][1][1][1][1][1][1][1]).getClass().getSimpleName()); + System.out.println((new java.security.PrivilegedAction() + { + public Object run() { + return null; + } + }).getClass().getSimpleName()); + System.out.println(PR35020$Inner.class.getSimpleName()); + System.out.println(outer$inner.class.getSimpleName()); + System.out.println(outer$inner.inner.class.getSimpleName()); + } } - diff --git a/libjava/testsuite/libjava.lang/PR35020.out b/libjava/testsuite/libjava.lang/PR35020.out index 73eb0c917fc..9bf85e209d5 100644 --- a/libjava/testsuite/libjava.lang/PR35020.out +++ b/libjava/testsuite/libjava.lang/PR35020.out @@ -4,3 +4,6 @@ Class int[] Object[][][][][][][][] +PR35020$Inner +outer$inner +inner diff --git a/libobjc/ChangeLog b/libobjc/ChangeLog index df30eaae50c..fa0e059e089 100644 --- a/libobjc/ChangeLog +++ b/libobjc/ChangeLog @@ -1,3 +1,16 @@ +2008-05-30 Julian Brown <julian@codesourcery.com> + + * exception.c (__objc_exception_class): Initialise as constant + array for ARM EABI. Change macro to static const for non-ARM EABI. + (ObjcException): Add note about structure layout. Remove landingPad + and handlerSwitchValue for ARM EABI. + (get_ttype_entry): Add __ARM_EABI_UNWINDER__ version + of function. + (CONTINUE_UNWINDING): Define for ARM EABI/otherwise cases. + (PERSONALITY_FUNCTION): Use ARM EABI-specific arguments, and add + ARM EABI unwinding support. + (objc_exception_throw): Use memcpy to initialise exception class. + 2008-05-25 Alan Modra <amodra@bigpond.net.au> * encoding.c (strip_array_types): Rename from get_inner_array_type. diff --git a/libobjc/exception.c b/libobjc/exception.c index 4777c3bdd41..1a6b9dab4d1 100644 --- a/libobjc/exception.c +++ b/libobjc/exception.c @@ -31,16 +31,25 @@ Boston, MA 02110-1301, USA. */ #include "unwind-pe.h" +#ifdef __ARM_EABI_UNWINDER__ + +const _Unwind_Exception_Class __objc_exception_class + = {'G', 'N', 'U', 'C', 'O', 'B', 'J', 'C'}; + +#else + /* This is the exception class we report -- "GNUCOBJC". */ -#define __objc_exception_class \ - ((((((((_Unwind_Exception_Class) 'G' \ - << 8 | (_Unwind_Exception_Class) 'N') \ - << 8 | (_Unwind_Exception_Class) 'U') \ - << 8 | (_Unwind_Exception_Class) 'C') \ - << 8 | (_Unwind_Exception_Class) 'O') \ - << 8 | (_Unwind_Exception_Class) 'B') \ - << 8 | (_Unwind_Exception_Class) 'J') \ - << 8 | (_Unwind_Exception_Class) 'C') +static const _Unwind_Exception_Class __objc_exception_class + = ((((((((_Unwind_Exception_Class) 'G' + << 8 | (_Unwind_Exception_Class) 'N') + << 8 | (_Unwind_Exception_Class) 'U') + << 8 | (_Unwind_Exception_Class) 'C') + << 8 | (_Unwind_Exception_Class) 'O') + << 8 | (_Unwind_Exception_Class) 'B') + << 8 | (_Unwind_Exception_Class) 'J') + << 8 | (_Unwind_Exception_Class) 'C'); + +#endif /* This is the object that is passed around by the Objective C runtime to represent the exception in flight. */ @@ -50,12 +59,18 @@ struct ObjcException /* This bit is needed in order to interact with the unwind runtime. */ struct _Unwind_Exception base; - /* The actual object we want to throw. */ + /* The actual object we want to throw. Note: must come immediately after + unwind header. */ id value; +#ifdef __ARM_EABI_UNWINDER__ + /* Note: we use the barrier cache defined in the unwind control block for + ARM EABI. */ +#else /* Cache some internal unwind data between phase 1 and phase 2. */ _Unwind_Ptr landingPad; int handlerSwitchValue; +#endif }; @@ -106,6 +121,24 @@ parse_lsda_header (struct _Unwind_Context *context, const unsigned char *p, return p; } +#ifdef __ARM_EABI_UNWINDER__ + +static Class +get_ttype_entry (struct lsda_header_info *info, _uleb128_t i) +{ + _Unwind_Ptr ptr; + + ptr = (_Unwind_Ptr) (info->TType - (i * 4)); + ptr = _Unwind_decode_target2 (ptr); + + if (ptr) + return objc_get_class ((const char *) ptr); + else + return 0; +} + +#else + static Class get_ttype_entry (struct lsda_header_info *info, _Unwind_Word i) { @@ -122,6 +155,8 @@ get_ttype_entry (struct lsda_header_info *info, _Unwind_Word i) return 0; } +#endif + /* Like unto the method of the same name on Object, but takes an id. */ /* ??? Does this bork the meta-type system? Can/should we look up an isKindOf method on the id? */ @@ -150,12 +185,32 @@ isKindOf (id value, Class target) #define PERSONALITY_FUNCTION __gnu_objc_personality_v0 #endif +#ifdef __ARM_EABI_UNWINDER__ + +#define CONTINUE_UNWINDING \ + do \ + { \ + if (__gnu_unwind_frame(ue_header, context) != _URC_OK) \ + return _URC_FAILURE; \ + return _URC_CONTINUE_UNWIND; \ + } \ + while (0) + +_Unwind_Reason_Code +PERSONALITY_FUNCTION (_Unwind_State state, + struct _Unwind_Exception *ue_header, + struct _Unwind_Context *context) +#else + +#define CONTINUE_UNWINDING return _URC_CONTINUE_UNWIND + _Unwind_Reason_Code PERSONALITY_FUNCTION (int version, _Unwind_Action actions, _Unwind_Exception_Class exception_class, struct _Unwind_Exception *ue_header, struct _Unwind_Context *context) +#endif { struct ObjcException *xh = (struct ObjcException *) ue_header; @@ -165,19 +220,65 @@ PERSONALITY_FUNCTION (int version, const unsigned char *p; _Unwind_Ptr landing_pad, ip; int handler_switch_value; - int saw_cleanup = 0, saw_handler; + int saw_cleanup = 0, saw_handler, foreign_exception; void *return_object; + int ip_before_insn = 0; + +#ifdef __ARM_EABI_UNWINDER__ + _Unwind_Action actions; + + switch (state & _US_ACTION_MASK) + { + case _US_VIRTUAL_UNWIND_FRAME: + actions = _UA_SEARCH_PHASE; + break; + + case _US_UNWIND_FRAME_STARTING: + actions = _UA_CLEANUP_PHASE; + if (!(state & _US_FORCE_UNWIND) + && ue_header->barrier_cache.sp == _Unwind_GetGR (context, 13)) + actions |= _UA_HANDLER_FRAME; + break; + + case _US_UNWIND_FRAME_RESUME: + CONTINUE_UNWINDING; + break; + + default: + abort(); + } + actions |= state & _US_FORCE_UNWIND; + + /* TODO: Foreign exceptions need some attention (e.g. rethrowing doesn't + work). */ + foreign_exception = 0; + /* The dwarf unwinder assumes the context structure holds things like the + function and LSDA pointers. The ARM implementation caches these in + the exception header (UCB). To avoid rewriting everything we make the + virtual IP register point at the UCB. */ + ip = (_Unwind_Ptr) ue_header; + _Unwind_SetGR (context, 12, ip); + +#else /* !__ARM_EABI_UNWINDER. */ /* Interface version check. */ if (version != 1) return _URC_FATAL_PHASE1_ERROR; + + foreign_exception = (exception_class != __objc_exception_class); +#endif /* Shortcut for phase 2 found handler for domestic exception. */ if (actions == (_UA_CLEANUP_PHASE | _UA_HANDLER_FRAME) - && exception_class == __objc_exception_class) + && !foreign_exception) { +#ifdef __ARM_EABI_UNWINDER__ + handler_switch_value = (int) ue_header->barrier_cache.bitpattern[1]; + landing_pad = (_Unwind_Ptr) ue_header->barrier_cache.bitpattern[3]; +#else handler_switch_value = xh->handlerSwitchValue; landing_pad = xh->landingPad; +#endif goto install_context; } @@ -186,12 +287,18 @@ PERSONALITY_FUNCTION (int version, /* If no LSDA, then there are no handlers or cleanups. */ if (! language_specific_data) - return _URC_CONTINUE_UNWIND; + CONTINUE_UNWINDING; /* Parse the LSDA header. */ p = parse_lsda_header (context, language_specific_data, &info); info.ttype_base = base_of_encoded_value (info.ttype_encoding, context); +#ifdef HAVE_GETIPINFO + ip = _Unwind_GetIPInfo (context, &ip_before_insn); +#else ip = _Unwind_GetIP (context) - 1; +#endif + if (!ip_before_insn) + --ip; landing_pad = 0; action_record = 0; handler_switch_value = 0; @@ -250,7 +357,7 @@ PERSONALITY_FUNCTION (int version, /* If ip is not present in the table, C++ would call terminate. */ /* ??? As with Java, it's perhaps better to tweek the LSDA to that no-action is mapped to no-entry. */ - return _URC_CONTINUE_UNWIND; + CONTINUE_UNWINDING; found_something: saw_cleanup = 0; @@ -287,8 +394,7 @@ PERSONALITY_FUNCTION (int version, /* During forced unwinding, we only run cleanups. With a foreign exception class, we have no class info to match. */ - else if ((actions & _UA_FORCE_UNWIND) - || exception_class != __objc_exception_class) + else if ((actions & _UA_FORCE_UNWIND) || foreign_exception) ; else if (ar_filter > 0) @@ -318,18 +424,24 @@ PERSONALITY_FUNCTION (int version, } if (! saw_handler && ! saw_cleanup) - return _URC_CONTINUE_UNWIND; + CONTINUE_UNWINDING; if (actions & _UA_SEARCH_PHASE) { if (!saw_handler) - return _URC_CONTINUE_UNWIND; + CONTINUE_UNWINDING; /* For domestic exceptions, we cache data from phase 1 for phase 2. */ - if (exception_class == __objc_exception_class) + if (!foreign_exception) { +#ifdef __ARM_EABI_UNWINDER__ + ue_header->barrier_cache.sp = _Unwind_GetGR (context, 13); + ue_header->barrier_cache.bitpattern[1] = (_uw) handler_switch_value; + ue_header->barrier_cache.bitpattern[3] = (_uw) landing_pad; +#else xh->handlerSwitchValue = handler_switch_value; xh->landingPad = landing_pad; +#endif } return _URC_HANDLER_FOUND; } @@ -361,7 +473,9 @@ void objc_exception_throw (id value) { struct ObjcException *header = calloc (1, sizeof (*header)); - header->base.exception_class = __objc_exception_class; + + memcpy (&header->base.exception_class, &__objc_exception_class, + sizeof (__objc_exception_class)); header->base.exception_cleanup = __objc_exception_cleanup; header->value = value; diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index 1c023cfe827..1132ddd49da 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,35 @@ +2008-06-02 Sandra Loosemore <sandra@codesourcery.com> + Daniel Jacobowitz <dan@codesourcery.com> + + * testsuite/27_io/basic_filebuf/sputbackc/char/9425.cc: Use + dg-require-fileio. + * testsuite/27_io/basic_filebuf/sputbackc/char/1-out.cc: Likewise. + * testsuite/27_io/basic_filebuf/sputbackc/char/2-out.cc: Likewise. + +2008-06-02 Paolo Carlini <paolo.carlini@oracle.com> + + * include/bits/vector.tcc (vector<>::_M_insert_aux): In C++0x mode, + avoid a memory leak if the first __uninitialized_move_a throws. + (vector<>::_M_fill_insert): Do not always copy to __x_copy, similarly + to _M_insert_aux. + * testsuite/23_containers/vector/modifiers/moveable.cc: Adjust. + * testsuite/23_containers/vector/resize/moveable.cc: Likewise. + +2008-05-31 Paolo Carlini <paolo.carlini@oracle.com> + Chris Jefferson <chris@bubblescope.net> + + PR libstdc++/36338 + * include/bits/stl_heap.h (sort_heap): Use __pop_heap directly. + (pop_heap): Slightly tweak. + +2008-05-29 Paolo Carlini <paolo.carlini@oracle.com> + + * include/debug/bitset (bitset(const char*)): Implement DR 778 + in debug-mode too. + + * include/bits/cpp_type_traits.h (__is_integer): In C++0x mode + deal with char16_t and char32_t. + 2008-05-26 Paolo Carlini <paolo.carlini@oracle.com> * include/c_global/cmath (pow(float, int), pow(double, int), diff --git a/libstdc++-v3/include/bits/cpp_type_traits.h b/libstdc++-v3/include/bits/cpp_type_traits.h index 45b958f852d..b378abafcb4 100644 --- a/libstdc++-v3/include/bits/cpp_type_traits.h +++ b/libstdc++-v3/include/bits/cpp_type_traits.h @@ -180,6 +180,22 @@ _GLIBCXX_BEGIN_NAMESPACE(std) }; # endif +#ifdef __GXX_EXPERIMENTAL_CXX0X__ + template<> + struct __is_integer<char16_t> + { + enum { __value = 1 }; + typedef __true_type __type; + }; + + template<> + struct __is_integer<char32_t> + { + enum { __value = 1 }; + typedef __true_type __type; + }; +#endif + template<> struct __is_integer<short> { diff --git a/libstdc++-v3/include/bits/stl_heap.h b/libstdc++-v3/include/bits/stl_heap.h index bbe76e79634..4deafd2f4c7 100644 --- a/libstdc++-v3/include/bits/stl_heap.h +++ b/libstdc++-v3/include/bits/stl_heap.h @@ -1,6 +1,6 @@ // Heap implementation -*- C++ -*- -// Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 +// Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 // Free Software Foundation, Inc. // // This file is part of the GNU ISO C++ Library. This library is free @@ -285,7 +285,8 @@ _GLIBCXX_BEGIN_NAMESPACE(std) __glibcxx_requires_valid_range(__first, __last); __glibcxx_requires_heap(__first, __last); - std::__pop_heap(__first, __last - 1, __last - 1); + --__last; + std::__pop_heap(__first, __last, __last); } template<typename _RandomAccessIterator, typename _Distance, @@ -355,7 +356,8 @@ _GLIBCXX_BEGIN_NAMESPACE(std) __glibcxx_requires_valid_range(__first, __last); __glibcxx_requires_heap_pred(__first, __last, __comp); - std::__pop_heap(__first, __last - 1, __last - 1, __comp); + --__last; + std::__pop_heap(__first, __last, __last, __comp); } /** @@ -458,7 +460,10 @@ _GLIBCXX_BEGIN_NAMESPACE(std) __glibcxx_requires_heap(__first, __last); while (__last - __first > 1) - std::pop_heap(__first, _RandomAccessIterator(__last--)); + { + --__last; + std::__pop_heap(__first, __last, __last); + } } /** @@ -483,7 +488,10 @@ _GLIBCXX_BEGIN_NAMESPACE(std) __glibcxx_requires_heap_pred(__first, __last, __comp); while (__last - __first > 1) - std::pop_heap(__first, _RandomAccessIterator(__last--), __comp); + { + --__last; + std::__pop_heap(__first, __last, __last, __comp); + } } #ifdef __GXX_EXPERIMENTAL_CXX0X__ diff --git a/libstdc++-v3/include/bits/vector.tcc b/libstdc++-v3/include/bits/vector.tcc index 030cb3aabcc..462d18f6cbb 100644 --- a/libstdc++-v3/include/bits/vector.tcc +++ b/libstdc++-v3/include/bits/vector.tcc @@ -1,6 +1,6 @@ // Vector implementation (out of line) -*- C++ -*- -// Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 +// Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 // Free Software Foundation, Inc. // // This file is part of the GNU ISO C++ Library. This library is free @@ -305,22 +305,29 @@ _GLIBCXX_BEGIN_NESTED_NAMESPACE(std, _GLIBCXX_STD_D) { const size_type __len = _M_check_len(size_type(1), "vector::_M_insert_aux"); + const size_type __elems_before = __position - begin(); pointer __new_start(this->_M_allocate(__len)); pointer __new_finish(__new_start); try { + // The order of the three operations is dictated by the C++0x + // case, where the moves could alter a new element belonging + // to the existing vector. This is an issue only for callers + // taking the element by const lvalue ref (see 23.1/13). + this->_M_impl.construct(__new_start + __elems_before, #ifdef __GXX_EXPERIMENTAL_CXX0X__ - this->_M_impl.construct(__new_start + (__position - begin()), std::forward<_Args>(__args)...); +#else + __x); #endif + __new_finish = 0; + __new_finish = std::__uninitialized_move_a(this->_M_impl._M_start, __position.base(), __new_start, _M_get_Tp_allocator()); -#ifndef __GXX_EXPERIMENTAL_CXX0X__ - this->_M_impl.construct(__new_finish, __x); -#endif ++__new_finish; + __new_finish = std::__uninitialized_move_a(__position.base(), this->_M_impl._M_finish, @@ -329,7 +336,10 @@ _GLIBCXX_BEGIN_NESTED_NAMESPACE(std, _GLIBCXX_STD_D) } catch(...) { - std::_Destroy(__new_start, __new_finish, _M_get_Tp_allocator()); + if (!__new_finish) + this->_M_impl.destroy(__new_start + __elems_before); + else + std::_Destroy(__new_start, __new_finish, _M_get_Tp_allocator()); _M_deallocate(__new_start, __len); __throw_exception_again; } @@ -351,15 +361,10 @@ _GLIBCXX_BEGIN_NESTED_NAMESPACE(std, _GLIBCXX_STD_D) { if (__n != 0) { -#ifdef __GXX_EXPERIMENTAL_CXX0X__ - value_type __x_copy = __x; -#endif if (size_type(this->_M_impl._M_end_of_storage - this->_M_impl._M_finish) >= __n) { -#ifndef __GXX_EXPERIMENTAL_CXX0X__ value_type __x_copy = __x; -#endif const size_type __elems_after = end() - __position; pointer __old_finish(this->_M_impl._M_finish); if (__elems_after > __n) @@ -392,22 +397,24 @@ _GLIBCXX_BEGIN_NESTED_NAMESPACE(std, _GLIBCXX_STD_D) { const size_type __len = _M_check_len(__n, "vector::_M_fill_insert"); + const size_type __elems_before = __position - begin(); pointer __new_start(this->_M_allocate(__len)); pointer __new_finish(__new_start); try { + // See _M_insert_aux above. + std::__uninitialized_fill_n_a(__new_start + __elems_before, + __n, __x, + _M_get_Tp_allocator()); + __new_finish = 0; + __new_finish = std::__uninitialized_move_a(this->_M_impl._M_start, __position.base(), __new_start, _M_get_Tp_allocator()); -#ifdef __GXX_EXPERIMENTAL_CXX0X__ - std::__uninitialized_fill_n_a(__new_finish, __n, __x_copy, -#else - std::__uninitialized_fill_n_a(__new_finish, __n, __x, -#endif - _M_get_Tp_allocator()); __new_finish += __n; + __new_finish = std::__uninitialized_move_a(__position.base(), this->_M_impl._M_finish, @@ -416,8 +423,13 @@ _GLIBCXX_BEGIN_NESTED_NAMESPACE(std, _GLIBCXX_STD_D) } catch(...) { - std::_Destroy(__new_start, __new_finish, - _M_get_Tp_allocator()); + if (!__new_finish) + std::_Destroy(__new_start + __elems_before, + __new_start + __elems_before + __n, + _M_get_Tp_allocator()); + else + std::_Destroy(__new_start, __new_finish, + _M_get_Tp_allocator()); _M_deallocate(__new_start, __len); __throw_exception_again; } diff --git a/libstdc++-v3/include/debug/bitset b/libstdc++-v3/include/debug/bitset index db4b3c075d0..75474c806b5 100644 --- a/libstdc++-v3/include/debug/bitset +++ b/libstdc++-v3/include/debug/bitset @@ -134,6 +134,12 @@ namespace __debug __n = (std::basic_string<_CharT,_Traits,_Allocator>::npos)) : _Base(__str, __pos, __n) { } + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // 778. std::bitset does not have any constructor taking a string literal + explicit + bitset(const char* __s) + : _Base(__s) { } + bitset(const _Base& __x) : _Base(__x), _Safe_base() { } // 23.3.5.2 bitset operations: diff --git a/libstdc++-v3/testsuite/23_containers/vector/modifiers/moveable.cc b/libstdc++-v3/testsuite/23_containers/vector/modifiers/moveable.cc index 15adafc2671..9e466378a62 100644 --- a/libstdc++-v3/testsuite/23_containers/vector/modifiers/moveable.cc +++ b/libstdc++-v3/testsuite/23_containers/vector/modifiers/moveable.cc @@ -1,6 +1,6 @@ // { dg-options "-std=gnu++0x" } -// Copyright (C) 2005, 2007 Free Software Foundation, Inc. +// Copyright (C) 2005, 2006, 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 @@ -104,11 +104,11 @@ test04() std::vector<copycounter> a(10, c); copycounter::copycount = 0; a.insert(a.begin(), 20, c); - VERIFY(copycounter::copycount == 20 + 1); + VERIFY(copycounter::copycount == 20); a.insert(a.end(), 50, c); - VERIFY(copycounter::copycount == 70 + 2); + VERIFY(copycounter::copycount == 70); a.insert(a.begin() + 50, 100, c); - VERIFY(copycounter::copycount == 170 + 3); + VERIFY(copycounter::copycount == 170); } // Test vector::insert(iterator, count, value) makes no unneeded copies diff --git a/libstdc++-v3/testsuite/23_containers/vector/resize/moveable.cc b/libstdc++-v3/testsuite/23_containers/vector/resize/moveable.cc index f4dbc19da41..f24babc0792 100644 --- a/libstdc++-v3/testsuite/23_containers/vector/resize/moveable.cc +++ b/libstdc++-v3/testsuite/23_containers/vector/resize/moveable.cc @@ -1,6 +1,6 @@ // { dg-options "-std=gnu++0x" } -// Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. +// Copyright (C) 2005, 2006, 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 @@ -51,28 +51,28 @@ test01() a.resize(99); a.resize(100); #ifndef _GLIBCXX_DEBUG - VERIFY( copycounter::copycount == 100 + 4 ); + VERIFY( copycounter::copycount == 100 + 1 ); #else - VERIFY( copycounter::copycount == 100 + 4 + 4 ); + VERIFY( copycounter::copycount == 100 + 1 + 4 ); #endif a.resize(99); a.resize(0); #ifndef _GLIBCXX_DEBUG - VERIFY( copycounter::copycount == 100 + 4 ); + VERIFY( copycounter::copycount == 100 + 1 ); #else - VERIFY( copycounter::copycount == 100 + 4 + 6 ); + VERIFY( copycounter::copycount == 100 + 1 + 6 ); #endif a.resize(100); #ifndef _GLIBCXX_DEBUG - VERIFY( copycounter::copycount == 200 + 5 ); + VERIFY( copycounter::copycount == 200 + 2 ); #else - VERIFY( copycounter::copycount == 200 + 5 + 7 ); + VERIFY( copycounter::copycount == 200 + 2 + 7 ); #endif a.clear(); #ifndef _GLIBCXX_DEBUG - VERIFY( copycounter::copycount == 200 + 5 ); + VERIFY( copycounter::copycount == 200 + 2 ); #else - VERIFY( copycounter::copycount == 200 + 5 + 7 ); + VERIFY( copycounter::copycount == 200 + 2 + 7 ); #endif } diff --git a/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/1-out.cc b/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/1-out.cc index 2d89077c1dc..1fc40d7c1cd 100644 --- a/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/1-out.cc +++ b/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/1-out.cc @@ -20,6 +20,8 @@ // 27.8.1.4 Overridden virtual functions +// { dg-require-fileio "" } + #include <fstream> #include <testsuite_hooks.h> #include <testsuite_io.h> diff --git a/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/2-out.cc b/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/2-out.cc index 31ecfbd5e26..faf961248e4 100644 --- a/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/2-out.cc +++ b/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/2-out.cc @@ -20,6 +20,8 @@ // 27.8.1.4 Overridden virtual functions +// { dg-require-fileio "" } + #include <fstream> #include <testsuite_hooks.h> #include <testsuite_io.h> diff --git a/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/9425.cc b/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/9425.cc index a8465ed4061..2862ef01611 100644 --- a/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/9425.cc +++ b/libstdc++-v3/testsuite/27_io/basic_filebuf/sputbackc/char/9425.cc @@ -20,6 +20,8 @@ // 27.8.1.4 Overridden virtual functions +// { dg-require-fileio "" } + #include <fstream> #include <testsuite_hooks.h> |