diff options
| author | Andrey Belevantsev <abel@ispras.ru> | 2009-05-08 13:50:26 +0000 |
|---|---|---|
| committer | Andrey Belevantsev <abel@ispras.ru> | 2009-05-08 13:50:26 +0000 |
| commit | 21fa5c23a75b3289064fa6a009a84a51fe66c60f (patch) | |
| tree | 3735f0671579bbe13aafe2eb5c85d4d25ddf2ff2 | |
| parent | 9d3b33dceefa9d6f92784b0ff721eb8560776112 (diff) | |
Merge with trunk rev. 147267.
* cfgexpand.c: Reinstate recording of stack slot sharing
killed by the merge.
* alias-export.c (maybe_replace_with_partition): New.
(get_pointer_from_ref): Kill and do this in ...
(unshare_and_record_pta_info): ... here. Replace base
with its stack representative if needed.
(remove_exported_ddg_data): Check for null ddg_info.
git-svn-id: https://gcc.gnu.org/svn/gcc/branches/alias-export@147287 138bc75d-0d04-0410-961f-82ee72b054a4
144 files changed, 6157 insertions, 1803 deletions
diff --git a/ChangeLog b/ChangeLog index e3907beef71..39ad00f9602 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2009-05-07 Paolo Bonzini <bonzini@gnu.org> + + * config.guess: Sync with src. + +2009-05-07 Dave Korn <dave.korn.cygwin@gmail.com> + + * configure.ac ($with_ppl): Default to no if not supplied. + ($with_cloog): Likewise. + configure: Regenerate. + 2009-04-27 James E. Wilson <wilson@codesourcery.com> * MAINTAINERS: Update my e-mail address. diff --git a/config.guess b/config.guess index e5716eea733..b8cdd22573d 100755 --- a/config.guess +++ b/config.guess @@ -1116,7 +1116,10 @@ EOF # Left here for compatibility: # uname -m prints for DJGPP always 'pc', but it prints nothing about # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 diff --git a/config/ChangeLog b/config/ChangeLog index d0342028fb2..d670de4e371 100644 --- a/config/ChangeLog +++ b/config/ChangeLog @@ -1,3 +1,14 @@ +2009-05-07 Paolo Bonzini + + Sync from src: + 2009-02-02 Doug Evans <dje@google.com> + + * tcl.m4 (SC_PATH_TCLCONFIG): Don't exit 0 if tclconfig fails. + (SC_PATH_TKCONFIG): Don't exit 0 if tkconfig fails. + (SC_LOAD_TCLCONFIG): Quote all uses of TCL_BIN_DIR, it may contain + "# no Tcl configs found". + (SC_LOAD_TKCONFIG): Similarily for TK_BIN_DIR. + 2009-04-09 Jakub Jelinek <jakub@redhat.com> * lead-dot.m4: Change copyright header to refer to version diff --git a/config/tcl.m4 b/config/tcl.m4 index be0129b1bdf..900a2ceb81e 100644 --- a/config/tcl.m4 +++ b/config/tcl.m4 @@ -114,7 +114,6 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ if test x"${ac_cv_c_tclconfig}" = x ; then TCL_BIN_DIR="# no Tcl configs found" AC_MSG_WARN([Can't find Tcl configuration definitions]) - exit 0 else no_tcl= TCL_BIN_DIR=${ac_cv_c_tclconfig} @@ -237,7 +236,6 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ if test x"${ac_cv_c_tkconfig}" = x ; then TK_BIN_DIR="# no Tk configs found" AC_MSG_WARN([Can't find Tk configuration definitions]) - exit 0 else no_tk= TK_BIN_DIR=${ac_cv_c_tkconfig} @@ -285,7 +283,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. - if test -f ${TCL_BIN_DIR}/Makefile ; then + if test -f "${TCL_BIN_DIR}/Makefile" ; then TCL_LIB_SPEC=${TCL_BUILD_LIB_SPEC} TCL_STUB_LIB_SPEC=${TCL_BUILD_STUB_LIB_SPEC} TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH} @@ -295,7 +293,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ # against Tcl.framework installed in an arbitary location. case ${TCL_DEFS} in *TCL_FRAMEWORK*) - if test -f ${TCL_BIN_DIR}/${TCL_LIB_FILE}; then + if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then for i in "`cd ${TCL_BIN_DIR}; pwd`" \ "`cd ${TCL_BIN_DIR}/../..; pwd`"; do if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then @@ -304,7 +302,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ fi done fi - if test -f ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}; then + if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then TCL_STUB_LIB_SPEC="-L${TCL_BIN_DIR} ${TCL_STUB_LIB_FLAG}" TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" fi @@ -368,7 +366,7 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [ # of TK_BUILD_LIB_SPEC. An extension should make use of TK_LIB_SPEC # instead of TK_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. - if test -f ${TK_BIN_DIR}/Makefile ; then + if test -f "${TK_BIN_DIR}/Makefile" ; then TK_LIB_SPEC=${TK_BUILD_LIB_SPEC} TK_STUB_LIB_SPEC=${TK_BUILD_STUB_LIB_SPEC} TK_STUB_LIB_PATH=${TK_BUILD_STUB_LIB_PATH} @@ -378,7 +376,7 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [ # against Tk.framework installed in an arbitary location. case ${TK_DEFS} in *TK_FRAMEWORK*) - if test -f ${TK_BIN_DIR}/${TK_LIB_FILE}; then + if test -f "${TK_BIN_DIR}/${TK_LIB_FILE}"; then for i in "`cd ${TK_BIN_DIR}; pwd`" \ "`cd ${TK_BIN_DIR}/../..; pwd`"; do if test "`basename "$i"`" = "${TK_LIB_FILE}.framework"; then @@ -387,7 +385,7 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [ fi done fi - if test -f ${TK_BIN_DIR}/${TK_STUB_LIB_FILE}; then + if test -f "${TK_BIN_DIR}/${TK_STUB_LIB_FILE}"; then TK_STUB_LIB_SPEC="-L${TK_BIN_DIR} ${TK_STUB_LIB_FLAG}" TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}" fi diff --git a/configure b/configure index 45d85c98bd9..dd525c807ba 100755 --- a/configure +++ b/configure @@ -4843,6 +4843,8 @@ pplinc= if test "${with_ppl+set}" = set; then withval="$with_ppl" +else + with_ppl=no fi; # Check whether --with-ppl_include or --without-ppl_include was given. @@ -4961,6 +4963,8 @@ clooginc=" -DCLOOG_PPL_BACKEND " if test "${with_cloog+set}" = set; then withval="$with_cloog" +else + with_cloog=no fi; # Check whether --with-cloog_include or --without-cloog_include was given. diff --git a/configure.ac b/configure.ac index 0bb26e83a4a..a1e11c65071 100644 --- a/configure.ac +++ b/configure.ac @@ -1339,7 +1339,7 @@ pplinc= AC_ARG_WITH(ppl, [ --with-ppl=PATH Specify prefix directory for the installed PPL package Equivalent to --with-ppl-include=PATH/include - plus --with-ppl-lib=PATH/lib]) + plus --with-ppl-lib=PATH/lib],, with_ppl=no) AC_ARG_WITH(ppl_include, [ --with-ppl-include=PATH Specify directory for installed PPL include files]) AC_ARG_WITH(ppl_lib, [ --with-ppl-lib=PATH Specify the directory for the installed PPL library]) @@ -1394,7 +1394,7 @@ clooginc=" -DCLOOG_PPL_BACKEND " AC_ARG_WITH(cloog, [ --with-cloog=PATH Specify prefix directory for the installed CLooG-PPL package Equivalent to --with-cloog-include=PATH/include - plus --with-cloog-lib=PATH/lib]) + plus --with-cloog-lib=PATH/lib],, with_cloog=no) AC_ARG_WITH(cloog_include, [ --with-cloog-include=PATH Specify directory for installed CLooG include files]) AC_ARG_WITH(cloog_lib, [ --with-cloog-lib=PATH Specify the directory for the installed CLooG library]) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 3593d748295..abe70592493 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,133 @@ +2009-05-08 Kaz Kojima <kkojima@gcc.gnu.org> + + * config/sh/sh.c: Do not include c-pragma.h. + +2009-05-07 Andrew Pinski <andrew_pinski@playstation.sony.com> + + * config/spu/spu.c: Remove include of c-common.h. + +2009-05-07 Janis Johnson <janis187@us.ibm.com> + + PR c/39037 + * c-common.h (mark_valid_location_for_stdc_pragma, + valid_location_for_stdc_pragma_p, set_float_const_decimal64, + clear_float_const_decimal64, float_const_decimal64_p): New. + * c.opt (Wunsuffixed-float-constants): New. + * c-lex.c (interpret_float): Use pragma FLOAT_CONST_DECIMAL64 for + unsuffixed float constant, handle new warning. + * c-cppbuiltin.c (c_cpp_builtins): Use cast for double constants. + * c-decl.c (c_scope): New flag float_const_decimal64. + (set_float_const_decimal64, clear_float_const_decimal64, + float_const_decimal64_p): New. + (push_scope): Set new flag. + * c-parser.c (c_parser_translation_unit): Mark when it's valid + to use STDC pragmas. + (c_parser_external_declaration): Ditto. + (c_parser_compound_statement_nostart): Ditto. + * c-pragma.c (valid_location_for_stdc_pragma, + mark_valid_location_for_stdc_pragma, + valid_location_for_stdc_pragma_p, handle_stdc_pragma, + handle_pragma_float_const_decimal64): New. + (init_pragma): Register new pragma FLOAT_CONST_DECIMAL64. + * cp/semantics.c (valid_location_for_stdc_pragma_p, + set_float_const_decimal64, clear_float_const_decimal64, + float_const_decimal64_p): New dummy functions. + * doc/extend.texi (Decimal Float): Remove statement that the + pragma, and suffix for double constants, are not supported. + * doc/invoke.texi (Warning Options): List new option. + (-Wunsuffixed-float-constants): New. + +2009-05-08 Steven Bosscher <steven@gcc.gnu.org> + + * config/i386/i386.c: Do not include c-common.h. + +2009-05-07 Mark Heffernan <meheff@google.com> + + * doc/invoke.texi (Debugging Options): Document change of debugging + dump location. + * opts.c (decode_options): Make dump_base_name relative to + aux_base_name directory. + +2009-05-07 Hariharan Sandanagobalane <hariharan@picochip.com> + + * config/picochip/picochip.h (NO_DOLLAR_IN_LABEL): Added. + * config/picochip/libgccExtras/divmod15.asm : Removed redefiniton. + +2009-05-07 Rafael Avila de Espindola <espindola@google.com> + + * Makefile.in (install-plugin): Simplify a bit. + +2009-05-07 Paolo Bonzini <bonzini@gnu.org> + + * Makefile.in (OBJS-common): Add regcprop.o. + (regcprop.o): New. + * timevar.def (TV_CPROP_REGISTERS): New. + * regrename.c (regrename_optimize): Return 0. + (rest_of_handle_regrename): Delete. + (pass_rename_registers): Point to regrename_optimize. + (struct value_data_entry, struct value_data, + kill_value_one_regno, kill_value_regno, kill_value, + set_value_regno, init_value_data, kill_clobbered_value, + kill_set_value, kill_autoinc_value, copy_value, + mode_change_ok, maybe_mode_change, find_oldest_value_reg, + replace_oldest_value_reg, replace_oldest_value_addr, + replace_oldest_value_mem, copyprop_hardreg_forward_1, + debug_value_data, validate_value_data): Move... + * regcprop.c: ... here. + (rest_of_handle_cprop): Delete. + (pass_cprop_hardreg): Point to copyprop_hardreg_forward. + +2009-05-07 Jakub Jelinek <jakub@redhat.com> + + PR middle-end/40057 + * dojump.c (prefer_and_bit_test): Use immed_double_const instead of + GEN_INT for 1 << bitnum. + (do_jump) <case BIT_AND_EXPR>: Use build_int_cst_wide_type instead of + build_int_cst_type. + +2009-05-07 Uros Bizjak <ubizjak@gmail.com> + + * doc/md.texi (Standard Pattern Names For Generation) [sync_nand]: + Remove wrong description of "nand" functionality. + +2009-05-06 Richard Guenther <rguenther@suse.de> + Adam Nemet <anemet@caviumnetworks.com> + + * gimple.def (GIMPLE_ASSIGN): Fix incorrect information in the + comment. Add that if LHS is not a gimple register, then RHS1 has + to be a single object (GIMPLE_SINGLE_RHS). + +2009-05-06 Adam Nemet <anemet@caviumnetworks.com> + + * expr.c (get_def_for_expr): Move it up in the file. + (store_field): When expanding a bit-field store, look at the + defining gimple stmt for the masking conversion. + +2009-05-06 Janis Johnson <janis187@us.ibm.com> + + PR middle-end/39986 + * dfp.c (encode_decimal32, decode_decimal32, encode_decimal64, + decode_decimal64, encode_decimal128, decode_decimal128): Avoid + 32-bit memcpy into long. + +2009-05-06 Jakub Jelinek <jakub@redhat.com> + + * dwarf2out.c (new_reg_loc_descr): Don't ever create DW_OP_regX. + (one_reg_loc_descriptor): Create DW_OP_regX here instead of calling + new_reg_loc_descr. + (loc_by_reference): If loc is DW_OP_regX, change it into DW_OP_bregX 0 + instead of appending DW_OP_deref*. + +2009-05-06 Michael Matz <matz@suse.de> + + PR middle-end/40021 + * cfgexpand.c (maybe_cleanup_end_of_block): New static function. + (expand_gimple_cond): Use it to cleanup CFG and superfluous jumps. + +2009-05-06 Rafael Avila de Espindola <espindola@google.com> + + * Makefile.in (install-plugin): Fix srcdir handling. + 2009-05-06 Andrey Belevantsev <abel@ispras.ru> * tree-ssa.c (execute_update_address_taken): Handle TARGET_MEM_REF @@ -8,9 +138,8 @@ 2009-05-06 H.J. Lu <hongjiu.lu@intel.com> - * config/i386/i386.md ((unnamed inc/dec peephole): Use - optimize_insn_for_size_p instead - of optimize_size. + * config/i386/i386.md (unnamed inc/dec peephole): Use + optimize_insn_for_size_p instead of optimize_size. * config/i386/predicates.md (incdec_operand): Likewise. (aligned_operand): Likewise. * config/i386/sse.md (divv8sf3): Likewise. @@ -30,8 +159,7 @@ 2009-05-06 Joseph Myers <joseph@codesourcery.com> PR c/40032 - * c-decl.c (grokdeclarator): Handle incomplete type of unnamed - field. + * c-decl.c (grokdeclarator): Handle incomplete type of unnamed field. 2009-05-05 Jakub Jelinek <jakub@redhat.com> @@ -76,21 +204,20 @@ 2009-05-05 Richard Guenther <rguenther@suse.de> PR middle-end/40023 - * builtins.c (gimplify_va_arg_expr): Properly build the - address. + * builtins.c (gimplify_va_arg_expr): Properly build the address. 2009-05-05 Shujing Zhao <pearly.zhao@oracle.com> * tree.h (strip_float_extensions): Remove duplicate declaration. - (build_low_bits_mask, debug_fold_checksum, expand_function_end, - expand_function_start, stack_protect_prologue, stack_protect_epilogue, - block_ultimate_origin): Rearrange the declarations line to match the - comment that indicates the .c file which the functions are defined. - (dwarf2out_*, set_decl_rtl): Add comment. - (get_base_address): Adjust comment. - (change_decl_assembler_name, maybe_fold_*, build_addr): Rearrange the - declarations line and add comment. - (is_builtin_name): Add blank after function name, for clarity. + (build_low_bits_mask, debug_fold_checksum, expand_function_end, + expand_function_start, stack_protect_prologue, stack_protect_epilogue, + block_ultimate_origin): Rearrange the declarations line to match the + comment that indicates the .c file which the functions are defined. + (dwarf2out_*, set_decl_rtl): Add comment. + (get_base_address): Adjust comment. + (change_decl_assembler_name, maybe_fold_*, build_addr): Rearrange the + declarations line and add comment. + (is_builtin_name): Add blank after function name, for clarity. 2009-05-04 Joseph Myers <joseph@codesourcery.com> @@ -159,7 +286,7 @@ 2009-05-04 Michael Eager <eager@eagercon.com> * config/rs6000/rs6000.c (rs6000_legitimate_address): Allow - address for DImode/DFmode only if double-precision FP regs. + address for DImode/DFmode only if double-precision FP regs. 2009-05-04 Michael Eager <eager@eagercon.com> @@ -190,7 +317,8 @@ * config/bfin/bfin-protos.h (legitimize_address): Remove. * config/bfin/bfin.c (legitimize_address): Remove. * config/bfin/bfin.h (LEGITIMIZE_ADDRESS): Remove. - * config/m68hc11/m68hc11-protos.h (m68hc11_legitimize_address): Remove. + * config/m68hc11/m68hc11-protos.h (m68hc11_legitimize_address): + Remove. * config/m68hc11/m68hc11.c (m68hc11_legitimize_address): Remove. * config/m68hc11/m68hc11.h (LEGITIMIZE_ADDRESS): Remove. @@ -232,8 +360,10 @@ * gcc/config/alpha/alpha-protos.h (alpha_legitimize_address): Delete. * gcc/config/frv/frv-protos.h (frv_legitimize_address): Delete. * gcc/config/spu/spu-protos.h (spu_legitimize_address): Delete. - * gcc/config/xtensa/xtensa-protos.h (xtensa_legitimize_address): Delete. - * gcc/config/rs6000/rs6000-protos.h (rs6000_legitimize_address): Delete. + * gcc/config/xtensa/xtensa-protos.h (xtensa_legitimize_address): + Delete. + * gcc/config/rs6000/rs6000-protos.h (rs6000_legitimize_address): + Delete. * config/arm/arm.c (arm_legitimize_address): Maybe call Thumb version. * config/m32c/m32c.c (m32c_legitimize_address): Standardize. @@ -280,8 +410,7 @@ (pp_base_tree_identifier): Declare as function. (identifier_to_locale): Declare. * Makefile.in (pretty-print.o): Update dependencies. - * varasm.c (finish_aliases_1): Use %qE for identifiers in - diagnostics. + * varasm.c (finish_aliases_1): Use %qE for identifiers in diagnostics. 2009-05-04 Richard Guenther <rguenther@suse.de> @@ -403,9 +532,9 @@ * tree-ssa-coalesce.c (coalesce_cost): Do not take ciritical parameter; update callers. - (coalesce_cost_edge): EH edges are costier because they needs splitting - even if not critical and even more costier when there are multiple - EH predecestors. + (coalesce_cost_edge): EH edges are costier because they needs + splitting even if not critical and even more costier when there are + multiple EH predecestors. 2009-05-02 Jan Hubicka <jh@suse.cz> @@ -455,7 +584,8 @@ (ldst_entry): Rename to st_expr_entry, update users. (free_ldst_entry): Rename to free_st_expr_entry, update users. (free_ldst_mems): Rename to free_store_motion_mems, update users. - (enumerate_ldsts): Rename to enumerate_store_motion_mems, update caller. + (enumerate_ldsts): Rename to enumerate_store_motion_mems, + update caller. (first_ls_expr): Rename to first_st_expr, update users. (next_ls_expr): Rename to next_st_expr, update users. (print_ldst_list): Rename to print_store_motion_mems. Print names of @@ -507,8 +637,7 @@ 2009-04-30 Paul Pluzhnikov <ppluzhnikov@google.com> Roland McGrath <roland@redhat.com> - * configure.ac (HAVE_LD_BUILDID): New check for ld --build-id - support. + * configure.ac (HAVE_LD_BUILDID): New check for ld --build-id support. (ENABLE_LD_BUILDID): New configuration option. * gcc.c [HAVE_LD_BUILDID and ENABLE_LD_BUILDID] (LINK_BUILDID_SPEC): New macro. @@ -615,13 +744,13 @@ * config/avr/avr.h (CAN_ELIMINATE): Use avr_can_eliminate. (FRAME_POINTER_REQUIRED): Use avr_frame_pointer_required_p. (INITIAL_ELIMINATION_OFFSET): Use avr_initial_elimination_offset. - * config/avr/avr-protos.h (initial_elimination_offset) : Rename to + * config/avr/avr-protos.h (initial_elimination_offset): Rename to avr_initial_elimination_offset. (frame_pointer_required_p): Rename to avr_frame_pointer_required_p. (avr_initial_elimination_offset): Define. 2009-04-29 Eric Botcazou <ebotcazou@adacore.com> - Steven Bosscher <steven@gcc.gnu.org> + Steven Bosscher <steven@gcc.gnu.org> PR rtl-optimization/39938 * Makefile.in (cfgrtl.o): Add $(INSN_ATTR_H). @@ -681,12 +810,13 @@ (bfin_cpus): Add WA_LOAD_LCREGS as needed. (struct loop_info): Remove members INIT and LOOP_INIT. (bfin_optimize_loop): Don't set them. Reorder the code that generates - the LSETUP sequence. Allow LC to be loaded from any register, but also - add a case to push/pop a PREG scratch if ENABLE_WA_LOAD_LCREGS. + the LSETUP sequence. Allow LC to be loaded from any register, but + also add a case to push/pop a PREG scratch if ENABLE_WA_LOAD_LCREGS. (bfin_reorg_loops): When done, split all BB_ENDs with splitting_loops set to 1. * config/bfin/bfin.md (loop_end splitter): Use splitting_loops instead of reload_completed. + From Jie Zhang: * config/bfin/bfin.md (movsi_insn): Refine constraints. @@ -711,8 +841,8 @@ * config/bfin/bfin.c (bfin_optimize_loop): Unify handling of problematic last insns. Test for TYPE_CALL rather than CALL_P. - Remove special case testing for last insn of inner loops. Don't fail if - the loop ends with a jump, emit an extra nop instead. + Remove special case testing for last insn of inner loops. Don't fail + if the loop ends with a jump, emit an extra nop instead. * config/bfin/bfin.c (bfin_register_move_cost): Test for subsets of DREGS rather than comparing directly. Remove code that tries to @@ -734,12 +864,12 @@ * config/bfin/bfin.md (sp_or_sm, spm_string, spm_name): New macro. (ss<spm_name>hi3, ss<spm_name>hi3_parts, ss<spm_name>hi3_low_parts, - ss<spm_name_hi3_high_parts): New patterns, replacing ssaddhi3, ssubhi3, - ssaddhi3_parts and sssubhi3_parts. + ss<spm_name_hi3_high_parts): New patterns, replacing ssaddhi3, + ssubhi3, ssaddhi3_parts and sssubhi3_parts. (flag_mulhi3_parts): Produce a HImode output rather than trying to set a VEC_SELECT. - * config/bfin/bfin.c (bfin_expand_builtin, case BFIN_BUILTIN_CPLX_SQU): - Adjust accordingly. + * config/bfin/bfin.c (bfin_expand_builtin, + case BFIN_BUILTIN_CPLX_SQU): Adjust accordingly. 2009-04-28 Richard Guenther <rguenther@suse.de> @@ -8279,7 +8409,7 @@ * config/picochip/picochip.md (lea_add): Allow any nonimmediate in the lea_add. Reload eventually constraints it properly. - * config/picochip/constraints.md : Remove the target constraint + * config/picochip/constraints.md: Remove the target constraint "b", since it is not needed anymore. 2009-02-16 Jakub Jelinek <jakub@redhat.com> diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index f17877fccc8..0dedc0283d6 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20090506 +20090508 diff --git a/gcc/Makefile.in b/gcc/Makefile.in index 7984c475272..4a8747764a6 100644 --- a/gcc/Makefile.in +++ b/gcc/Makefile.in @@ -1175,6 +1175,7 @@ OBJS-common = \ real.o \ recog.o \ reg-stack.o \ + regcprop.o \ reginfo.o \ regmove.o \ regrename.o \ @@ -3058,6 +3059,10 @@ cfglayout.o : cfglayout.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \ $(DF_H) timevar.o : timevar.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \ $(TIMEVAR_H) $(FLAGS_H) intl.h $(TOPLEV_H) $(RTL_H) timevar.def +regcprop.o : regcprop.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \ + $(RTL_H) insn-config.h $(BASIC_BLOCK_H) $(REGS_H) hard-reg-set.h \ + output.h $(RECOG_H) $(FUNCTION_H) $(OBSTACK_H) $(FLAGS_H) $(TM_P_H) \ + addresses.h reload.h $(TOPLEV_H) $(TIMEVAR_H) $(TREE_PASS_H) $(DF_H) regrename.o : regrename.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \ $(RTL_H) insn-config.h $(BASIC_BLOCK_H) $(REGS_H) hard-reg-set.h \ output.h $(RECOG_H) $(FUNCTION_H) $(OBSTACK_H) $(FLAGS_H) $(TM_P_H) \ @@ -4020,6 +4025,7 @@ install-plugin: installdirs # other files are flattened to a single directory. $(mkinstalldirs) $(DESTDIR)$(plugin_includedir) headers=`echo $(PLUGIN_HEADERS) | tr ' ' '\n' | sort -u`; \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`; \ for file in $$headers; do \ if [ -f $$file ] ; then \ path=$$file; \ @@ -4028,8 +4034,8 @@ install-plugin: installdirs else continue; \ fi; \ case $$path in \ - "$(srcdir)"*/config/* | "$(srcdir)"*.def ) \ - base=`echo $$path | sed "s|$(srcdir)||"`;; \ + "$(srcdir)"/config/* | "$(srcdir)"/*.def ) \ + base=`echo "$$path" | sed -e "s|$$srcdirstrip/||"`;; \ *) base=`basename $$path` ;; \ esac; \ dest=$(plugin_includedir)/$$base; \ diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 04513875ba3..473d8f37bbe 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,44 @@ +2009-05-07 Arnaud Charlet <charlet@adacore.com> + + * gcc-interface/Make-lang.in: Update dependencies + +2009-05-06 Laurent GUERBY <laurent@guerby.net> + + * s-linux.ads, s-linux-alpha.ads, s-linux-hppa.ads, + osinte-linux.ads: Define sa_handler_pos. + * s-osinte-linux.ads: Use it. + * s-linux-mipsel.ads: New. + * system-linux-mips64el.ads: New. + * gcc-interface/Makefile.in: Multilib handling for + mipsel-linux and mips64el-linux. + +2009-05-06 Arnaud Charlet <charlet@adacore.com> + + * exp_ch5.adb, exp_util.adb, exp_attr.adb, sem_util.adb, sem_res.adb, + targparm.adb, targparm.ads, exp_ch4.adb, exp_ch6.adb, exp_disp.adb, + opt.ads, exp_aggr.adb, exp_intr.adb, sem_disp.adb, exp_ch3.adb + (Tagged_Type_Expansion): New flag. + Replace use of VM_Target related to tagged types expansion by + Tagged_Type_Expansion, since tagged type expansion is not necessarily + linked to VM targets. + +2009-05-06 Robert Dewar <dewar@adacore.com> + + * sem_attr.adb: Add processing for Standard'Compiler_Version + + * sinput.adb (Expr_Last_Char): Fix some copy-paste errors for paren + skipping. + (Expr_First_Char): Add ??? comment that paren skipping needs work + (Expr_Last_Char): Add ??? comment that paren skipping needs work + + * exp_attr.adb: Add processing for Compiler_Version + + * sem_attr.adb: New attribute Compiler_Version + + * snames.ads-tmpl: Add entries for Compiler_Version attribute + + * gnat_rm.texi: Document Compiler_Version attribute + 2009-05-06 Robert Dewar <dewar@adacore.com> * errout.adb: Minor reformatting diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 90473b77547..db9e1d7784c 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -56,7 +56,6 @@ with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; -with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; @@ -623,7 +622,9 @@ package body Exp_Aggr is -- with tagged components, but not clear whether it's worthwhile ???; -- in the case of the JVM, object tags are handled implicitly) - if Is_Tagged_Type (Component_Type (Typ)) and then VM_Target = No_VM then + if Is_Tagged_Type (Component_Type (Typ)) + and then Tagged_Type_Expansion + then return False; end if; @@ -1188,12 +1189,12 @@ package body Exp_Aggr is Append_To (L, A); -- Adjust the tag if tagged (because of possible view - -- conversions), unless compiling for the Java VM where + -- conversions), unless compiling for a VM where -- tags are implicit. if Present (Comp_Type) and then Is_Tagged_Type (Comp_Type) - and then VM_Target = No_VM + and then Tagged_Type_Expansion then A := Make_OK_Assignment_Statement (Loc, @@ -2619,7 +2620,7 @@ package body Exp_Aggr is -- the subsequent deep_adjust works properly (unless VM_Target, -- where tags are implicit). - if VM_Target = No_VM then + if Tagged_Type_Expansion then Instr := Make_OK_Assignment_Statement (Loc, Name => @@ -3032,7 +3033,9 @@ package body Exp_Aggr is -- tmp.comp._tag := comp_typ'tag; - if Is_Tagged_Type (Comp_Type) and then VM_Target = No_VM then + if Is_Tagged_Type (Comp_Type) + and then Tagged_Type_Expansion + then Instr := Make_OK_Assignment_Statement (Loc, Name => @@ -3155,7 +3158,7 @@ package body Exp_Aggr is elsif Is_CPP_Class (Typ) then null; - elsif Is_Tagged_Type (Typ) and then VM_Target = No_VM then + elsif Is_Tagged_Type (Typ) and then Tagged_Type_Expansion then Instr := Make_OK_Assignment_Statement (Loc, Name => @@ -5298,7 +5301,7 @@ package body Exp_Aggr is else Set_Etype (N, Typ); - if VM_Target = No_VM then + if Tagged_Type_Expansion then Expand_Record_Aggregate (N, Orig_Tag => New_Occurrence_Of @@ -5389,7 +5392,7 @@ package body Exp_Aggr is or else (Is_Entity_Name (Expr_Q) and then Ekind (Entity (Expr_Q)) in Formal_Kind)) - and then VM_Target = No_VM + and then Tagged_Type_Expansion then Static_Components := False; return True; @@ -5735,7 +5738,7 @@ package body Exp_Aggr is if Present (Orig_Tag) then Tag_Value := Orig_Tag; - elsif VM_Target /= No_VM then + elsif not Tagged_Type_Expansion then Tag_Value := Empty; else Tag_Value := @@ -5799,7 +5802,7 @@ package body Exp_Aggr is -- For a root type, the tag component is added (unless compiling -- for the VMs, where tags are implicit). - elsif VM_Target = No_VM then + elsif Tagged_Type_Expansion then declare Tag_Name : constant Node_Id := New_Occurrence_Of @@ -5901,7 +5904,7 @@ package body Exp_Aggr is begin return Static_Dispatch_Tables - and then VM_Target = No_VM + and then Tagged_Type_Expansion and then RTU_Loaded (Ada_Tags) -- Avoid circularity when rebuilding the compiler diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 6d835169841..bdc3c53502e 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1031,7 +1031,7 @@ package body Exp_Attr is elsif Is_Class_Wide_Type (Ptyp) and then Is_Interface (Ptyp) - and then VM_Target = No_VM + and then Tagged_Type_Expansion and then not (Nkind (Pref) in N_Has_Entity and then Is_Subprogram (Entity (Pref))) then @@ -3118,7 +3118,7 @@ package body Exp_Attr is -- accessibility check on virtual machines, so we omit it. if Ada_Version >= Ada_05 - and then VM_Target = No_VM + and then Tagged_Type_Expansion then Insert_Action (N, Make_Implicit_If_Statement (N, @@ -4355,7 +4355,7 @@ package body Exp_Attr is -- For VMs we leave the type attribute unexpanded because -- there's not a dispatching table to reference. - if VM_Target = No_VM then + if Tagged_Type_Expansion then Rewrite (N, Unchecked_Convert_To (RTE (RE_Tag), New_Reference_To @@ -4380,7 +4380,7 @@ package body Exp_Attr is -- Not needed for VM targets, since all handled by the VM - if VM_Target = No_VM then + if Tagged_Type_Expansion then Rewrite (N, Make_Explicit_Dereference (Loc, Unchecked_Convert_To (RTE (RE_Tag_Ptr), @@ -5238,6 +5238,7 @@ package body Exp_Attr is Attribute_Address_Size | Attribute_Base | Attribute_Class | + Attribute_Compiler_Version | Attribute_Default_Bit_Order | Attribute_Delta | Attribute_Denorm | diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 3a47042cae0..4138dd01858 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1865,7 +1865,7 @@ package body Exp_Ch3 is -- Suppress the tag adjustment when VM_Target because VM tags are -- represented implicitly in objects. - if Is_Tagged_Type (Typ) and then VM_Target = No_VM then + if Is_Tagged_Type (Typ) and then Tagged_Type_Expansion then Append_To (Res, Make_Assignment_Statement (Loc, Name => @@ -2159,7 +2159,7 @@ package body Exp_Ch3 is if not Is_Tagged_Type (Rec_Type) or else Etype (Rec_Type) = Rec_Type or else not Has_Discriminants (Etype (Rec_Type)) - or else VM_Target /= No_VM + or else not Tagged_Type_Expansion then return; end if; @@ -2292,7 +2292,7 @@ package body Exp_Ch3 is if Is_Tagged_Type (Rec_Type) and then not Is_CPP_Class (Rec_Type) - and then VM_Target = No_VM + and then Tagged_Type_Expansion and then not No_Run_Time_Mode then -- Initialize the primary tag @@ -4214,7 +4214,7 @@ package body Exp_Ch3 is -- Force construction of dispatch tables of library level tagged types - if VM_Target = No_VM + if Tagged_Type_Expansion and then Static_Dispatch_Tables and then Is_Library_Level_Entity (Def_Id) and then Is_Library_Level_Tagged_Type (Base_Typ) @@ -4523,7 +4523,7 @@ package body Exp_Ch3 is or else not Is_Ancestor (Root_Type (Typ), Etype (Expr))) and then Comes_From_Source (Def_Id) - and then VM_Target = No_VM + and then Tagged_Type_Expansion then declare Decl_1 : Node_Id; @@ -4650,7 +4650,7 @@ package body Exp_Ch3 is if Is_Tagged_Type (Typ) and then not Is_Class_Wide_Type (Typ) and then not Is_CPP_Class (Typ) - and then VM_Target = No_VM + and then Tagged_Type_Expansion and then Nkind (Expr) /= N_Aggregate then -- The re-assignment of the tag has to be done even if the @@ -5076,7 +5076,7 @@ package body Exp_Ch3 is if Has_Task (Typ) and then not Restriction_Active (No_Implicit_Heap_Allocations) and then not Global_Discard_Names - and then VM_Target = No_VM + and then Tagged_Type_Expansion then Set_Uses_Sec_Stack (Proc_Id); end if; @@ -5701,7 +5701,7 @@ package body Exp_Ch3 is -- Create the tag entities with a minimum decoration - if VM_Target = No_VM then + if Tagged_Type_Expansion then Append_Freeze_Actions (Def_Id, Make_Tags (Def_Id)); end if; @@ -5822,16 +5822,14 @@ package body Exp_Ch3 is -- VM_Target because the dispatching mechanism is handled -- internally by the VMs. - if VM_Target = No_VM then + if Tagged_Type_Expansion then Append_Freeze_Actions (Def_Id, Make_Tags (Def_Id)); -- Generate dispatch table of locally defined tagged type. -- Dispatch tables of library level tagged types are built -- later (see Analyze_Declarations). - if VM_Target = No_VM - and then not Has_Static_DT - then + if not Has_Static_DT then Append_Freeze_Actions (Def_Id, Make_DT (Def_Id)); end if; end if; @@ -5950,7 +5948,7 @@ package body Exp_Ch3 is Adjust_Discriminants (Def_Id); - if VM_Target = No_VM or else not Is_Interface (Def_Id) then + if Tagged_Type_Expansion or else not Is_Interface (Def_Id) then -- Do not need init for interfaces on e.g. CIL since they're -- abstract. Helps operation of peverify (the PE Verify tool). @@ -7934,7 +7932,7 @@ package body Exp_Ch3 is -- these bodies if No_Dispatching_Calls, Ravenscar or ZFP is active. if Ada_Version >= Ada_05 - and then VM_Target = No_VM + and then Tagged_Type_Expansion and then not Restriction_Active (No_Dispatching_Calls) and then not Restriction_Active (No_Select_Statements) and then RTE_Available (RE_Select_Specific_Data) @@ -8429,7 +8427,7 @@ package body Exp_Ch3 is -- these bodies if No_Dispatching_Calls, Ravenscar or ZFP is active. if Ada_Version >= Ada_05 - and then VM_Target = No_VM + and then Tagged_Type_Expansion and then not Is_Interface (Tag_Typ) and then ((Is_Interface (Etype (Tag_Typ)) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 42f6199f2af..6da8ff90e44 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -378,7 +378,7 @@ package body Exp_Ch4 is -- Do nothing in case of VM targets: the virtual machine will handle -- interfaces directly. - if VM_Target /= No_VM then + if not Tagged_Type_Expansion then return; end if; @@ -511,7 +511,7 @@ package body Exp_Ch4 is -- there does not seem to be any practical way of implementing it. if Ada_Version >= Ada_05 - and then VM_Target = No_VM + and then Tagged_Type_Expansion and then Is_Class_Wide_Type (DesigT) and then not Scope_Suppress (Accessibility_Check) and then @@ -626,7 +626,7 @@ package body Exp_Ch4 is if Is_Class_Wide_Type (Etype (Exp)) and then Is_Interface (Etype (Exp)) - and then VM_Target = No_VM + and then Tagged_Type_Expansion then Set_Expression (Expression (N), @@ -795,7 +795,7 @@ package body Exp_Ch4 is -- Suppress the tag assignment when VM_Target because VM tags are -- represented implicitly in objects. - if VM_Target /= No_VM then + if not Tagged_Type_Expansion then null; -- Ada 2005 (AI-251): Suppress the tag assignment with class-wide @@ -4302,7 +4302,7 @@ package body Exp_Ch4 is -- are not explicitly represented in Java objects, so the -- normal tagged membership expansion is not what we want). - if VM_Target = No_VM then + if Tagged_Type_Expansion then Rewrite (N, Tagged_Membership (N)); Analyze_And_Resolve (N, Rtyp); end if; @@ -7392,7 +7392,7 @@ package body Exp_Ch4 is -- on such run-time unit. and then - (VM_Target /= No_VM + (not Tagged_Type_Expansion or else not (RTU_Loaded (Ada_Tags) and then Nkind (Prefix (N)) = N_Selected_Component diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index c77ff0595bf..4cc66304ec9 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -4075,7 +4075,7 @@ package body Exp_Ch5 is -- does not seem to be any practical way to implement this check. elsif Ada_Version >= Ada_05 - and then VM_Target = No_VM + and then Tagged_Type_Expansion and then Is_Class_Wide_Type (R_Type) and then not Scope_Suppress (Accessibility_Check) and then @@ -4285,7 +4285,7 @@ package body Exp_Ch5 is Save_Tag : constant Boolean := Is_Tagged_Type (T) and then not No_Ctrl_Actions (N) - and then VM_Target = No_VM; + and then Tagged_Type_Expansion; -- Tags are not saved and restored when VM_Target because VM tags are -- represented implicitly in objects. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 2ea49a3c4af..1da82bafd03 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -68,7 +68,6 @@ with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; -with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; with Validsw; use Validsw; @@ -2574,7 +2573,7 @@ package body Exp_Ch6 is if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) and then Present (Controlling_Argument (N)) then - if VM_Target = No_VM then + if Tagged_Type_Expansion then Expand_Dispatching_Call (N); -- The following return is worrisome. Is it really OK to @@ -4820,7 +4819,7 @@ package body Exp_Ch6 is and then not Is_Abstract_Subprogram (Subp) and then Present (DTC_Entity (Subp)) and then Present (Scope (DTC_Entity (Subp))) - and then VM_Target = No_VM + and then Tagged_Type_Expansion and then not Restriction_Active (No_Dispatching_Calls) and then RTE_Available (RE_Tag) then diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 23dc728f988..977a90fc4a7 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -59,7 +59,6 @@ with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; -with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; @@ -249,7 +248,7 @@ package body Exp_Disp is begin if not Expander_Active - or else VM_Target /= No_VM + or else not Tagged_Type_Expansion then return; end if; @@ -806,7 +805,7 @@ package body Exp_Disp is or else (not Is_Class_Wide_Type (Iface_Typ) and then Is_Interface (Iface_Typ))); - if VM_Target /= No_VM then + if not Tagged_Type_Expansion then -- For VM, just do a conversion ??? diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index d3f9334a607..b35c35ea9df 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -39,6 +39,7 @@ with Freeze; use Freeze; with Namet; use Namet; with Nmake; use Nmake; with Nlists; use Nlists; +with Opt; use Opt; with Restrict; use Restrict; with Rident; use Rident; with Rtsfind; use Rtsfind; @@ -52,7 +53,6 @@ with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; -with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; with Urealp; use Urealp; @@ -219,7 +219,7 @@ package body Exp_Intr is -- checks are suppressed for the result type or VM_Target /= No_VM if Tag_Checks_Suppressed (Etype (Result_Typ)) - or else VM_Target /= No_VM + or else not Tagged_Type_Expansion then null; @@ -1034,7 +1034,7 @@ package body Exp_Intr is -- free (Base_Address (Obj_Ptr)) if Is_Interface (Directly_Designated_Type (Typ)) - and then VM_Target = No_VM + and then Tagged_Type_Expansion then Set_Expression (Free_Node, Unchecked_Convert_To (Typ, diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 8e5479738c8..1fe6526c77d 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -3880,7 +3880,7 @@ package body Exp_Util is -- initialization itself (and doesn't need or want the -- additional intermediate type to handle the assignment). - if Expander_Active and then VM_Target = No_VM then + if Expander_Active and then Tagged_Type_Expansion then EQ_Typ := Make_CW_Equivalent_Type (Unc_Typ, E); end if; diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index cac0bf810b0..564919d793e 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -1243,22 +1243,22 @@ ada/ada.o : ada/ada.ads ada/system.ads ada/ali-util.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/ali.ads ada/ali-util.ads ada/ali-util.adb \ - ada/alloc.ads ada/binderr.ads ada/casing.ads ada/csets.ads \ - ada/debug.ads ada/err_vars.ads ada/gnat.ads ada/g-htable.ads \ - ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/namet.ads \ - ada/namet.adb ada/opt.ads ada/osint.ads ada/output.ads ada/rident.ads \ - ada/scans.ads ada/scng.ads ada/scng.adb ada/sinput.ads ada/sinput.adb \ - ada/sinput-c.ads ada/snames.ads ada/stringt.ads ada/stringt.adb \ - ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \ - ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads \ - ada/s-htable.ads ada/s-htable.adb ada/s-memory.ads ada/s-os_lib.ads \ - ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ - ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads \ - ada/s-utf_32.adb ada/s-wchcon.ads ada/table.ads ada/table.adb \ - ada/tree_io.ads ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb \ - ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \ - ada/widechar.ads + ada/alloc.ads ada/atree.ads ada/binderr.ads ada/casing.ads \ + ada/csets.ads ada/debug.ads ada/einfo.ads ada/err_vars.ads ada/gnat.ads \ + ada/g-htable.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \ + ada/namet.ads ada/namet.adb ada/opt.ads ada/osint.ads ada/output.ads \ + ada/rident.ads ada/scans.ads ada/scng.ads ada/scng.adb ada/sinfo.ads \ + ada/sinput.ads ada/sinput.adb ada/sinput-c.ads ada/snames.ads \ + ada/stringt.ads ada/stringt.adb ada/styleg.ads ada/styleg.adb \ + ada/stylesw.ads ada/system.ads ada/s-carun8.ads ada/s-crc32.ads \ + ada/s-crc32.adb ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb \ + ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \ + ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ + ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \ + ada/s-unstyp.ads ada/s-utf_32.ads ada/s-utf_32.adb ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/types.adb \ + ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \ + ada/urealp.ads ada/urealp.adb ada/widechar.ads ada/ali.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \ ada/ali.ads ada/ali.adb ada/alloc.ads ada/butil.ads ada/casing.ads \ @@ -1523,17 +1523,18 @@ ada/errout.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/urealp.ads ada/widechar.ads ada/erroutc.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ - ada/a-uncdea.ads ada/alloc.ads ada/casing.ads ada/debug.ads \ - ada/err_vars.ads ada/erroutc.ads ada/erroutc.adb ada/hostparm.ads \ - ada/interfac.ads ada/namet.ads ada/namet.adb ada/opt.ads ada/output.ads \ - ada/output.adb ada/rident.ads ada/sinput.ads ada/sinput.adb \ - ada/snames.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \ - ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \ - ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ - ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ - ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \ - ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/widechar.ads + ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/casing.ads \ + ada/debug.ads ada/einfo.ads ada/err_vars.ads ada/erroutc.ads \ + ada/erroutc.adb ada/hostparm.ads ada/interfac.ads ada/namet.ads \ + ada/namet.adb ada/opt.ads ada/output.ads ada/output.adb ada/rident.ads \ + ada/sinfo.ads ada/sinput.ads ada/sinput.adb ada/snames.ads \ + ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads \ + ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \ + ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ + ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/targparm.ads ada/tree_io.ads \ + ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \ + ada/urealp.ads ada/widechar.ads ada/eval_fat.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \ @@ -2471,17 +2472,18 @@ ada/inline.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/instpar.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ - ada/a-uncdea.ads ada/alloc.ads ada/casing.ads ada/debug.ads \ - ada/gnatvsn.ads ada/hostparm.ads ada/instpar.ads ada/instpar.adb \ - ada/interfac.ads ada/namet.ads ada/opt.ads ada/output.ads \ - ada/sdefault.ads ada/sinput.ads ada/sinput.adb ada/sinput-l.ads \ + ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/casing.ads \ + ada/debug.ads ada/einfo.ads ada/gnatvsn.ads ada/hostparm.ads \ + ada/instpar.ads ada/instpar.adb ada/interfac.ads ada/namet.ads \ + ada/opt.ads ada/output.ads ada/sdefault.ads ada/sinfo.ads \ + ada/sinput.ads ada/sinput.adb ada/sinput-l.ads ada/snames.ads \ ada/system.ads ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb \ ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \ ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \ ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ - ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads \ - ada/widechar.ads + ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \ + ada/unchdeal.ads ada/urealp.ads ada/widechar.ads ada/interfac.o : ada/interfac.ads ada/system.ads @@ -2775,22 +2777,22 @@ ada/prep.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/unchdeal.ads ada/urealp.ads ada/prepcomp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ - ada/a-uncdea.ads ada/alloc.ads ada/casing.ads ada/csets.ads \ - ada/debug.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \ - ada/gnat.ads ada/g-dyntab.ads ada/g-dyntab.adb ada/g-hesorg.ads \ - ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib-writ.ads \ - ada/namet.ads ada/opt.ads ada/osint.ads ada/output.ads ada/prep.ads \ - ada/prepcomp.ads ada/prepcomp.adb ada/scans.ads ada/scn.ads \ - ada/scng.ads ada/scng.adb ada/sinput.ads ada/sinput.adb \ - ada/sinput-l.ads ada/snames.ads ada/stringt.ads ada/stringt.adb \ - ada/style.ads ada/styleg.ads ada/styleg.adb ada/stylesw.ads \ - ada/system.ads ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads \ - ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads \ - ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \ - ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ - ada/s-utf_32.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ - ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \ - ada/unchdeal.ads ada/urealp.ads ada/widechar.ads + ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/casing.ads \ + ada/csets.ads ada/debug.ads ada/einfo.ads ada/err_vars.ads \ + ada/errout.ads ada/erroutc.ads ada/gnat.ads ada/g-dyntab.ads \ + ada/g-dyntab.adb ada/g-hesorg.ads ada/hostparm.ads ada/interfac.ads \ + ada/lib.ads ada/lib-writ.ads ada/namet.ads ada/opt.ads ada/osint.ads \ + ada/output.ads ada/prep.ads ada/prepcomp.ads ada/prepcomp.adb \ + ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sinfo.ads \ + ada/sinput.ads ada/sinput.adb ada/sinput-l.ads ada/snames.ads \ + ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \ + ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-crc32.ads \ + ada/s-crc32.adb ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads \ + ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \ + ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \ + ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \ + ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \ + ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads ada/repinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \ @@ -3100,29 +3102,29 @@ ada/sem_attr.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \ ada/exp_disp.ads ada/exp_dist.ads ada/exp_pakd.ads ada/exp_tss.ads \ ada/exp_util.ads ada/exp_util.adb ada/expander.ads ada/fname.ads \ ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \ - ada/hostparm.ads ada/inline.ads ada/itypes.ads ada/lib.ads \ - ada/lib-xref.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \ - ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \ - ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/sdefault.ads \ - ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads ada/sem_attr.adb \ - ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch3.ads \ - ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads \ - ada/sem_dist.ads ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads \ - ada/sem_eval.adb ada/sem_intr.ads ada/sem_res.ads ada/sem_res.adb \ - ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \ - ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \ - ada/snames.adb ada/sprint.ads ada/stand.ads ada/stringt.ads \ - ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \ - ada/stylesw.ads ada/system.ads ada/s-carun8.ads ada/s-exctab.ads \ - ada/s-exctab.adb ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \ - ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-soflin.ads \ - ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ - ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \ - ada/tbuild.adb ada/tree_io.ads ada/ttypef.ads ada/ttypes.ads \ - ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb \ - ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \ - ada/validsw.ads ada/widechar.ads + ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/itypes.ads \ + ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/nlists.ads \ + ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \ + ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \ + ada/sdefault.ads ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \ + ada/sem_attr.adb ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch13.ads \ + ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch8.ads \ + ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_elim.ads \ + ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads ada/sem_res.ads \ + ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads \ + ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \ + ada/snames.ads ada/snames.adb ada/sprint.ads ada/stand.ads \ + ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \ + ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-carun8.ads \ + ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imenne.ads \ + ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \ + ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ + ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \ + ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \ + ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \ + ada/ttypef.ads ada/ttypes.ads ada/types.ads ada/types.adb ada/uintp.ads \ + ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \ + ada/urealp.adb ada/validsw.ads ada/widechar.ads ada/sem_aux.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \ @@ -3951,14 +3953,17 @@ ada/sinput-l.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/urealp.ads ada/widechar.ads ada/sinput.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ - ada/a-uncdea.ads ada/alloc.ads ada/casing.ads ada/debug.ads \ - ada/hostparm.ads ada/interfac.ads ada/namet.ads ada/namet.adb \ - ada/opt.ads ada/output.ads ada/sinput.ads ada/sinput.adb ada/system.ads \ - ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \ - ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \ - ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads \ - ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads + ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \ + ada/casing.ads ada/debug.ads ada/einfo.ads ada/hostparm.ads \ + ada/interfac.ads ada/namet.ads ada/namet.adb ada/nlists.ads \ + ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb \ + ada/sinput.ads ada/sinput.adb ada/snames.ads ada/system.ads \ + ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \ + ada/s-parame.ads ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads \ + ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \ + ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \ + ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \ + ada/urealp.ads ada/widechar.ads ada/snames.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/hostparm.ads \ diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index c7c515993e7..04553d4b2ce 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -1555,11 +1555,11 @@ ifeq ($(strip $(filter-out mips linux%,$(arch) $(osys))),) endif ifeq ($(strip $(filter-out mipsel linux%,$(arch) $(osys))),) - LIBGNAT_TARGET_PAIRS = \ + LIBGNAT_TARGET_PAIRS_COMMON = \ a-intnam.ads<a-intnam-linux.ads \ s-inmaop.adb<s-inmaop-posix.adb \ s-intman.adb<s-intman-posix.adb \ - s-linux.ads<s-linux.ads \ + s-linux.ads<s-linux-mipsel.ads \ s-osinte.adb<s-osinte-posix.adb \ s-osinte.ads<s-osinte-linux.ads \ s-osprim.adb<s-osprim-posix.adb \ @@ -1568,9 +1568,65 @@ ifeq ($(strip $(filter-out mipsel linux%,$(arch) $(osys))),) s-tasinf.adb<s-tasinf-linux.adb \ s-taspri.ads<s-taspri-posix-noaltstack.ads \ s-tpopsp.adb<s-tpopsp-posix-foreign.adb \ - g-sercom.adb<g-sercom-linux.adb \ + g-sercom.adb<g-sercom-linux.adb + + LIBGNAT_TARGET_PAIRS_32 = \ system.ads<system-linux-mipsel.ads + LIBGNAT_TARGET_PAIRS_64 = \ + system.ads<system-linux-mips64el.ads + + ifeq ($(strip $(shell $(GCC_FOR_TARGET) $(GNATLIBCFLAGS) -print-multi-os-directory)),../lib64) + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_64) + else + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_32) + endif + + TOOLS_TARGET_PAIRS = \ + mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \ + indepsw.adb<indepsw-gnu.adb + + EXTRA_GNATRTL_TASKING_OBJS=s-linux.o + EH_MECHANISM=-gcc + THREADSLIB = -lpthread + GNATLIB_SHARED = gnatlib-shared-dual + GMEM_LIB = gmemlib + PREFIX_OBJS = $(PREFIX_REAL_OBJS) + LIBRARY_VERSION := $(LIB_VERSION) +endif + +ifeq ($(strip $(filter-out mips64el linux%,$(arch) $(osys))),) + LIBGNAT_TARGET_PAIRS_COMMON = \ + a-intnam.ads<a-intnam-linux.ads \ + s-inmaop.adb<s-inmaop-posix.adb \ + s-intman.adb<s-intman-posix.adb \ + s-linux.ads<s-linux-mipsel.ads \ + s-osinte.adb<s-osinte-posix.adb \ + s-osinte.ads<s-osinte-linux.ads \ + s-osprim.adb<s-osprim-posix.adb \ + s-taprop.adb<s-taprop-linux.adb \ + s-tasinf.ads<s-tasinf-linux.ads \ + s-tasinf.adb<s-tasinf-linux.adb \ + s-taspri.ads<s-taspri-posix-noaltstack.ads \ + s-tpopsp.adb<s-tpopsp-posix-foreign.adb \ + g-sercom.adb<g-sercom-linux.adb + + LIBGNAT_TARGET_PAIRS_32 = \ + system.ads<system-linux-mipsel.ads + + LIBGNAT_TARGET_PAIRS_64 = \ + system.ads<system-linux-mips64el.ads + + ifeq ($(strip $(shell $(GCC_FOR_TARGET) $(GNATLIBCFLAGS) -print-multi-os-directory)),../lib64) + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_64) + else + LIBGNAT_TARGET_PAIRS = \ + $(LIBGNAT_TARGET_PAIRS_COMMON) $(LIBGNAT_TARGET_PAIRS_32) + endif + TOOLS_TARGET_PAIRS = \ mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \ indepsw.adb<indepsw-gnu.adb diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 229b7a60c25..2ff9c117680 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -222,6 +222,7 @@ Implementation Defined Attributes * AST_Entry:: * Bit:: * Bit_Position:: +* Compiler_Version:: * Code_Address:: * Default_Bit_Order:: * Elaborated:: @@ -5352,6 +5353,7 @@ consideration, you should minimize the use of these attributes. * AST_Entry:: * Bit:: * Bit_Position:: +* Compiler_Version:: * Code_Address:: * Default_Bit_Order:: * Elaborated:: @@ -5504,6 +5506,15 @@ type @code{Universal_Integer}. The value depends only on the field @var{C} and is independent of the alignment of the containing record @var{R}. +@node Compiler_Version +@unnumberedsec Compiler_Version +@findex Compiler_Version +@noindent +@code{Standard'Compiler_Version} (@code{Standard} is the only allowed +prefix) yields a static string identifying the version of the compiler +being used to compile the unit containing the attribute reference. A +typical result would be something like "GNAT Pro 6.3.0w (20090221)". + @node Code_Address @unnumberedsec Code_Address @findex Code_Address diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 229babfff00..e999c646b77 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1110,6 +1110,13 @@ package Opt is -- multiplied by the factor given here. The default value is used if no -- -gnatT switch appears. + Tagged_Type_Expansion : Boolean := True; + -- GNAT + -- Set True if tagged types and interfaces should be expanded by the + -- front-end. If False, the original tree is left unexpanded for + -- tagged types and dispatching calls, assuming the underlying target + -- supports it (e.g. case of JVM). + Task_Dispatching_Policy : Character := ' '; -- GNAT, GNATBIND -- Set to ' ' for the default case (no task dispatching policy specified). diff --git a/gcc/ada/s-linux-alpha.ads b/gcc/ada/s-linux-alpha.ads index 2f1112f7b2d..cdc716c727d 100644 --- a/gcc/ada/s-linux-alpha.ads +++ b/gcc/ada/s-linux-alpha.ads @@ -104,8 +104,9 @@ package System.Linux is -- struct_sigaction offsets - sa_mask_pos : constant := Standard'Address_Size / 8; - sa_flags_pos : constant := 128 + sa_mask_pos; + sa_handler_pos : constant := 0; + sa_mask_pos : constant := Standard'Address_Size / 8; + sa_flags_pos : constant := 128 + sa_mask_pos; SA_SIGINFO : constant := 16#40#; SA_ONSTACK : constant := 16#01#; diff --git a/gcc/ada/s-linux-hppa.ads b/gcc/ada/s-linux-hppa.ads index 2ee2ad9011d..16393c539f6 100644 --- a/gcc/ada/s-linux-hppa.ads +++ b/gcc/ada/s-linux-hppa.ads @@ -96,8 +96,9 @@ package System.Linux is -- struct_sigaction offsets - sa_flags_pos : constant := Standard'Address_Size / 8; - sa_mask_pos : constant := sa_flags_pos * 2; + sa_handler_pos : constant := 0; + sa_flags_pos : constant := Standard'Address_Size / 8; + sa_mask_pos : constant := sa_flags_pos * 2; SA_SIGINFO : constant := 16#10#; SA_ONSTACK : constant := 16#01#; diff --git a/gcc/ada/s-linux-mipsel.ads b/gcc/ada/s-linux-mipsel.ads new file mode 100644 index 00000000000..c0911d8d16a --- /dev/null +++ b/gcc/ada/s-linux-mipsel.ads @@ -0,0 +1,118 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . L I N U X -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- -- +-- GNARL 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. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the mipsel version of this package + +-- This package encapsulates cpu specific differences between implementations +-- of GNU/Linux, in order to share s-osinte-linux.ads. + +-- PLEASE DO NOT add any with-clauses to this package or remove the pragma +-- Preelaborate. This package is designed to be a bottom-level (leaf) package + +package System.Linux is + pragma Preelaborate; + + ----------- + -- Errno -- + ----------- + + EAGAIN : constant := 11; + EINTR : constant := 4; + EINVAL : constant := 22; + ENOMEM : constant := 12; + EPERM : constant := 1; + ETIMEDOUT : constant := 110; + + ------------- + -- Signals -- + ------------- + + SIGHUP : constant := 1; -- hangup + SIGINT : constant := 2; -- interrupt (rubout) + SIGQUIT : constant := 3; -- quit (ASCD FS) + SIGILL : constant := 4; -- illegal instruction (not reset) + SIGTRAP : constant := 5; -- trace trap (not reset) + SIGIOT : constant := 6; -- IOT instruction + SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future + SIGFPE : constant := 8; -- floating point exception + SIGKILL : constant := 9; -- kill (cannot be caught or ignored) + SIGBUS : constant := 7; -- bus error + SIGSEGV : constant := 11; -- segmentation violation + SIGPIPE : constant := 13; -- write on a pipe with no one to read it + SIGALRM : constant := 14; -- alarm clock + SIGTERM : constant := 15; -- software termination signal from kill + SIGUSR1 : constant := 10; -- user defined signal 1 + SIGUSR2 : constant := 12; -- user defined signal 2 + SIGCLD : constant := 17; -- alias for SIGCHLD + SIGCHLD : constant := 17; -- child status change + SIGPWR : constant := 30; -- power-fail restart + SIGWINCH : constant := 28; -- window size change + SIGURG : constant := 23; -- urgent condition on IO channel + SIGPOLL : constant := 29; -- pollable event occurred + SIGIO : constant := 29; -- I/O now possible (4.2 BSD) + SIGLOST : constant := 29; -- File lock lost + SIGSTOP : constant := 19; -- stop (cannot be caught or ignored) + SIGTSTP : constant := 20; -- user stop requested from tty + SIGCONT : constant := 18; -- stopped process has been continued + SIGTTIN : constant := 21; -- background tty read attempted + SIGTTOU : constant := 22; -- background tty write attempted + SIGVTALRM : constant := 26; -- virtual timer expired + SIGPROF : constant := 27; -- profiling timer expired + SIGXCPU : constant := 24; -- CPU time limit exceeded + SIGXFSZ : constant := 25; -- filesize limit exceeded + SIGUNUSED : constant := 31; -- unused signal (GNU/Linux) + SIGSTKFLT : constant := 16; -- coprocessor stack fault (Linux) + SIGLTHRRES : constant := 32; -- GNU/LinuxThreads restart signal + SIGLTHRCAN : constant := 33; -- GNU/LinuxThreads cancel signal + SIGLTHRDBG : constant := 34; -- GNU/LinuxThreads debugger signal + + -- struct_sigaction offsets + + sa_handler_pos : constant := Standard'Address_Size / 8; + sa_mask_pos : constant := 2 * Standard'Address_Size / 8; + sa_flags_pos : constant := 0; + + SA_SIGINFO : constant := 16#04#; + SA_ONSTACK : constant := 16#08000000#; + + type struct_pthread_fast_lock is record + status : Long_Integer; + spinlock : Integer; + end record; + pragma Convention (C, struct_pthread_fast_lock); + + type pthread_mutex_t is record + m_reserved : Integer; + m_count : Integer; + m_owner : System.Address; + m_kind : Integer; + m_lock : struct_pthread_fast_lock; + end record; + pragma Convention (C, pthread_mutex_t); + +end System.Linux; diff --git a/gcc/ada/s-linux.ads b/gcc/ada/s-linux.ads index b0612bd2d42..83b07c018e6 100644 --- a/gcc/ada/s-linux.ads +++ b/gcc/ada/s-linux.ads @@ -94,8 +94,9 @@ package System.Linux is -- struct_sigaction offsets - sa_mask_pos : constant := Standard'Address_Size / 8; - sa_flags_pos : constant := 128 + sa_mask_pos; + sa_handler_pos : constant := 0; + sa_mask_pos : constant := Standard'Address_Size / 8; + sa_flags_pos : constant := 128 + sa_mask_pos; SA_SIGINFO : constant := 16#04#; SA_ONSTACK : constant := 16#08000000#; diff --git a/gcc/ada/s-osinte-linux.ads b/gcc/ada/s-osinte-linux.ads index a663aa8de9b..5d2fdccb69f 100644 --- a/gcc/ada/s-osinte-linux.ads +++ b/gcc/ada/s-osinte-linux.ads @@ -513,9 +513,9 @@ private pragma Warnings (Off); for struct_sigaction use record - sa_handler at 0 range 0 .. Standard'Address_Size - 1; - sa_mask at Linux.sa_mask_pos range 0 .. 1023; - sa_flags at Linux.sa_flags_pos range 0 .. Standard'Address_Size - 1; + sa_handler at Linux.sa_handler_pos range 0 .. Standard'Address_Size - 1; + sa_mask at Linux.sa_mask_pos range 0 .. 1023; + sa_flags at Linux.sa_flags_pos range 0 .. Standard'Address_Size - 1; end record; -- We intentionally leave sa_restorer unspecified and let the compiler -- append it after the last field, so disable corresponding warning. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 3a123d9985e..028d8b54ac3 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -35,6 +35,7 @@ with Exp_Dist; use Exp_Dist; with Exp_Util; use Exp_Util; with Expander; use Expander; with Freeze; use Freeze; +with Gnatvsn; use Gnatvsn; with Itypes; use Itypes; with Lib; use Lib; with Lib.Xref; use Lib.Xref; @@ -2544,6 +2545,16 @@ package body Sem_Attr is Set_Etype (N, RTE (RE_Address)); + ---------------------- + -- Compiler_Version -- + ---------------------- + + when Attribute_Compiler_Version => + Check_E0; + Check_Standard_Prefix; + Rewrite (N, Make_String_Literal (Loc, "GNAT " & Gnat_Version_String)); + Analyze_And_Resolve (N, Standard_String); + -------------------- -- Component_Size -- -------------------- @@ -7482,6 +7493,7 @@ package body Sem_Attr is Attribute_Caller | Attribute_Class | Attribute_Code_Address | + Attribute_Compiler_Version | Attribute_Count | Attribute_Default_Bit_Order | Attribute_Elaborated | diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index c44c8e8d0fc..7c69da1ade1 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -50,7 +50,6 @@ with Sem_Util; use Sem_Util; with Snames; use Snames; with Stand; use Stand; with Sinfo; use Sinfo; -with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; @@ -1742,7 +1741,7 @@ package body Sem_Disp is -- the VM back-ends directly handle the generation of dispatching -- calls and would have to undo any expansion to an indirect call. - if VM_Target = No_VM then + if Tagged_Type_Expansion then Expand_Dispatching_Call (Call_Node); -- Expansion of a dispatching call results in an indirect call, which in diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 9b285c3cde2..d6113d88a7e 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -72,7 +72,6 @@ with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; with Style; use Style; -with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; with Urealp; use Urealp; @@ -7844,13 +7843,13 @@ package body Sem_Res is -- undesired dependence on such run-time unit. and then - (VM_Target /= No_VM - or else not - (RTU_Loaded (Ada_Tags) - and then Nkind (Prefix (N)) = N_Selected_Component - and then Present (Entity (Selector_Name (Prefix (N)))) - and then Entity (Selector_Name (Prefix (N))) = - RTE_Record_Component (RE_Prims_Ptr))) + (not Tagged_Type_Expansion + or else not + (RTU_Loaded (Ada_Tags) + and then Nkind (Prefix (N)) = N_Selected_Component + and then Present (Entity (Selector_Name (Prefix (N)))) + and then Entity (Selector_Name (Prefix (N))) = + RTE_Record_Component (RE_Prims_Ptr))) then Apply_Range_Check (Drange, Etype (Index)); end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d7e85261dfe..31f3ccd1a4d 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -5920,7 +5920,7 @@ package body Sem_Util is -- uninitialized case. Note that this applies both to the -- uTag entry and the main vtable pointer (CPP_Class case). - and then (VM_Target = No_VM or else not Is_Tag (Ent)) + and then (Tagged_Type_Expansion or else not Is_Tag (Ent)) then return False; end if; diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 949fcc3afa2..020e69df26d 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -317,6 +317,11 @@ package body Sinput is Loc := Sloc (N); + -- Skip past parens + + -- This is not right, it does not deal with skipping comments + -- and probably also has wide character problems ??? + if Count > 0 then declare SFI : constant Source_File_Index := @@ -408,7 +413,7 @@ package body Sinput is N_Conditional_Expression => raise Program_Error; - -- Cases where the Sloc points to the start of the tokem, but we + -- Cases where the Sloc points to the start of the token, but we -- still need to handle the sequence of left parentheses. when N_Identifier | @@ -425,25 +430,44 @@ package body Sinput is Loc := Sloc (N); - if Count > 0 then - declare - SFI : constant Source_File_Index := - Get_Source_File_Index (Loc); - Src : constant Source_Buffer_Ptr := Source_Text (SFI); - Fst : constant Source_Ptr := Source_Last (SFI); + -- Now we have two tasks, first we are pointing to the start + -- of the token below, second, we need to skip parentheses. - begin + -- Skipping to the end of a token is not easy, we can't just + -- skip to a space, since we may have e.g. X*YAR+Z, and if we + -- are finding the end of the subexpression X*YAR, we don't + -- want to skip past the +Z. Also we have to worry about + -- skipping comments, and about wide characters ??? + + declare + SFI : constant Source_File_Index := + Get_Source_File_Index (Loc); + Src : constant Source_Buffer_Ptr := Source_Text (SFI); + Lst : constant Source_Ptr := Source_Last (SFI); + + begin + -- Scan through first blank character, to get to the end + -- of this token. As noted above that's not really right??? + + loop + exit when Loc = Lst or else Src (Loc + 1) <= ' '; + Loc := Loc + 1; + end loop; + + -- Skip past parens, but this also ignores comments ??? + + if Count > 0 then for J in 1 .. Count loop loop - exit when Loc = Fst; - Loc := Loc - 1; + exit when Loc = Lst; + Loc := Loc + 1; exit when Src (Loc) >= ' '; end loop; - exit when Src (Loc) /= '('; + exit when Src (Loc) /= ')'; end loop; - end; - end if; + end if; + end; return Loc; end case; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 60a91a39b43..263269ca0a5 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -688,6 +688,7 @@ package Snames is Name_Callable : constant Name_Id := N + $; Name_Caller : constant Name_Id := N + $; Name_Code_Address : constant Name_Id := N + $; -- GNAT + Name_Compiler_Version : constant Name_Id := N + $; -- GNAT Name_Component_Size : constant Name_Id := N + $; Name_Compose : constant Name_Id := N + $; Name_Constrained : constant Name_Id := N + $; @@ -1188,6 +1189,7 @@ package Snames is Attribute_Callable, Attribute_Caller, Attribute_Code_Address, + Attribute_Compiler_Version, Attribute_Component_Size, Attribute_Compose, Attribute_Constrained, diff --git a/gcc/ada/system-linux-mips64el.ads b/gcc/ada/system-linux-mips64el.ads new file mode 100644 index 00000000000..0c848717365 --- /dev/null +++ b/gcc/ada/system-linux-mips64el.ads @@ -0,0 +1,152 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M -- +-- -- +-- S p e c -- +-- (GNU-Linux/MIPS64EL Version) -- +-- -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 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. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package System is + pragma Pure; + -- Note that we take advantage of the implementation permission to make + -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada + -- 2005, this is Pure in any case (AI-362). + + type Name is (SYSTEM_NAME_GNAT); + System_Name : constant Name := SYSTEM_NAME_GNAT; + + -- System-Dependent Named Numbers + + Min_Int : constant := Long_Long_Integer'First; + Max_Int : constant := Long_Long_Integer'Last; + + Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size; + Max_Nonbinary_Modulus : constant := Integer'Last; + + Max_Base_Digits : constant := Long_Long_Float'Digits; + Max_Digits : constant := Long_Long_Float'Digits; + + Max_Mantissa : constant := 63; + Fine_Delta : constant := 2.0 ** (-Max_Mantissa); + + Tick : constant := 0.000_001; + + -- Storage-related Declarations + + type Address is private; + Null_Address : constant Address; + + Storage_Unit : constant := 8; + Word_Size : constant := 64; + Memory_Size : constant := 2 ** 64; + + -- Address comparison + + function "<" (Left, Right : Address) return Boolean; + function "<=" (Left, Right : Address) return Boolean; + function ">" (Left, Right : Address) return Boolean; + function ">=" (Left, Right : Address) return Boolean; + function "=" (Left, Right : Address) return Boolean; + + pragma Import (Intrinsic, "<"); + pragma Import (Intrinsic, "<="); + pragma Import (Intrinsic, ">"); + pragma Import (Intrinsic, ">="); + pragma Import (Intrinsic, "="); + + -- Other System-Dependent Declarations + + type Bit_Order is (High_Order_First, Low_Order_First); + Default_Bit_Order : constant Bit_Order := Low_Order_First; + pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning + + -- Priority-related Declarations (RM D.1) + + Max_Priority : constant Positive := 30; + Max_Interrupt_Priority : constant Positive := 31; + + subtype Any_Priority is Integer range 0 .. 31; + subtype Priority is Any_Priority range 0 .. 30; + subtype Interrupt_Priority is Any_Priority range 31 .. 31; + + Default_Priority : constant Priority := 15; + +private + + type Address is mod Memory_Size; + Null_Address : constant Address := 0; + + -------------------------------------- + -- System Implementation Parameters -- + -------------------------------------- + + -- These parameters provide information about the target that is used + -- by the compiler. They are in the private part of System, where they + -- can be accessed using the special circuitry in the Targparm unit + -- whose source should be consulted for more detailed descriptions + -- of the individual switch values. + + AAMP : constant Boolean := False; + Backend_Divide_Checks : constant Boolean := False; + Backend_Overflow_Checks : constant Boolean := False; + Command_Line_Args : constant Boolean := True; + Compiler_System_Version : constant Boolean := False; + Configurable_Run_Time : constant Boolean := False; + Denorm : constant Boolean := True; + Duration_32_Bits : constant Boolean := False; + Exit_Status_Supported : constant Boolean := True; + Fractional_Fixed_Ops : constant Boolean := False; + Frontend_Layout : constant Boolean := False; + Functions_Return_By_DSP : constant Boolean := False; + Machine_Overflows : constant Boolean := False; + Machine_Rounds : constant Boolean := True; + OpenVMS : constant Boolean := False; + Preallocated_Stacks : constant Boolean := False; + Signed_Zeros : constant Boolean := True; + Stack_Check_Default : constant Boolean := False; + Stack_Check_Probes : constant Boolean := False; + Support_64_Bit_Divides : constant Boolean := True; + Support_Aggregates : constant Boolean := True; + Support_Composite_Assign : constant Boolean := True; + Support_Composite_Compare : constant Boolean := True; + Support_Long_Shifts : constant Boolean := True; + Suppress_Standard_Library : constant Boolean := False; + Use_Ada_Main_Program_Name : constant Boolean := False; + ZCX_By_Default : constant Boolean := True; + GCC_ZCX_Support : constant Boolean := True; + Front_End_ZCX_Support : constant Boolean := False; + + -- Obsolete entries, to be removed eventually (bootstrap issues!) + + High_Integrity_Mode : constant Boolean := False; + Long_Shifts_Inlined : constant Boolean := True; + +end System; diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index da42ba8b7b5..d78201d3016 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2009, 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- -- @@ -560,6 +560,7 @@ package body Targparm is when CLI => if Result then VM_Target := CLI_Target; + Tagged_Type_Expansion := False; end if; when CRT => Configurable_Run_Time_On_Target := Result; @@ -571,6 +572,7 @@ package body Targparm is when JVM => if Result then VM_Target := JVM_Target; + Tagged_Type_Expansion := False; end if; when MOV => Machine_Overflows_On_Target := Result; diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index 55f56652608..fd74ea5cbc9 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -220,7 +220,9 @@ package Targparm is type Virtual_Machine_Kind is (No_VM, JVM_Target, CLI_Target); VM_Target : Virtual_Machine_Kind := No_VM; -- Kind of virtual machine targetted - -- Needs comments, don't depend on names ??? + -- No_VM: no virtual machine, default case of a standard processor + -- JVM_Target: Java Virtual Machine + -- CLI_Target: CLI/.NET Virtual Machine ------------------------------- -- Backend Arithmetic Checks -- diff --git a/gcc/alias-export.c b/gcc/alias-export.c index 6e3516c8771..01b328e3dc6 100644 --- a/gcc/alias-export.c +++ b/gcc/alias-export.c @@ -103,29 +103,29 @@ static struct ddg_info_def *ddg_info; static unsigned int ddg_export_disambiguations = 0; -/* Return the pointer on which REF access is based, or NULL, - if there's no such thing. */ +/* Replace *PBASE with its stack representative in EXPR, if any. + Return EXPR back. */ static tree -get_pointer_from_ref (tree ref) +maybe_replace_with_partition (tree expr, tree *pbase) { - HOST_WIDE_INT of, sz, maxsz; - tree base; + tree *pdecl; - if (SSA_VAR_P (ref) - || handled_component_p (ref) - || INDIRECT_REF_P (ref)) - { - base = get_ref_base_and_extent (ref, &of, &sz, &maxsz); - if (INDIRECT_REF_P (base)) - return TREE_OPERAND (base, 0); - } - return NULL; + if (!decls_to_stack) + return expr; + pdecl = (tree *) pointer_map_contains (decls_to_stack, *pbase); + if (!pdecl + || *pdecl == *pbase) + return expr; + if (*pbase == expr) + return *pdecl; + *pbase = *pdecl; + return expr; } /* Change points-to set for POINTER in PID so that it would have all conflicting stack vars. */ static void -mark_conflict_stack_vars (tree pointer ATTRIBUTE_UNUSED, struct ptr_info_def *pid) +mark_conflict_stack_vars (tree pointer, struct ptr_info_def *pid) { bitmap_iterator bi; unsigned i; @@ -161,34 +161,50 @@ mark_conflict_stack_vars (tree pointer ATTRIBUTE_UNUSED, struct ptr_info_def *pi /* Record the final points-to set and returns orig expr. */ tree -unshare_and_record_pta_info (tree orig_expr) +unshare_and_record_pta_info (tree expr) { - struct ptr_info_def **ppid, *pid; - tree pointer, old_expr; + tree base, old_expr, *pbase; - /* No point saving anything for calls. */ - if (TREE_CODE (orig_expr) == CALL_EXPR) - return NULL; + /* No point saving anything for unhandled stuff. */ + if (! (SSA_VAR_P (expr) + || handled_component_p (expr) + || INDIRECT_REF_P (expr))) + return NULL_TREE; - old_expr = orig_expr; - orig_expr = unshare_expr (orig_expr); + /* Unshare the tree and do replacement in ddg info. */ + old_expr = expr; + expr = unshare_expr (expr); if (flag_ddg_export) - replace_var_in_datarefs (old_expr, orig_expr); + replace_var_in_datarefs (old_expr, expr); - pointer = get_pointer_from_ref (orig_expr); - if (! pointer - || TREE_CODE (pointer) != SSA_NAME - || (pid = SSA_NAME_PTR_INFO (pointer)) == NULL) - return orig_expr; + base = expr, pbase = &expr; + while (handled_component_p (base)) + { + pbase = &TREE_OPERAND (base, 0); + base = TREE_OPERAND (base, 0); + } + if (DECL_P (base) + || TREE_CODE (base) == SSA_NAME) + expr = maybe_replace_with_partition (expr, pbase); + else if (INDIRECT_REF_P (base)) + { + struct ptr_info_def **ppid, *pid; + + base = TREE_OPERAND (base, 0); + if (TREE_CODE (base) == SSA_NAME + && (pid = SSA_NAME_PTR_INFO (base)) != NULL) + { + if (!exprs_to_ptas) + exprs_to_ptas = pointer_map_create (); + ppid = (struct ptr_info_def **) pointer_map_insert (exprs_to_ptas, + expr); + *ppid = pid; + + mark_conflict_stack_vars (base, pid); + } + } - mark_conflict_stack_vars (pointer, pid); - - if (!exprs_to_ptas) - exprs_to_ptas = pointer_map_create (); - ppid = (struct ptr_info_def **) pointer_map_insert (exprs_to_ptas, orig_expr); - *ppid = pid; - - return orig_expr; + return expr; } /* Record the DECL mapping to its PART_DECL representative. */ @@ -600,6 +616,9 @@ walk_mems (rtx *x, void *data ATTRIBUTE_UNUSED) void remove_exported_ddg_data (rtx insn) { + if (!ddg_info) + return; + for_each_rtx (&PATTERN (insn), walk_mems, NULL); } diff --git a/gcc/c-common.h b/gcc/c-common.h index 14448800ce0..250a7ff74fa 100644 --- a/gcc/c-common.h +++ b/gcc/c-common.h @@ -809,6 +809,11 @@ extern void warn_logical_operator (location_t, enum tree_code, extern void check_main_parameter_types (tree decl); extern bool c_determine_visibility (tree); extern bool same_scalar_type_ignoring_signedness (tree, tree); +extern void mark_valid_location_for_stdc_pragma (bool); +extern bool valid_location_for_stdc_pragma_p (void); +extern void set_float_const_decimal64 (void); +extern void clear_float_const_decimal64 (void); +extern bool float_const_decimal64_p (void); #define c_sizeof(T) c_sizeof_or_alignof_type (T, true, 1) #define c_alignof(T) c_sizeof_or_alignof_type (T, false, 1) diff --git a/gcc/c-cppbuiltin.c b/gcc/c-cppbuiltin.c index 8b776b15dbc..921addbccf0 100644 --- a/gcc/c-cppbuiltin.c +++ b/gcc/c-cppbuiltin.c @@ -619,14 +619,11 @@ c_cpp_builtins (cpp_reader *pfile) TARGET_DEC_EVAL_METHOD); builtin_define_float_constants ("FLT", "F", "%s", float_type_node); - /* Cast the double precision constants when single precision constants are - specified. The correct result is computed by the compiler when using - macros that include a cast. This has the side-effect of making the value - unusable in const expressions. */ - if (flag_single_precision_constant) - builtin_define_float_constants ("DBL", "L", "((double)%s)", double_type_node); - else - builtin_define_float_constants ("DBL", "", "%s", double_type_node); + /* Cast the double precision constants. This is needed when single + precision constants are specified or when pragma FLOAT_CONST_DECIMAL64 + is used. The correct result is computed by the compiler when using + macros that include a cast. */ + builtin_define_float_constants ("DBL", "L", "((double)%s)", double_type_node); builtin_define_float_constants ("LDBL", "L", "%s", long_double_type_node); /* For decfloat.h. */ diff --git a/gcc/c-decl.c b/gcc/c-decl.c index 85c4d6bf02d..409c458e195 100644 --- a/gcc/c-decl.c +++ b/gcc/c-decl.c @@ -342,6 +342,9 @@ struct GTY((chain_next ("%h.outer"))) c_scope { /* True means make a BLOCK for this scope no matter what. */ BOOL_BITFIELD keep : 1; + + /* True means that an unsuffixed float constant is _Decimal64. */ + BOOL_BITFIELD float_const_decimal64 : 1; }; /* The scope currently in effect. */ @@ -674,6 +677,30 @@ keep_next_level (void) keep_next_level_flag = true; } +/* Set the flag for the FLOAT_CONST_DECIMAL64 pragma being ON. */ + +void +set_float_const_decimal64 (void) +{ + current_scope->float_const_decimal64 = true; +} + +/* Clear the flag for the FLOAT_CONST_DECIMAL64 pragma. */ + +void +clear_float_const_decimal64 (void) +{ + current_scope->float_const_decimal64 = false; +} + +/* Return nonzero if an unsuffixed float constant is _Decimal64. */ + +bool +float_const_decimal64_p (void) +{ + return current_scope->float_const_decimal64; +} + /* Identify this scope as currently being filled with parameters. */ void @@ -705,6 +732,13 @@ push_scope (void) keep_next_level_flag = false; next_is_function_body = false; + + /* The FLOAT_CONST_DECIMAL64 pragma applies to nested scopes. */ + if (current_scope->outer) + current_scope->float_const_decimal64 + = current_scope->outer->float_const_decimal64; + else + current_scope->float_const_decimal64 = false; } else { @@ -717,6 +751,12 @@ push_scope (void) else scope = GGC_CNEW (struct c_scope); + /* The FLOAT_CONST_DECIMAL64 pragma applies to nested scopes. */ + if (current_scope) + scope->float_const_decimal64 = current_scope->float_const_decimal64; + else + scope->float_const_decimal64 = false; + scope->keep = keep_next_level_flag; scope->outer = current_scope; scope->depth = current_scope ? (current_scope->depth + 1) : 0; diff --git a/gcc/c-lex.c b/gcc/c-lex.c index df6354843bf..fc89279a7d9 100644 --- a/gcc/c-lex.c +++ b/gcc/c-lex.c @@ -617,11 +617,21 @@ interpret_float (const cpp_token *token, unsigned int flags) char *copy; size_t copylen; - /* Default (no suffix) is double. */ + /* Default (no suffix) depends on whether the FLOAT_CONST_DECIMAL64 + pragma has been used and is either double or _Decimal64. Types + that are not allowed with decimal float default to double. */ if (flags & CPP_N_DEFAULT) { flags ^= CPP_N_DEFAULT; flags |= CPP_N_MEDIUM; + + if (((flags & CPP_N_HEX) == 0) && ((flags & CPP_N_IMAGINARY) == 0)) + { + warning (OPT_Wunsuffixed_float_constants, + "unsuffixed float constant"); + if (float_const_decimal64_p ()) + flags |= CPP_N_DFLOAT; + } } /* Decode _Fract and _Accum. */ diff --git a/gcc/c-parser.c b/gcc/c-parser.c index 6c839e9104c..033c8350776 100644 --- a/gcc/c-parser.c +++ b/gcc/c-parser.c @@ -976,6 +976,7 @@ c_parser_translation_unit (c_parser *parser) else { void *obstack_position = obstack_alloc (&parser_obstack, 0); + mark_valid_location_for_stdc_pragma (false); do { ggc_collect (); @@ -1060,7 +1061,9 @@ c_parser_external_declaration (c_parser *parser) c_parser_consume_token (parser); break; case CPP_PRAGMA: + mark_valid_location_for_stdc_pragma (true); c_parser_pragma (parser, pragma_external); + mark_valid_location_for_stdc_pragma (false); break; case CPP_PLUS: case CPP_MINUS: @@ -3350,17 +3353,20 @@ c_parser_compound_statement_nostart (c_parser *parser) { bool last_stmt = false; bool last_label = false; + bool save_valid_for_pragma = valid_location_for_stdc_pragma_p (); location_t label_loc = UNKNOWN_LOCATION; /* Quiet warning. */ if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE)) { c_parser_consume_token (parser); return; } + mark_valid_location_for_stdc_pragma (true); if (c_parser_next_token_is_keyword (parser, RID_LABEL)) { location_t err_loc = c_parser_peek_token (parser)->location; /* Read zero or more forward-declarations for labels that nested functions can jump to. */ + mark_valid_location_for_stdc_pragma (false); while (c_parser_next_token_is_keyword (parser, RID_LABEL)) { c_parser_consume_token (parser); @@ -3391,6 +3397,7 @@ c_parser_compound_statement_nostart (c_parser *parser) /* We must now have at least one statement, label or declaration. */ if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE)) { + mark_valid_location_for_stdc_pragma (save_valid_for_pragma); c_parser_error (parser, "expected declaration or statement"); c_parser_consume_token (parser); return; @@ -3409,12 +3416,14 @@ c_parser_compound_statement_nostart (c_parser *parser) label_loc = c_parser_peek_token (parser)->location; last_label = true; last_stmt = false; + mark_valid_location_for_stdc_pragma (false); c_parser_label (parser); } else if (!last_label && c_parser_next_token_starts_declspecs (parser)) { last_label = false; + mark_valid_location_for_stdc_pragma (false); c_parser_declaration_or_fndef (parser, true, true, true, true); if (last_stmt) pedwarn_c90 (loc, @@ -3441,6 +3450,7 @@ c_parser_compound_statement_nostart (c_parser *parser) ext = disable_extension_diagnostics (); c_parser_consume_token (parser); last_label = false; + mark_valid_location_for_stdc_pragma (false); c_parser_declaration_or_fndef (parser, true, true, true, true); /* Following the old parser, __extension__ does not disable this diagnostic. */ @@ -3467,6 +3477,7 @@ c_parser_compound_statement_nostart (c_parser *parser) } else if (c_parser_next_token_is (parser, CPP_EOF)) { + mark_valid_location_for_stdc_pragma (save_valid_for_pragma); c_parser_error (parser, "expected declaration or statement"); return; } @@ -3474,6 +3485,7 @@ c_parser_compound_statement_nostart (c_parser *parser) { if (parser->in_if_block) { + mark_valid_location_for_stdc_pragma (save_valid_for_pragma); error_at (loc, """expected %<}%> before %<else%>"); return; } @@ -3489,6 +3501,7 @@ c_parser_compound_statement_nostart (c_parser *parser) statement: last_label = false; last_stmt = true; + mark_valid_location_for_stdc_pragma (false); c_parser_statement_after_labels (parser); } @@ -3497,6 +3510,8 @@ c_parser_compound_statement_nostart (c_parser *parser) if (last_label) error_at (label_loc, "label at end of compound statement"); c_parser_consume_token (parser); + /* Restore the value we started with. */ + mark_valid_location_for_stdc_pragma (save_valid_for_pragma); } /* Parse a label (C90 6.6.1, C99 6.8.1). diff --git a/gcc/c-pragma.c b/gcc/c-pragma.c index 64a224f4a28..bd71d1d79e8 100644 --- a/gcc/c-pragma.c +++ b/gcc/c-pragma.c @@ -1162,6 +1162,116 @@ handle_pragma_message (cpp_reader *ARG_UNUSED(dummy)) inform (input_location, "#pragma message: %s", TREE_STRING_POINTER (message)); } +/* Mark whether the current location is valid for a STDC pragma. */ + +static bool valid_location_for_stdc_pragma; + +void +mark_valid_location_for_stdc_pragma (bool flag) +{ + valid_location_for_stdc_pragma = flag; +} + +/* Return true if the current location is valid for a STDC pragma. */ + +bool +valid_location_for_stdc_pragma_p (void) +{ + return valid_location_for_stdc_pragma; +} + +enum pragma_switch_t { ON, OFF, DEFAULT, BAD }; + +/* A STDC pragma must appear outside of external declarations or + preceding all explicit declarations and statements inside a compound + statement; its behavior is undefined if used in any other context. + It takes a switch of ON, OFF, or DEFAULT. */ + +static enum pragma_switch_t +handle_stdc_pragma (const char *pname) +{ + const char *arg; + tree t; + enum pragma_switch_t ret; + + if (!valid_location_for_stdc_pragma_p ()) + { + warning (OPT_Wpragmas, "invalid location for %<pragma %s%>, ignored", + pname); + return BAD; + } + + if (pragma_lex (&t) != CPP_NAME) + { + warning (OPT_Wpragmas, "malformed %<#pragma %s%>, ignored", pname); + return BAD; + } + + arg = IDENTIFIER_POINTER (t); + + if (!strcmp (arg, "ON")) + ret = ON; + else if (!strcmp (arg, "OFF")) + ret = OFF; + else if (!strcmp (arg, "DEFAULT")) + ret = DEFAULT; + else + { + warning (OPT_Wpragmas, "malformed %<#pragma %s%>, ignored", pname); + return BAD; + } + + if (pragma_lex (&t) != CPP_EOF) + { + warning (OPT_Wpragmas, "junk at end of %<#pragma %s%>", pname); + return BAD; + } + + return ret; +} + +/* #pragma STDC FLOAT_CONST_DECIMAL64 ON + #pragma STDC FLOAT_CONST_DECIMAL64 OFF + #pragma STDC FLOAT_CONST_DECIMAL64 DEFAULT */ + +static void +handle_pragma_float_const_decimal64 (cpp_reader *ARG_UNUSED (dummy)) +{ + if (c_dialect_cxx ()) + { + if (warn_unknown_pragmas > in_system_header) + warning (OPT_Wunknown_pragmas, + "%<#pragma STDC FLOAT_CONST_DECIMAL64%> is not supported" + " for C++"); + return; + } + + if (!targetm.decimal_float_supported_p ()) + { + if (warn_unknown_pragmas > in_system_header) + warning (OPT_Wunknown_pragmas, + "%<#pragma STDC FLOAT_CONST_DECIMAL64%> is not supported" + " on this target"); + return; + } + + pedwarn (input_location, OPT_pedantic, + "ISO C does not support %<#pragma STDC FLOAT_CONST_DECIMAL64%>"); + + switch (handle_stdc_pragma ("STDC FLOAT_CONST_DECIMAL64")) + { + case ON: + set_float_const_decimal64 (); + break; + case OFF: + case DEFAULT: + clear_float_const_decimal64 (); + break; + case BAD: + break; + } +} + /* A vector of registered pragma callbacks. */ DEF_VEC_O (pragma_handler); @@ -1330,6 +1440,9 @@ init_pragma (void) c_register_pragma ("GCC", "pop_options", handle_pragma_pop_options); c_register_pragma ("GCC", "reset_options", handle_pragma_reset_options); + c_register_pragma ("STDC", "FLOAT_CONST_DECIMAL64", + handle_pragma_float_const_decimal64); + c_register_pragma_with_expansion (0, "redefine_extname", handle_pragma_redefine_extname); c_register_pragma (0, "extern_prefix", handle_pragma_extern_prefix); diff --git a/gcc/c.opt b/gcc/c.opt index 7f71699faa7..fc34ff57f78 100644 --- a/gcc/c.opt +++ b/gcc/c.opt @@ -476,6 +476,10 @@ Wunknown-pragmas C ObjC C++ ObjC++ Warning Warn about unrecognized pragmas +Wunsuffixed-float-constants +C ObjC Var(warn_unsuffixed_float_constants) Warning +Warn about unsuffixed float constants + Wunused-macros C ObjC C++ ObjC++ Warning Warn about macros defined in the main file that are not used diff --git a/gcc/cfgexpand.c b/gcc/cfgexpand.c index 29502ad36aa..91dbe9e77d3 100644 --- a/gcc/cfgexpand.c +++ b/gcc/cfgexpand.c @@ -42,6 +42,7 @@ along with GCC; see the file COPYING3. If not see #include "tree-inline.h" #include "value-prof.h" #include "target.h" +#include "alias-export.h" #include "ssaexpand.h" @@ -774,16 +775,20 @@ static void union_stack_vars (size_t a, size_t b, HOST_WIDE_INT offset) { size_t i, last; + bool adressable; /* Update each element of partition B with the given offset, and merge them into partition A. */ + adressable = false; for (last = i = b; i != EOC; last = i, i = stack_vars[i].next) { stack_vars[i].offset += offset; stack_vars[i].representative = a; + adressable |= TREE_ADDRESSABLE (stack_vars[i].decl); } stack_vars[last].next = stack_vars[a].next; stack_vars[a].next = b; + TREE_ADDRESSABLE (stack_vars[a].decl) |= adressable; /* Update the required alignment of partition A to account for B. */ if (stack_vars[a].alignb < stack_vars[b].alignb) @@ -912,6 +917,21 @@ dump_stack_var_partition (void) } } +/* Save the generated partitions for alias.c, so we can say whether two + vars actually occupy different stack locations. */ + +static void +record_stack_var_partitions (void) +{ + size_t i; + + /* Save all stack_vars partition info in the annotations. */ + for (i = 0; i < stack_vars_num; i++) + record_stack_var_partition_for (stack_vars[i].decl, + stack_vars[stack_vars[i].representative].decl); +} + + /* Assign rtl to DECL at frame offset OFFSET. */ static void @@ -1651,6 +1671,9 @@ expand_used_vars (void) expand_stack_vars (NULL); + if (flag_alias_export) + record_stack_var_partitions (); + fini_vars_expansion (); } @@ -1724,6 +1747,52 @@ label_rtx_for_bb (basic_block bb ATTRIBUTE_UNUSED) } +/* A subroutine of expand_gimple_cond. Given E, a fallthrough edge + of a basic block where we just expanded the conditional at the end, + possibly clean up the CFG and instruction sequence. */ + +static void +maybe_cleanup_end_of_block (edge e) +{ + /* Special case: when jumpif decides that the condition is + trivial it emits an unconditional jump (and the necessary + barrier). But we still have two edges, the fallthru one is + wrong. purge_dead_edges would clean this up later. Unfortunately + we have to insert insns (and split edges) before + find_many_sub_basic_blocks and hence before purge_dead_edges. + But splitting edges might create new blocks which depend on the + fact that if there are two edges there's no barrier. So the + barrier would get lost and verify_flow_info would ICE. Instead + of auditing all edge splitters to care for the barrier (which + normally isn't there in a cleaned CFG), fix it here. */ + if (BARRIER_P (get_last_insn ())) + { + basic_block bb = e->src; + rtx insn; + remove_edge (e); + /* Now, we have a single successor block, if we have insns to + insert on the remaining edge we potentially will insert + it at the end of this block (if the dest block isn't feasible) + in order to avoid splitting the edge. This insertion will take + place in front of the last jump. But we might have emitted + multiple jumps (conditional and one unconditional) to the + same destination. Inserting in front of the last one then + is a problem. See PR 40021. We fix this by deleting all + jumps except the last unconditional one. */ + insn = PREV_INSN (get_last_insn ()); + /* Make sure we have an unconditional jump. Otherwise we're + confused. */ + gcc_assert (JUMP_P (insn) && !any_condjump_p (insn)); + for (insn = PREV_INSN (insn); insn != BB_HEAD (bb);) + { + insn = PREV_INSN (insn); + if (JUMP_P (NEXT_INSN (insn))) + delete_insn (NEXT_INSN (insn)); + } + } +} + + /* A subroutine of expand_gimple_basic_block. Expand one GIMPLE_COND. Returns a new basic block if we've terminated the current basic block and created a new one. */ @@ -1767,19 +1836,7 @@ expand_gimple_cond (basic_block bb, gimple stmt) true_edge->goto_block = NULL; false_edge->flags |= EDGE_FALLTHRU; ggc_free (pred); - /* Special case: when jumpif decides that the condition is - trivial it emits an unconditional jump (and the necessary - barrier). But we still have two edges, the fallthru one is - wrong. purge_dead_edges would clean this up later. Unfortunately - we have to insert insns (and split edges) before - find_many_sub_basic_blocks and hence before purge_dead_edges. - But splitting edges might create new blocks which depend on the - fact that if there are two edges there's no barrier. So the - barrier would get lost and verify_flow_info would ICE. Instead - of auditing all edge splitters to care for the barrier (which - normally isn't there in a cleaned CFG), fix it here. */ - if (BARRIER_P (get_last_insn ())) - remove_edge (false_edge); + maybe_cleanup_end_of_block (false_edge); return NULL; } if (true_edge->dest == bb->next_bb) @@ -1796,8 +1853,7 @@ expand_gimple_cond (basic_block bb, gimple stmt) false_edge->goto_block = NULL; true_edge->flags |= EDGE_FALLTHRU; ggc_free (pred); - if (BARRIER_P (get_last_insn ())) - remove_edge (true_edge); + maybe_cleanup_end_of_block (true_edge); return NULL; } @@ -2288,8 +2344,9 @@ discover_nonconstant_array_refs_r (tree * tp, int *walk_subtrees, if (TREE_CODE (t) == ARRAY_REF || TREE_CODE (t) == ARRAY_RANGE_REF) { t = get_base_address (t); - if (t && DECL_P (t)) - TREE_ADDRESSABLE (t) = 1; + if (t && DECL_P (t) + && DECL_MODE (t) != BLKmode) + TREE_ADDRESSABLE (t) = 1; } *walk_subtrees = 0; diff --git a/gcc/config/i386/i386.c b/gcc/config/i386/i386.c index 2054b8898a7..f3d35cea9c5 100644 --- a/gcc/config/i386/i386.c +++ b/gcc/config/i386/i386.c @@ -35,7 +35,6 @@ along with GCC; see the file COPYING3. If not see #include "insn-codes.h" #include "insn-attr.h" #include "flags.h" -#include "c-common.h" #include "except.h" #include "function.h" #include "recog.h" diff --git a/gcc/config/picochip/libgccExtras/divmod15.asm b/gcc/config/picochip/libgccExtras/divmod15.asm index 777adf27968..b477e03a011 100644 --- a/gcc/config/picochip/libgccExtras/divmod15.asm +++ b/gcc/config/picochip/libgccExtras/divmod15.asm @@ -33,8 +33,6 @@ _picoMark_FUNCTION_BEGIN= // picoChip Function Prologue : &__divmod15 = 0 bytes -__divmod15: - // The picoChip instruction set has a divstep instruction which // is used to perform one iteration of a binary division algorithm. // The instruction allows 16-bit signed division to be implemented. diff --git a/gcc/config/picochip/picochip.h b/gcc/config/picochip/picochip.h index 7c32ebeec42..a3263d02e02 100644 --- a/gcc/config/picochip/picochip.h +++ b/gcc/config/picochip/picochip.h @@ -729,6 +729,7 @@ enum picochip_builtins PICOCHIP_BUILTIN_HALT }; +#define NO_DOLLAR_IN_LABEL 1 #define NO_DOT_IN_LABEL 1 /* The assembler does support LEB128, despite the auto-configure test diff --git a/gcc/config/sh/sh.c b/gcc/config/sh/sh.c index 9834d62d13b..1c915a5bf8e 100644 --- a/gcc/config/sh/sh.c +++ b/gcc/config/sh/sh.c @@ -37,7 +37,6 @@ along with GCC; see the file COPYING3. If not see #include "insn-attr.h" #include "toplev.h" #include "recog.h" -#include "c-pragma.h" #include "integrate.h" #include "dwarf2.h" #include "tm_p.h" diff --git a/gcc/config/spu/spu.c b/gcc/config/spu/spu.c index 61113aa51da..eb7ded6ec60 100644 --- a/gcc/config/spu/spu.c +++ b/gcc/config/spu/spu.c @@ -48,7 +48,6 @@ #include "sched-int.h" #include "params.h" #include "assert.h" -#include "c-common.h" #include "machmode.h" #include "gimple.h" #include "tm-constrs.h" diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index a4e1725c0d9..ca9c05af9f8 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,9 @@ +2009-05-06 Dodji Seketeli <dodji@redhat.com> + + PR c++/17395 + * pt.c (tsubst_copy) <case PARM_DECL>: We don't want to tsubst the + whole list of PARM_DECLs, just the current one. + 2009-05-05 Shujing Zhao <pearly.zhao@oracle.com> * cp-tree.h: diff --git a/gcc/cp/pt.c b/gcc/cp/pt.c index adea7eb46ef..e100d6b116c 100644 --- a/gcc/cp/pt.c +++ b/gcc/cp/pt.c @@ -10020,11 +10020,15 @@ tsubst_copy (tree t, tree args, tsubst_flags_t complain, tree in_decl) if (r == NULL) { + tree c; /* This can happen for a parameter name used later in a function declaration (such as in a late-specified return type). Just make a dummy decl, since it's only used for its type. */ gcc_assert (skip_evaluation); - r = tsubst_decl (t, args, complain); + /* We copy T because want to tsubst the PARM_DECL only, + not the following PARM_DECLs that are chained to T. */ + c = copy_node (t); + r = tsubst_decl (c, args, complain); /* Give it the template pattern as its context; its true context hasn't been instantiated yet and this is good enough for mangling. */ diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c index dd84891d73b..4c0c91d5905 100644 --- a/gcc/cp/semantics.c +++ b/gcc/cp/semantics.c @@ -5050,4 +5050,23 @@ finish_trait_expr (cp_trait_kind kind, tree type1, tree type2) ? boolean_true_node : boolean_false_node); } +/* Do-nothing variants of functions to handle pragma FLOAT_CONST_DECIMAL64, + which is ignored for C++. */ + +void +set_float_const_decimal64 (void) +{ +} + +void +clear_float_const_decimal64 (void) +{ +} + +bool +float_const_decimal64_p (void) +{ + return 0; +} + #include "gt-cp-semantics.h" diff --git a/gcc/dfp.c b/gcc/dfp.c index 875e8c409a0..5e1dbcc41eb 100644 --- a/gcc/dfp.c +++ b/gcc/dfp.c @@ -133,6 +133,7 @@ encode_decimal32 (const struct real_format *fmt ATTRIBUTE_UNUSED, decNumber dn; decimal32 d32; decContext set; + int32_t image; decContextDefault (&set, DEC_INIT_DECIMAL128); set.traps = 0; @@ -140,7 +141,8 @@ encode_decimal32 (const struct real_format *fmt ATTRIBUTE_UNUSED, decimal_to_decnumber (r, &dn); decimal32FromNumber (&d32, &dn, &set); - memcpy (&buf[0], d32.bytes, sizeof (uint32_t)); + memcpy (&image, d32.bytes, sizeof (int32_t)); + buf[0] = image; } /* Decode an IEEE 754 decimal32 type into a real. */ @@ -152,11 +154,13 @@ decode_decimal32 (const struct real_format *fmt ATTRIBUTE_UNUSED, decNumber dn; decimal32 d32; decContext set; + int32_t image; decContextDefault (&set, DEC_INIT_DECIMAL128); set.traps = 0; - memcpy (&d32.bytes, &buf[0], sizeof (uint32_t)); + image = buf[0]; + memcpy (&d32.bytes, &image, sizeof (int32_t)); decimal32ToNumber (&d32, &dn); decimal_from_decnumber (r, &dn, &set); @@ -171,6 +175,7 @@ encode_decimal64 (const struct real_format *fmt ATTRIBUTE_UNUSED, decNumber dn; decimal64 d64; decContext set; + int32_t image; decContextDefault (&set, DEC_INIT_DECIMAL128); set.traps = 0; @@ -180,13 +185,17 @@ encode_decimal64 (const struct real_format *fmt ATTRIBUTE_UNUSED, if (WORDS_BIGENDIAN == FLOAT_WORDS_BIG_ENDIAN) { - memcpy (&buf[0], &d64.bytes[0], sizeof (uint32_t)); - memcpy (&buf[1], &d64.bytes[4], sizeof (uint32_t)); + memcpy (&image, &d64.bytes[0], sizeof (int32_t)); + buf[0] = image; + memcpy (&image, &d64.bytes[4], sizeof (int32_t)); + buf[1] = image; } else { - memcpy (&buf[0], &d64.bytes[4], sizeof (uint32_t)); - memcpy (&buf[1], &d64.bytes[0], sizeof (uint32_t)); + memcpy (&image, &d64.bytes[4], sizeof (int32_t)); + buf[0] = image; + memcpy (&image, &d64.bytes[0], sizeof (int32_t)); + buf[1] = image; } } @@ -199,19 +208,24 @@ decode_decimal64 (const struct real_format *fmt ATTRIBUTE_UNUSED, decNumber dn; decimal64 d64; decContext set; + int32_t image; decContextDefault (&set, DEC_INIT_DECIMAL128); set.traps = 0; if (WORDS_BIGENDIAN == FLOAT_WORDS_BIG_ENDIAN) { - memcpy (&d64.bytes[0], &buf[0], sizeof (uint32_t)); - memcpy (&d64.bytes[4], &buf[1], sizeof (uint32_t)); + image = buf[0]; + memcpy (&d64.bytes[0], &image, sizeof (int32_t)); + image = buf[1]; + memcpy (&d64.bytes[4], &image, sizeof (int32_t)); } else { - memcpy (&d64.bytes[0], &buf[1], sizeof (uint32_t)); - memcpy (&d64.bytes[4], &buf[0], sizeof (uint32_t)); + image = buf[1]; + memcpy (&d64.bytes[0], &image, sizeof (int32_t)); + image = buf[0]; + memcpy (&d64.bytes[4], &image, sizeof (int32_t)); } decimal64ToNumber (&d64, &dn); @@ -227,6 +241,7 @@ encode_decimal128 (const struct real_format *fmt ATTRIBUTE_UNUSED, decNumber dn; decContext set; decimal128 d128; + int32_t image; decContextDefault (&set, DEC_INIT_DECIMAL128); set.traps = 0; @@ -236,17 +251,25 @@ encode_decimal128 (const struct real_format *fmt ATTRIBUTE_UNUSED, if (WORDS_BIGENDIAN == FLOAT_WORDS_BIG_ENDIAN) { - memcpy (&buf[0], &d128.bytes[0], sizeof (uint32_t)); - memcpy (&buf[1], &d128.bytes[4], sizeof (uint32_t)); - memcpy (&buf[2], &d128.bytes[8], sizeof (uint32_t)); - memcpy (&buf[3], &d128.bytes[12], sizeof (uint32_t)); + memcpy (&image, &d128.bytes[0], sizeof (int32_t)); + buf[0] = image; + memcpy (&image, &d128.bytes[4], sizeof (int32_t)); + buf[1] = image; + memcpy (&image, &d128.bytes[8], sizeof (int32_t)); + buf[2] = image; + memcpy (&image, &d128.bytes[12], sizeof (int32_t)); + buf[3] = image; } else { - memcpy (&buf[0], &d128.bytes[12], sizeof (uint32_t)); - memcpy (&buf[1], &d128.bytes[8], sizeof (uint32_t)); - memcpy (&buf[2], &d128.bytes[4], sizeof (uint32_t)); - memcpy (&buf[3], &d128.bytes[0], sizeof (uint32_t)); + memcpy (&image, &d128.bytes[12], sizeof (int32_t)); + buf[0] = image; + memcpy (&image, &d128.bytes[8], sizeof (int32_t)); + buf[1] = image; + memcpy (&image, &d128.bytes[4], sizeof (int32_t)); + buf[2] = image; + memcpy (&image, &d128.bytes[0], sizeof (int32_t)); + buf[3] = image; } } @@ -259,23 +282,32 @@ decode_decimal128 (const struct real_format *fmt ATTRIBUTE_UNUSED, decNumber dn; decimal128 d128; decContext set; + int32_t image; decContextDefault (&set, DEC_INIT_DECIMAL128); set.traps = 0; if (WORDS_BIGENDIAN == FLOAT_WORDS_BIG_ENDIAN) { - memcpy (&d128.bytes[0], &buf[0], sizeof (uint32_t)); - memcpy (&d128.bytes[4], &buf[1], sizeof (uint32_t)); - memcpy (&d128.bytes[8], &buf[2], sizeof (uint32_t)); - memcpy (&d128.bytes[12], &buf[3], sizeof (uint32_t)); + image = buf[0]; + memcpy (&d128.bytes[0], &image, sizeof (int32_t)); + image = buf[1]; + memcpy (&d128.bytes[4], &image, sizeof (int32_t)); + image = buf[2]; + memcpy (&d128.bytes[8], &image, sizeof (int32_t)); + image = buf[3]; + memcpy (&d128.bytes[12], &image, sizeof (int32_t)); } else { - memcpy (&d128.bytes[0], &buf[3], sizeof (uint32_t)); - memcpy (&d128.bytes[4], &buf[2], sizeof (uint32_t)); - memcpy (&d128.bytes[8], &buf[1], sizeof (uint32_t)); - memcpy (&d128.bytes[12], &buf[0], sizeof (uint32_t)); + image = buf[3]; + memcpy (&d128.bytes[0], &image, sizeof (int32_t)); + image = buf[2]; + memcpy (&d128.bytes[4], &image, sizeof (int32_t)); + image = buf[1]; + memcpy (&d128.bytes[8], &image, sizeof (int32_t)); + image = buf[0]; + memcpy (&d128.bytes[12], &image, sizeof (int32_t)); } decimal128ToNumber (&d128, &dn); diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi index 4e06be3daca..43bebf911c0 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -958,10 +958,6 @@ is incomplete: @itemize @bullet @item -Pragma @code{FLOAT_CONST_DECIMAL64} is not supported, nor is the @samp{d} -suffix for literal constants of type @code{double}. - -@item When the value of a decimal floating type cannot be represented in the integer type to which it is being converted, the result is undefined rather than the result value specified by the draft technical report. diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 0021e800916..3fc575d34de 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -259,8 +259,8 @@ Objective-C and Objective-C++ Dialects}. -Wswitch -Wswitch-default -Wswitch-enum -Wsync-nand @gol -Wsystem-headers -Wtrigraphs -Wtype-limits -Wundef -Wuninitialized @gol -Wunknown-pragmas -Wno-pragmas -Wunreachable-code @gol --Wunused -Wunused-function -Wunused-label -Wunused-parameter @gol --Wunused-value -Wunused-variable @gol +-Wunsuffixed-float-constants -Wunused -Wunused-function @gol +-Wunused-label -Wunused-parameter -Wunused-value -Wunused-variable @gol -Wvariadic-macros -Wvla @gol -Wvolatile-register-var -Wwrite-strings} @@ -4218,6 +4218,15 @@ minimum maximum, so we do not diagnose overlength strings in C++@. This option is implied by @option{-pedantic}, and can be disabled with @option{-Wno-overlength-strings}. + +@item -Wunsuffixed-float-constants +@opindex Wunsuffixed-float-constants + +GCC will issue a warning for any floating constant that does not have +a suffix. When used together with @option{-Wsystem-headers} it will +warn about such constants in system header files. This can be useful +when preparing code to use with the @code{FLOAT_CONST_DECIMAL64} pragma +from the decimal floating-point extension to C99. @end table @node Debugging Options @@ -4585,13 +4594,14 @@ and dbg_cnt(tail_call) will return false always. @itemx -fdump-rtl-@var{pass} @opindex d Says to make debugging dumps during compilation at times specified by -@var{letters}. This is used for debugging the RTL-based passes of the -compiler. The file names for most of the dumps are made by appending a -pass number and a word to the @var{dumpname}. @var{dumpname} is generated -from the name of the output file, if explicitly specified and it is not -an executable, otherwise it is the basename of the source file. These -switches may have different effects when @option{-E} is used for -preprocessing. +@var{letters}. This is used for debugging the RTL-based passes of the +compiler. The file names for most of the dumps are made by appending +a pass number and a word to the @var{dumpname}, and the files are +created in the directory of the output file. @var{dumpname} is +generated from the name of the output file, if explicitly specified +and it is not an executable, otherwise it is the basename of the +source file. These switches may have different effects when +@option{-E} is used for preprocessing. Debug dumps can be enabled with a @option{-fdump-rtl} switch or some @option{-d} option @var{letters}. Here are the possible @@ -4919,7 +4929,8 @@ invocations with different options, in particular with and without @opindex fdump-translation-unit Dump a representation of the tree structure for the entire translation unit to a file. The file name is made by appending @file{.tu} to the -source file name. If the @samp{-@var{options}} form is used, @var{options} +source file name, and the file is created in the same directory as the +output file. If the @samp{-@var{options}} form is used, @var{options} controls the details of the dump as described for the @option{-fdump-tree} options. @@ -4927,16 +4938,19 @@ controls the details of the dump as described for the @itemx -fdump-class-hierarchy-@var{options} @r{(C++ only)} @opindex fdump-class-hierarchy Dump a representation of each class's hierarchy and virtual function -table layout to a file. The file name is made by appending @file{.class} -to the source file name. If the @samp{-@var{options}} form is used, -@var{options} controls the details of the dump as described for the -@option{-fdump-tree} options. +table layout to a file. The file name is made by appending +@file{.class} to the source file name, and the file is created in the +same directory as the output file. If the @samp{-@var{options}} form +is used, @var{options} controls the details of the dump as described +for the @option{-fdump-tree} options. @item -fdump-ipa-@var{switch} @opindex fdump-ipa Control the dumping at various stages of inter-procedural analysis -language tree to a file. The file name is generated by appending a switch -specific suffix to the source file name. The following dumps are possible: +language tree to a file. The file name is generated by appending a +switch specific suffix to the source file name, and the file is created +in the same directory as the output file. The following dumps are +possible: @table @samp @item all @@ -4954,22 +4968,25 @@ Dump after function inlining. @item -fdump-statistics-@var{option} @opindex -fdump-statistics Enable and control dumping of pass statistics in a separate file. The -file name is generated by appending a suffix ending in @samp{.statistics} -to the source file name. If the @samp{-@var{option}} form is used, -@samp{-stats} will cause counters to be summed over the whole compilation unit -while @samp{-details} will dump every event as the passes generate them. -The default with no option is to sum counters for each function compiled. +file name is generated by appending a suffix ending in +@samp{.statistics} to the source file name, and the file is created in +the same directory as the output file. If the @samp{-@var{option}} +form is used, @samp{-stats} will cause counters to be summed over the +whole compilation unit while @samp{-details} will dump every event as +the passes generate them. The default with no option is to sum +counters for each function compiled. @item -fdump-tree-@var{switch} @itemx -fdump-tree-@var{switch}-@var{options} @opindex fdump-tree Control the dumping at various stages of processing the intermediate -language tree to a file. The file name is generated by appending a switch -specific suffix to the source file name. If the @samp{-@var{options}} -form is used, @var{options} is a list of @samp{-} separated options that -control the details of the dump. Not all options are applicable to all -dumps, those which are not meaningful will be ignored. The following -options are available +language tree to a file. The file name is generated by appending a +switch specific suffix to the source file name, and the file is +created in the same directory as the output file. If the +@samp{-@var{options}} form is used, @var{options} is a list of +@samp{-} separated options that control the details of the dump. Not +all options are applicable to all dumps, those which are not +meaningful will be ignored. The following options are available @table @samp @item address diff --git a/gcc/doc/md.texi b/gcc/doc/md.texi index 7c4da3192c5..b966c27a880 100644 --- a/gcc/doc/md.texi +++ b/gcc/doc/md.texi @@ -5115,8 +5115,6 @@ These patterns emit code for an atomic operation on memory. Operand 0 is the memory on which the atomic operation is performed. Operand 1 is the second operand to the binary operator. -The ``nand'' operation is @code{~op0 & op1}. - This pattern must issue any memory barrier instructions such that all memory operations before the atomic operation occur before the atomic operation and all memory operations after the atomic operation occur diff --git a/gcc/dojump.c b/gcc/dojump.c index 715e7373eee..36430851393 100644 --- a/gcc/dojump.c +++ b/gcc/dojump.c @@ -141,7 +141,8 @@ prefer_and_bit_test (enum machine_mode mode, int bitnum) } /* Fill in the integers. */ - XEXP (and_test, 1) = GEN_INT ((unsigned HOST_WIDE_INT) 1 << bitnum); + XEXP (and_test, 1) + = immed_double_const ((unsigned HOST_WIDE_INT) 1 << bitnum, 0, mode); XEXP (XEXP (shift_test, 0), 1) = GEN_INT (bitnum); return (rtx_cost (and_test, IF_THEN_ELSE, optimize_insn_for_speed_p ()) @@ -474,10 +475,10 @@ do_jump (tree exp, rtx if_false_label, rtx if_true_label) && prefer_and_bit_test (TYPE_MODE (argtype), TREE_INT_CST_LOW (shift))) { - HOST_WIDE_INT mask = (HOST_WIDE_INT) 1 - << TREE_INT_CST_LOW (shift); + unsigned HOST_WIDE_INT mask + = (unsigned HOST_WIDE_INT) 1 << TREE_INT_CST_LOW (shift); do_jump (build2 (BIT_AND_EXPR, argtype, arg, - build_int_cst_type (argtype, mask)), + build_int_cst_wide_type (argtype, mask, 0)), clr_label, set_label); break; } diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index 73a31ecd9b8..0d308c9f047 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -3851,18 +3851,11 @@ new_loc_descr (enum dwarf_location_atom op, unsigned HOST_WIDE_INT oprnd1, static inline dw_loc_descr_ref new_reg_loc_descr (unsigned int reg, unsigned HOST_WIDE_INT offset) { - if (offset) - { - if (reg <= 31) - return new_loc_descr ((enum dwarf_location_atom) (DW_OP_breg0 + reg), - offset, 0); - else - return new_loc_descr (DW_OP_bregx, reg, offset); - } - else if (reg <= 31) - return new_loc_descr ((enum dwarf_location_atom) (DW_OP_reg0 + reg), 0, 0); + if (reg <= 31) + return new_loc_descr ((enum dwarf_location_atom) (DW_OP_breg0 + reg), + offset, 0); else - return new_loc_descr (DW_OP_regx, reg, 0); + return new_loc_descr (DW_OP_bregx, reg, offset); } /* Add a location description term to a location description expression. */ @@ -9702,7 +9695,13 @@ reg_loc_descriptor (rtx rtl, enum var_init_status initialized) static dw_loc_descr_ref one_reg_loc_descriptor (unsigned int regno, enum var_init_status initialized) { - dw_loc_descr_ref reg_loc_descr = new_reg_loc_descr (regno, 0); + dw_loc_descr_ref reg_loc_descr; + + if (regno <= 31) + reg_loc_descr + = new_loc_descr ((enum dwarf_location_atom) (DW_OP_reg0 + regno), 0, 0); + else + reg_loc_descr = new_loc_descr (DW_OP_regx, regno, 0); if (initialized == VAR_INIT_STATUS_UNINITIALIZED) add_loc_descr (®_loc_descr, new_loc_descr (DW_OP_GNU_uninit, 0, 0)); @@ -11719,6 +11718,31 @@ loc_by_reference (dw_loc_descr_ref loc, tree decl) || !DECL_BY_REFERENCE (decl)) return loc; + /* If loc is DW_OP_reg{0...31,x}, don't add DW_OP_deref, instead + change it into corresponding DW_OP_breg{0...31,x} 0. Then the + location expression is considered to be address of a memory location, + rather than the register itself. */ + if (((loc->dw_loc_opc >= DW_OP_reg0 && loc->dw_loc_opc <= DW_OP_reg31) + || loc->dw_loc_opc == DW_OP_regx) + && (loc->dw_loc_next == NULL + || (loc->dw_loc_next->dw_loc_opc == DW_OP_GNU_uninit + && loc->dw_loc_next->dw_loc_next == NULL))) + { + if (loc->dw_loc_opc == DW_OP_regx) + { + loc->dw_loc_opc = DW_OP_bregx; + loc->dw_loc_oprnd2.v.val_int = 0; + } + else + { + loc->dw_loc_opc + = (enum dwarf_location_atom) + (loc->dw_loc_opc + (DW_OP_breg0 - DW_OP_reg0)); + loc->dw_loc_oprnd1.v.val_int = 0; + } + return loc; + } + size = int_size_in_bytes (TREE_TYPE (decl)); if (size > DWARF2_ADDR_SIZE || size == -1) return 0; diff --git a/gcc/expr.c b/gcc/expr.c index 9eced38ca47..f7293a76015 100644 --- a/gcc/expr.c +++ b/gcc/expr.c @@ -2249,6 +2249,26 @@ use_group_regs (rtx *call_fusage, rtx regs) use_reg (call_fusage, reg); } } + +/* Return the defining gimple statement for SSA_NAME NAME if it is an + assigment and the code of the expresion on the RHS is CODE. Return + NULL otherwise. */ + +static gimple +get_def_for_expr (tree name, enum tree_code code) +{ + gimple def_stmt; + + if (TREE_CODE (name) != SSA_NAME) + return NULL; + + def_stmt = get_gimple_for_ssa_name (name); + if (!def_stmt + || gimple_assign_rhs_code (def_stmt) != code) + return NULL; + + return def_stmt; +} /* Determine whether the LEN bytes generated by CONSTFUN can be @@ -5776,22 +5796,25 @@ store_field (rtx target, HOST_WIDE_INT bitsize, HOST_WIDE_INT bitpos, && compare_tree_int (TYPE_SIZE (TREE_TYPE (exp)), bitsize) != 0)) { rtx temp; + gimple nop_def; /* If EXP is a NOP_EXPR of precision less than its mode, then that implies a mask operation. If the precision is the same size as the field we're storing into, that mask is redundant. This is particularly common with bit field assignments generated by the C front end. */ - if (TREE_CODE (exp) == NOP_EXPR) + nop_def = get_def_for_expr (exp, NOP_EXPR); + if (nop_def) { tree type = TREE_TYPE (exp); if (INTEGRAL_TYPE_P (type) && TYPE_PRECISION (type) < GET_MODE_BITSIZE (TYPE_MODE (type)) && bitsize == TYPE_PRECISION (type)) { - type = TREE_TYPE (TREE_OPERAND (exp, 0)); + tree op = gimple_assign_rhs1 (nop_def); + type = TREE_TYPE (op); if (INTEGRAL_TYPE_P (type) && TYPE_PRECISION (type) >= bitsize) - exp = TREE_OPERAND (exp, 0); + exp = op; } } @@ -6992,26 +7015,6 @@ expand_constructor (tree exp, rtx target, enum expand_modifier modifier, return target; } -/* Return the defining gimple statement for SSA_NAME NAME if it is an - assigment and the code of the expresion on the RHS is CODE. Return - NULL otherwise. */ - -static gimple -get_def_for_expr (tree name, enum tree_code code) -{ - gimple def_stmt; - - if (TREE_CODE (name) != SSA_NAME) - return NULL; - - def_stmt = get_gimple_for_ssa_name (name); - if (!def_stmt - || gimple_assign_rhs_code (def_stmt) != code) - return NULL; - - return def_stmt; -} - /* expand_expr: generate code for computing expression EXP. An rtx for the computed value is returned. The value is never null. diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3e9c86ad92b..219a1abf2d7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,105 @@ +2009-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/38830 + * gfortran.texi: Document that we don't support variable FORMAT + expressions. + +2009-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/39576 + * error.c (error_print): Add missing break statement. + +2009-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/36382 + * invoke.texi: Document that -fdollar-ok does not allow $ to be + used in IMPLICIT statement. + +2009-05-06 Janus Weil <janus@gcc.gnu.org> + Paul Thomas <pault@gcc.gnu.org> + + PR fortran/39630 + * decl.c (match_procedure_interface): New function to match the + interface for a PROCEDURE statement. + (match_procedure_decl): Call match_procedure_interface. + (match_ppc_decl): New function to match the declaration of a + procedure pointer component. + (gfc_match_procedure): Call match_ppc_decl. + (match_binding_attributes): Add new argument 'ppc' and handle the + POINTER attribute for procedure pointer components. + (match_procedure_in_type,gfc_match_generic): Added new argument to + match_binding_attributes. + * dump-parse-tree.c (show_expr,show_components,show_code_node): Handle + procedure pointer components. + * expr.c (free_expr0,gfc_copy_expr,gfc_simplify_expr): Handle EXPR_PPC. + (gfc_check_pointer_assign): Handle procedure pointer components, but no + full checking yet. + (is_proc_ptr_comp): New function to determine if an expression is a + procedure pointer component. + * gfortran.h (expr_t): Add EXPR_PPC. + (symbol_attribute): Add new member 'proc_pointer_comp'. + (gfc_component): Add new member 'formal'. + (gfc_exec_op): Add EXEC_CALL_PPC. + (gfc_get_default_type): Changed first argument. + (is_proc_ptr_comp): Add prototype. + (gfc_match_varspec): Add new argument. + * interface.c (compare_actual_formal): Handle procedure pointer + components. + * match.c (gfc_match_pointer_assignment,match_typebound_call): Handle + procedure pointer components. + * module.c (mio_expr): Handle EXPR_PPC. + * parse.c (parse_derived): Handle procedure pointer components. + * primary.c (gfc_match_varspec): Add new argument 'ppc_arg' and handle + procedure pointer components. + (gfc_variable_attr): Handle procedure pointer components. + (gfc_match_rvalue): Added new argument to gfc_match_varspec and changed + first argument of gfc_get_default_type. + (match_variable): Added new argument to gfc_match_varspec. + * resolve.c (resolve_entries,set_type,resolve_fl_parameter): Changed + first argument of gfc_get_default_type. + (resolve_structure_cons,resolve_actual_arglist): Handle procedure + pointer components. + (resolve_ppc_call): New function to resolve a call to a procedure + pointer component (subroutine). + (resolve_expr_ppc): New function to resolve a call to a procedure + pointer component (function). + (gfc_resolve_expr): Handle EXPR_PPC. + (resolve_code): Handle EXEC_CALL_PPC. + (resolve_fl_derived): Copy the interface for a procedure pointer + component. + (resolve_symbol): Fix overlong line. + * st.c (gfc_free_statement): Handle EXEC_CALL_PPC. + * symbol.c (gfc_get_default_type): Changed first argument. + (gfc_set_default_type): Changed first argument of gfc_get_default_type. + (gfc_add_component): Initialize ts.type to BT_UNKNOWN. + * trans.h (gfc_conv_function_call): Renamed. + * trans.c (gfc_trans_code): Handle EXEC_CALL_PPC. + * trans-expr.c (gfc_conv_component_ref): Ditto. + (gfc_conv_function_val): Rename to 'conv_function_val', add new + argument 'expr' and handle procedure pointer components. + (gfc_conv_operator_assign): Renamed gfc_conv_function_val. + (gfc_apply_interface_mapping_to_expr): Handle EXPR_PPC. + (gfc_conv_function_call): Rename to 'gfc_conv_procedure_call', add new + argument 'expr' and handle procedure pointer components. + (gfc_get_proc_ptr_comp): New function to get the backend decl for a + procedure pointer component. + (gfc_conv_function_expr): Renamed gfc_conv_function_call. + (gfc_conv_structure): Handle procedure pointer components. + * trans-intrinsic.c (gfc_conv_intrinsic_funcall, + conv_generic_with_optional_char_arg): Renamed gfc_conv_function_call. + * trans-stmt.h (gfc_get_proc_ptr_comp): Add prototype. + * trans-stmt.c (gfc_trans_call): Renamed gfc_conv_function_call. + * trans-types.h (gfc_get_ppc_type): Add prototype. + * trans-types.c (gfc_get_ppc_type): New function to build a tree node + for a procedure pointer component. + (gfc_get_derived_type): Handle procedure pointer components. + +2009-05-06 Tobias Burnus <burnus@net-b.de> + + PR fortran/40041 + * resolve.c (resolve_symbol): Print no warning for implicitly + typed intrinsic functions. + 2009-05-05 Janus Weil <janus@gcc.gnu.org> PR fortran/39998 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index eaa310cf066..f3ff0e68380 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4145,17 +4145,14 @@ add_hidden_procptr_result (gfc_symbol *sym) } -/* Match a PROCEDURE declaration (R1211). */ +/* Match the interface for a PROCEDURE declaration, + including brackets (R1212). */ static match -match_procedure_decl (void) +match_procedure_interface (gfc_symbol **proc_if) { match m; locus old_loc, entry_loc; - gfc_symbol *sym, *proc_if = NULL; - int num; - gfc_expr *initializer = NULL; - old_loc = entry_loc = gfc_current_locus; gfc_clear_ts (¤t_ts); @@ -4180,45 +4177,43 @@ match_procedure_decl (void) /* Get the name of the procedure or abstract interface to inherit the interface from. */ - m = gfc_match_symbol (&proc_if, 1); - - if (m == MATCH_NO) - goto syntax; - else if (m == MATCH_ERROR) + m = gfc_match_symbol (proc_if, 1); + if (m != MATCH_YES) return m; /* Various interface checks. */ - if (proc_if) + if (*proc_if) { - proc_if->refs++; + (*proc_if)->refs++; /* Resolve interface if possible. That way, attr.procedure is only set if it is declared by a later procedure-declaration-stmt, which is invalid per C1212. */ - while (proc_if->ts.interface) - proc_if = proc_if->ts.interface; + while ((*proc_if)->ts.interface) + *proc_if = (*proc_if)->ts.interface; - if (proc_if->generic) + if ((*proc_if)->generic) { - gfc_error ("Interface '%s' at %C may not be generic", proc_if->name); + gfc_error ("Interface '%s' at %C may not be generic", + (*proc_if)->name); return MATCH_ERROR; } - if (proc_if->attr.proc == PROC_ST_FUNCTION) + if ((*proc_if)->attr.proc == PROC_ST_FUNCTION) { gfc_error ("Interface '%s' at %C may not be a statement function", - proc_if->name); + (*proc_if)->name); return MATCH_ERROR; } /* Handle intrinsic procedures. */ - if (!(proc_if->attr.external || proc_if->attr.use_assoc - || proc_if->attr.if_source == IFSRC_IFBODY) - && (gfc_is_intrinsic (proc_if, 0, gfc_current_locus) - || gfc_is_intrinsic (proc_if, 1, gfc_current_locus))) - proc_if->attr.intrinsic = 1; - if (proc_if->attr.intrinsic - && !gfc_intrinsic_actual_ok (proc_if->name, 0)) + if (!((*proc_if)->attr.external || (*proc_if)->attr.use_assoc + || (*proc_if)->attr.if_source == IFSRC_IFBODY) + && (gfc_is_intrinsic ((*proc_if), 0, gfc_current_locus) + || gfc_is_intrinsic ((*proc_if), 1, gfc_current_locus))) + (*proc_if)->attr.intrinsic = 1; + if ((*proc_if)->attr.intrinsic + && !gfc_intrinsic_actual_ok ((*proc_if)->name, 0)) { gfc_error ("Intrinsic procedure '%s' not allowed " - "in PROCEDURE statement at %C", proc_if->name); + "in PROCEDURE statement at %C", (*proc_if)->name); return MATCH_ERROR; } } @@ -4230,7 +4225,26 @@ got_ts: return MATCH_NO; } - /* Parse attributes. */ + return MATCH_YES; +} + + +/* Match a PROCEDURE declaration (R1211). */ + +static match +match_procedure_decl (void) +{ + match m; + gfc_symbol *sym, *proc_if = NULL; + int num; + gfc_expr *initializer = NULL; + + /* Parse interface (with brackets). */ + m = match_procedure_interface (&proc_if); + if (m != MATCH_YES) + return m; + + /* Parse attributes (with colons). */ m = match_attr_spec(); if (m == MATCH_ERROR) return MATCH_ERROR; @@ -4360,6 +4374,138 @@ cleanup: } +static match +match_binding_attributes (gfc_typebound_proc* ba, bool generic, bool ppc); + + +/* Match a procedure pointer component declaration (R445). */ + +static match +match_ppc_decl (void) +{ + match m; + gfc_symbol *proc_if = NULL; + gfc_typespec ts; + int num; + gfc_component *c; + gfc_expr *initializer = NULL; + gfc_typebound_proc* tb; + char name[GFC_MAX_SYMBOL_LEN + 1]; + + /* Parse interface (with brackets). */ + m = match_procedure_interface (&proc_if); + if (m != MATCH_YES) + goto syntax; + + /* Parse attributes. */ + tb = XCNEW (gfc_typebound_proc); + tb->where = gfc_current_locus; + m = match_binding_attributes (tb, false, true); + if (m == MATCH_ERROR) + return m; + + /* TODO: Implement PASS. */ + if (!tb->nopass) + { + gfc_error ("Procedure Pointer Component with PASS at %C " + "not yet implemented"); + return MATCH_ERROR; + } + + gfc_clear_attr (¤t_attr); + current_attr.procedure = 1; + current_attr.proc_pointer = 1; + current_attr.access = tb->access; + current_attr.flavor = FL_PROCEDURE; + + /* Match the colons (required). */ + if (gfc_match (" ::") != MATCH_YES) + { + gfc_error ("Expected '::' after binding-attributes at %C"); + return MATCH_ERROR; + } + + /* Check for C450. */ + if (!tb->nopass && proc_if == NULL) + { + gfc_error("NOPASS or explicit interface required at %C"); + return MATCH_ERROR; + } + + /* Match PPC names. */ + ts = current_ts; + for(num=1;;num++) + { + m = gfc_match_name (name); + if (m == MATCH_NO) + goto syntax; + else if (m == MATCH_ERROR) + return m; + + if (gfc_add_component (gfc_current_block (), name, &c) == FAILURE) + return MATCH_ERROR; + + /* Add current_attr to the symbol attributes. */ + if (gfc_copy_attr (&c->attr, ¤t_attr, NULL) == FAILURE) + return MATCH_ERROR; + + if (gfc_add_external (&c->attr, NULL) == FAILURE) + return MATCH_ERROR; + + if (gfc_add_proc (&c->attr, name, NULL) == FAILURE) + return MATCH_ERROR; + + /* Set interface. */ + if (proc_if != NULL) + { + c->ts.interface = proc_if; + c->attr.untyped = 1; + c->attr.if_source = IFSRC_IFBODY; + } + else if (ts.type != BT_UNKNOWN) + { + c->ts = ts; + c->ts.interface = gfc_new_symbol ("", gfc_current_ns); + c->ts.interface->ts = ts; + c->ts.interface->attr.function = 1; + c->attr.function = c->ts.interface->attr.function; + c->attr.if_source = IFSRC_UNKNOWN; + } + + if (gfc_match (" =>") == MATCH_YES) + { + m = gfc_match_null (&initializer); + if (m == MATCH_NO) + { + gfc_error ("Pointer initialization requires a NULL() at %C"); + m = MATCH_ERROR; + } + if (gfc_pure (NULL)) + { + gfc_error ("Initialization of pointer at %C is not allowed in " + "a PURE procedure"); + m = MATCH_ERROR; + } + if (m != MATCH_YES) + { + gfc_free_expr (initializer); + return m; + } + c->initializer = initializer; + } + + if (gfc_match_eos () == MATCH_YES) + return MATCH_YES; + if (gfc_match_char (',') != MATCH_YES) + goto syntax; + } + +syntax: + gfc_error ("Syntax error in procedure pointer component at %C"); + return MATCH_ERROR; +} + + /* Match a PROCEDURE declaration inside an interface (R1206). */ static match @@ -4425,9 +4571,8 @@ gfc_match_procedure (void) m = match_procedure_in_interface (); break; case COMP_DERIVED: - gfc_error ("Fortran 2003: Procedure components at %C are not yet" - " implemented in gfortran"); - return MATCH_ERROR; + m = match_ppc_decl (); + break; case COMP_DERIVED_CONTAINS: m = match_procedure_in_type (); break; @@ -6830,9 +6975,10 @@ cleanup: /* Match binding attributes. */ static match -match_binding_attributes (gfc_typebound_proc* ba, bool generic) +match_binding_attributes (gfc_typebound_proc* ba, bool generic, bool ppc) { bool found_passing = false; + bool seen_ptr = false; match m; /* Intialize to defaults. Do so even before the MATCH_NO check so that in @@ -6907,38 +7053,6 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic) continue; } - /* NON_OVERRIDABLE flag. */ - m = gfc_match (" non_overridable"); - if (m == MATCH_ERROR) - goto error; - if (m == MATCH_YES) - { - if (ba->non_overridable) - { - gfc_error ("Duplicate NON_OVERRIDABLE at %C"); - goto error; - } - - ba->non_overridable = 1; - continue; - } - - /* DEFERRED flag. */ - m = gfc_match (" deferred"); - if (m == MATCH_ERROR) - goto error; - if (m == MATCH_YES) - { - if (ba->deferred) - { - gfc_error ("Duplicate DEFERRED at %C"); - goto error; - } - - ba->deferred = 1; - continue; - } - /* PASS possibly including argument. */ m = gfc_match (" pass"); if (m == MATCH_ERROR) @@ -6966,6 +7080,60 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic) continue; } + if (ppc) + { + /* POINTER flag. */ + m = gfc_match (" pointer"); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_YES) + { + if (seen_ptr) + { + gfc_error ("Duplicate POINTER attribute at %C"); + goto error; + } + + seen_ptr = true; + /*ba->ppc = 1;*/ + continue; + } + } + else + { + /* NON_OVERRIDABLE flag. */ + m = gfc_match (" non_overridable"); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_YES) + { + if (ba->non_overridable) + { + gfc_error ("Duplicate NON_OVERRIDABLE at %C"); + goto error; + } + + ba->non_overridable = 1; + continue; + } + + /* DEFERRED flag. */ + m = gfc_match (" deferred"); + if (m == MATCH_ERROR) + goto error; + if (m == MATCH_YES) + { + if (ba->deferred) + { + gfc_error ("Duplicate DEFERRED at %C"); + goto error; + } + + ba->deferred = 1; + continue; + } + } + } /* Nothing matching found. */ @@ -6987,6 +7155,13 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic) if (ba->access == ACCESS_UNKNOWN) ba->access = gfc_typebound_default_access; + if (ppc && !seen_ptr) + { + gfc_error ("POINTER attribute is required for procedure pointer component" + " at %C"); + goto error; + } + return MATCH_YES; error: @@ -7043,7 +7218,7 @@ match_procedure_in_type (void) tb->is_generic = 0; /* Match binding attributes. */ - m = match_binding_attributes (tb, false); + m = match_binding_attributes (tb, false, false); if (m == MATCH_ERROR) return m; seen_attrs = (m == MATCH_YES); @@ -7192,7 +7367,7 @@ gfc_match_generic (void) gcc_assert (block && ns); /* See if we get an access-specifier. */ - m = match_binding_attributes (&tbattr, true); + m = match_binding_attributes (&tbattr, true, false); if (m == MATCH_ERROR) goto error; diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 6c915084db9..e007a54aea0 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -541,13 +541,20 @@ show_expr (gfc_expr *p) case EXPR_FUNCTION: if (p->value.function.name == NULL) { - fprintf (dumpfile, "%s[", p->symtree->n.sym->name); + fprintf (dumpfile, "%s", p->symtree->n.sym->name); + if (is_proc_ptr_comp (p, NULL)) + show_ref (p->ref); + fputc ('[', dumpfile); show_actual_arglist (p->value.function.actual); fputc (']', dumpfile); } else { - fprintf (dumpfile, "%s[[", p->value.function.name); + fprintf (dumpfile, "%s", p->value.function.name); + if (is_proc_ptr_comp (p, NULL)) + show_ref (p->ref); + fputc ('[', dumpfile); + fputc ('[', dumpfile); show_actual_arglist (p->value.function.actual); fputc (']', dumpfile); fputc (']', dumpfile); @@ -653,6 +660,8 @@ show_components (gfc_symbol *sym) show_typespec (&c->ts); if (c->attr.pointer) fputs (" POINTER", dumpfile); + if (c->attr.proc_pointer) + fputs (" PPC", dumpfile); if (c->attr.dimension) fputs (" DIMENSION", dumpfile); fputc (' ', dumpfile); @@ -1212,6 +1221,12 @@ show_code_node (int level, gfc_code *c) show_compcall (c->expr); break; + case EXEC_CALL_PPC: + fputs ("CALL ", dumpfile); + show_expr (c->expr); + show_actual_arglist (c->ext.actual); + break; + case EXEC_RETURN: fputs ("RETURN ", dumpfile); if (c->expr) diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index 29efbd1fee0..7cb23dd70e6 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.c @@ -533,6 +533,7 @@ error_print (const char *type, const char *format0, va_list argp) case 'u': arg[pos].type = TYPE_UINTEGER; + break; case 'l': c = *format++; diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 9fa0ff13637..feaa6254840 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -182,6 +182,7 @@ free_expr0 (gfc_expr *e) break; case EXPR_COMPCALL: + case EXPR_PPC: gfc_free_actual_arglist (e->value.compcall.actual); break; @@ -507,6 +508,7 @@ gfc_copy_expr (gfc_expr *p) break; case EXPR_COMPCALL: + case EXPR_PPC: q->value.compcall.actual = gfc_copy_actual_arglist (p->value.compcall.actual); q->value.compcall.tbp = p->value.compcall.tbp; @@ -1728,6 +1730,7 @@ gfc_simplify_expr (gfc_expr *p, int type) break; case EXPR_COMPCALL: + case EXPR_PPC: gcc_unreachable (); break; } @@ -3038,7 +3041,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) symbol_attribute attr; gfc_ref *ref; int is_pure; - int pointer, check_intent_in; + int pointer, check_intent_in, proc_pointer; if (lvalue->symtree->n.sym->ts.type == BT_UNKNOWN && !lvalue->symtree->n.sym->attr.proc_pointer) @@ -3062,8 +3065,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) /* Check INTENT(IN), unless the object itself is the component or sub-component of a pointer. */ check_intent_in = 1; - pointer = lvalue->symtree->n.sym->attr.pointer - | lvalue->symtree->n.sym->attr.proc_pointer; + pointer = lvalue->symtree->n.sym->attr.pointer; + proc_pointer = lvalue->symtree->n.sym->attr.proc_pointer; for (ref = lvalue->ref; ref; ref = ref->next) { @@ -3071,7 +3074,10 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) check_intent_in = 0; if (ref->type == REF_COMPONENT) - pointer = ref->u.c.component->attr.pointer; + { + pointer = ref->u.c.component->attr.pointer; + proc_pointer = ref->u.c.component->attr.proc_pointer; + } if (ref->type == REF_ARRAY && ref->next == NULL) { @@ -3107,7 +3113,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) return FAILURE; } - if (!pointer) + if (!pointer && !proc_pointer) { gfc_error ("Pointer assignment to non-POINTER at %L", &lvalue->where); return FAILURE; @@ -3129,11 +3135,12 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) return SUCCESS; /* Checks on rvalue for procedure pointer assignments. */ - if (lvalue->symtree->n.sym->attr.proc_pointer) + if (proc_pointer) { attr = gfc_expr_attr (rvalue); if (!((rvalue->expr_type == EXPR_NULL) || (rvalue->expr_type == EXPR_FUNCTION && attr.proc_pointer) + || (rvalue->expr_type == EXPR_VARIABLE && attr.proc_pointer) || (rvalue->expr_type == EXPR_VARIABLE && attr.flavor == FL_PROCEDURE))) { @@ -3164,6 +3171,9 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) rvalue->symtree->name, &rvalue->where) == FAILURE) return FAILURE; } + /* TODO: Enable interface check for PPCs. */ + if (is_proc_ptr_comp (rvalue, NULL)) + return SUCCESS; if (rvalue->expr_type == EXPR_VARIABLE && !gfc_compare_interfaces (lvalue->symtree->n.sym, rvalue->symtree->n.sym, 0)) @@ -3497,6 +3507,34 @@ gfc_expr_set_symbols_referenced (gfc_expr *expr) } +/* Determine if an expression is a procedure pointer component. If yes, the + argument 'comp' will point to the component (provided that 'comp' was + provided). */ + +bool +is_proc_ptr_comp (gfc_expr *expr, gfc_component **comp) +{ + gfc_ref *ref; + bool ppc = false; + + if (!expr || !expr->ref) + return false; + + ref = expr->ref; + while (ref->next) + ref = ref->next; + + if (ref->type == REF_COMPONENT) + { + ppc = ref->u.c.component->attr.proc_pointer; + if (ppc && comp) + *comp = ref->u.c.component; + } + + return ppc; +} + + /* Walk an expression tree and check each variable encountered for being typed. If strict is not set, a top-level variable is tolerated untyped in -std=gnu mode as is a basic arithmetic expression using those; this is for things in diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index c4049545ec9..afd3edbf292 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -151,7 +151,7 @@ bt; /* Expression node types. */ typedef enum { EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE, - EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL + EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL, EXPR_PPC } expr_t; @@ -698,9 +698,11 @@ typedef struct unsigned cray_pointer:1, cray_pointee:1; /* The symbol is a derived type with allocatable components, pointer - components or private components, possibly nested. zero_comp - is true if the derived type has no component at all. */ - unsigned alloc_comp:1, pointer_comp:1, private_comp:1, zero_comp:1; + components or private components, procedure pointer components, + possibly nested. zero_comp is true if the derived type has no + component at all. */ + unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1, + private_comp:1, zero_comp:1; /* The namespace where the VOLATILE attribute has been set. */ struct gfc_namespace *volatile_ns; @@ -851,6 +853,8 @@ typedef struct gfc_component locus loc; struct gfc_expr *initializer; struct gfc_component *next; + + struct gfc_formal_arglist *formal; } gfc_component; @@ -1883,7 +1887,7 @@ typedef enum EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN, EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN, EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, - EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, + EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_CALL_PPC, EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT, EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END, @@ -2265,7 +2269,7 @@ void gfc_set_implicit_none (void); void gfc_check_function_type (gfc_namespace *); bool gfc_is_intrinsic_typename (const char *); -gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *); +gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *); gfc_try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *); void gfc_set_sym_referenced (gfc_symbol *); @@ -2484,6 +2488,8 @@ void gfc_expr_set_symbols_referenced (gfc_expr *); gfc_try gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool); void gfc_expr_replace_symbols (gfc_expr *, gfc_symbol *); +bool is_proc_ptr_comp (gfc_expr *, gfc_component **); + /* st.c */ extern gfc_code new_st; @@ -2592,7 +2598,7 @@ void gfc_free_use_stmts (gfc_use_list *); symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *); symbol_attribute gfc_expr_attr (gfc_expr *); match gfc_match_rvalue (gfc_expr **); -match gfc_match_varspec (gfc_expr*, int, bool); +match gfc_match_varspec (gfc_expr*, int, bool, bool); int gfc_check_digit (char, int); /* trans.c */ diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index af1d2961085..b7c8b82537c 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -1641,7 +1641,7 @@ code that uses them running with the GNU Fortran compiler. * STRUCTURE and RECORD:: @c * UNION and MAP:: * ENCODE and DECODE statements:: -@c * Expressions in FORMAT statements:: +* Variable FORMAT expressions:: @c * Q edit descriptor:: @c * AUTOMATIC statement:: @c * TYPE and ACCEPT I/O Statements:: @@ -1779,6 +1779,51 @@ c ... Code that sets A, B and C @end smallexample +@node Variable FORMAT expressions +@subsection Variable @code{FORMAT} expressions +@cindex @code{FORMAT} + +A variable @code{FORMAT} expression is format statement which includes +angle brackets enclosing a Fortran expression: @code{FORMAT(I<N>)}. GNU +Fortran does not support this legacy extension. The effect of variable +format expressions can be reproduced by using the more powerful (and +standard) combination of internal output and string formats. For example, +replace a code fragment like this: + +@smallexample + WRITE(6,20) INT1 + 20 FORMAT(I<N+1>) +@end smallexample + +@noindent +with the following: + +@smallexample +c Variable declaration + CHARACTER(LEN=20) F +c +c Other code here... +c + WRITE(FMT,'("(I", I0, ")")') N+1 + WRITE(6,FM) INT1 +@end smallexample + +@noindent +or with: + +@smallexample +c Variable declaration + CHARACTER(LEN=20) FMT +c +c Other code here... +c + WRITE(FMT,*) N+1 + WRITE(6,"(I" // ADJUSTL(FMT) // ")") INT1 +@end smallexample + + + + @c --------------------------------------------------------------------- @c Intrinsic Procedures @c --------------------------------------------------------------------- diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 489386c10a6..3c03f959fb2 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1864,7 +1864,8 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, /* Satisfy 12.4.1.3 by ensuring that a procedure pointer actual argument is provided for a procedure pointer formal argument. */ if (f->sym->attr.proc_pointer - && !a->expr->symtree->n.sym->attr.proc_pointer) + && !(a->expr->symtree->n.sym->attr.proc_pointer + || is_proc_ptr_comp (a->expr, NULL))) { if (where) gfc_error ("Expected a procedure pointer for argument '%s' at %L", @@ -1874,7 +1875,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, /* Satisfy 12.4.1.2 by ensuring that a procedure actual argument is provided for a procedure formal argument. */ - if (a->expr->ts.type != BT_PROCEDURE + if (a->expr->ts.type != BT_PROCEDURE && !is_proc_ptr_comp (a->expr, NULL) && a->expr->expr_type == EXPR_VARIABLE && f->sym->attr.flavor == FL_PROCEDURE) { diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 8c9bfced1a5..97fbf776ed1 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -259,6 +259,7 @@ the default width of @code{DOUBLE PRECISION} to 16 bytes if possible, unless Allow @samp{$} as a valid non-first character in a symbol name. Symbols that start with @samp{$} are rejected since it is unclear which rules to apply to implicit typing as different vendors implement different rules. +Using @samp{$} in @code{IMPLICIT} statements is also rejected. @item -fbackslash @opindex @code{backslash} diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index a5c9f32199a..6faedec1ce8 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1336,7 +1336,8 @@ gfc_match_pointer_assignment (void) goto cleanup; } - if (lvalue->symtree->n.sym->attr.proc_pointer) + if (lvalue->symtree->n.sym->attr.proc_pointer + || is_proc_ptr_comp (lvalue, NULL)) gfc_matching_procptr_assignment = 1; m = gfc_match (" %e%t", &rvalue); @@ -2629,7 +2630,7 @@ match_typebound_call (gfc_symtree* varst) base->where = gfc_current_locus; gfc_set_sym_referenced (varst->n.sym); - m = gfc_match_varspec (base, 0, true); + m = gfc_match_varspec (base, 0, true, true); if (m == MATCH_NO) gfc_error ("Expected component reference at %C"); if (m != MATCH_YES) @@ -2641,13 +2642,16 @@ match_typebound_call (gfc_symtree* varst) return MATCH_ERROR; } - if (base->expr_type != EXPR_COMPCALL) + if (base->expr_type == EXPR_COMPCALL) + new_st.op = EXEC_COMPCALL; + else if (base->expr_type == EXPR_PPC) + new_st.op = EXEC_CALL_PPC; + else { - gfc_error ("Expected type-bound procedure reference at %C"); + gfc_error ("Expected type-bound procedure or procedure pointer component " + "at %C"); return MATCH_ERROR; } - - new_st.op = EXEC_COMPCALL; new_st.expr = base; return MATCH_YES; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 86db7aa22c2..7f4dba5dcee 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3043,6 +3043,7 @@ mio_expr (gfc_expr **ep) break; case EXPR_COMPCALL: + case EXPR_PPC: gcc_unreachable (); break; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index c67e99400f2..59296b104fa 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1878,15 +1878,11 @@ parse_derived (void) unexpected_eof (); case ST_DATA_DECL: + case ST_PROCEDURE: accept_statement (st); seen_component = 1; break; - case ST_PROCEDURE: - gfc_error ("PROCEDURE binding at %C must be inside CONTAINS"); - error_flag = 1; - break; - case ST_FINAL: gfc_error ("FINAL declaration at %C must be inside CONTAINS"); error_flag = 1; @@ -1993,6 +1989,12 @@ endType: || (c->ts.type == BT_DERIVED && c->ts.derived->attr.pointer_comp)) sym->attr.pointer_comp = 1; + /* Look for procedure pointer components. */ + if (c->attr.proc_pointer + || (c->ts.type == BT_DERIVED + && c->ts.derived->attr.proc_pointer_comp)) + sym->attr.proc_pointer_comp = 1; + /* Look for private components. */ if (sym->component_access == ACCESS_PRIVATE || c->attr.access == ACCESS_PRIVATE diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 7e41535c266..96fbddce92a 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1708,10 +1708,13 @@ extend_ref (gfc_expr *primary, gfc_ref *tail) variable like member references or substrings. If equiv_flag is set we only match stuff that is allowed inside an EQUIVALENCE statement. sub_flag tells whether we expect a type-bound procedure found - to be a subroutine as part of CALL or a FUNCTION. */ + to be a subroutine as part of CALL or a FUNCTION. For procedure pointer + components, 'ppc_arg' determines whether the PPC may be called (with an + argument list), or whether it may just be referred to as a pointer. */ match -gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag) +gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, + bool ppc_arg) { char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_ref *substring, *tail; @@ -1754,7 +1757,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag) return MATCH_YES; if (sym->ts.type == BT_UNKNOWN && gfc_peek_ascii_char () == '%' - && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) + && gfc_get_default_type (sym->name, sym->ns)->type == BT_DERIVED) gfc_set_default_type (sym, 0, sym->ns); if (sym->ts.type != BT_DERIVED || gfc_match_char ('%') != MATCH_YES) @@ -1826,6 +1829,20 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag) primary->ts = component->ts; + if (component->attr.proc_pointer && ppc_arg + && !gfc_matching_procptr_assignment) + { + primary->expr_type = EXPR_PPC; + m = gfc_match_actual_arglist (component->attr.subroutine, + &primary->value.compcall.actual); + if (m == MATCH_ERROR) + return MATCH_ERROR; + if (m == MATCH_NO) + primary->value.compcall.actual = NULL; + + break; + } + if (component->as != NULL) { tail = extend_ref (primary, tail); @@ -1847,7 +1864,7 @@ check_substring: unknown = false; if (primary->ts.type == BT_UNKNOWN) { - if (gfc_get_default_type (sym, sym->ns)->type == BT_CHARACTER) + if (gfc_get_default_type (sym->name, sym->ns)->type == BT_CHARACTER) { gfc_set_default_type (sym, 0, sym->ns); primary->ts = sym->ts; @@ -1925,7 +1942,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) allocatable = attr.allocatable; target = attr.target; - if (pointer) + if (pointer || attr.proc_pointer) target = 1; if (ts != NULL && expr->ts.type == BT_UNKNOWN) @@ -1971,7 +1988,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) pointer = ref->u.c.component->attr.pointer; allocatable = ref->u.c.component->attr.allocatable; - if (pointer) + if (pointer || attr.proc_pointer) target = 1; break; @@ -2478,7 +2495,7 @@ gfc_match_rvalue (gfc_expr **result) e->expr_type = EXPR_VARIABLE; e->symtree = symtree; - m = gfc_match_varspec (e, 0, false); + m = gfc_match_varspec (e, 0, false, true); break; case FL_PARAMETER: @@ -2495,7 +2512,7 @@ gfc_match_rvalue (gfc_expr **result) } e->symtree = symtree; - m = gfc_match_varspec (e, 0, false); + m = gfc_match_varspec (e, 0, false, true); if (sym->ts.is_c_interop || sym->ts.is_iso_c) break; @@ -2551,7 +2568,7 @@ gfc_match_rvalue (gfc_expr **result) e = gfc_get_expr (); e->expr_type = EXPR_VARIABLE; e->symtree = symtree; - m = gfc_match_varspec (e, 0, false); + m = gfc_match_varspec (e, 0, false, true); break; } @@ -2578,7 +2595,7 @@ gfc_match_rvalue (gfc_expr **result) e->symtree = symtree; e->expr_type = EXPR_VARIABLE; - m = gfc_match_varspec (e, 0, false); + m = gfc_match_varspec (e, 0, false, true); break; } @@ -2658,7 +2675,7 @@ gfc_match_rvalue (gfc_expr **result) if (gfc_peek_ascii_char () == '%' && sym->ts.type == BT_UNKNOWN - && gfc_get_default_type (sym, sym->ns)->type == BT_DERIVED) + && gfc_get_default_type (sym->name, sym->ns)->type == BT_DERIVED) gfc_set_default_type (sym, 0, sym->ns); /* If the symbol has a dimension attribute, the expression is a @@ -2676,7 +2693,7 @@ gfc_match_rvalue (gfc_expr **result) e = gfc_get_expr (); e->symtree = symtree; e->expr_type = EXPR_VARIABLE; - m = gfc_match_varspec (e, 0, false); + m = gfc_match_varspec (e, 0, false, true); break; } @@ -2701,7 +2718,7 @@ gfc_match_rvalue (gfc_expr **result) /*FIXME:??? gfc_match_varspec does set this for us: */ e->ts = sym->ts; - m = gfc_match_varspec (e, 0, false); + m = gfc_match_varspec (e, 0, false, true); break; } @@ -2725,7 +2742,7 @@ gfc_match_rvalue (gfc_expr **result) implicit_char = false; if (sym->ts.type == BT_UNKNOWN) { - ts = gfc_get_default_type (sym,NULL); + ts = gfc_get_default_type (sym->name, NULL); if (ts->type == BT_CHARACTER) implicit_char = true; } @@ -2790,7 +2807,7 @@ gfc_match_rvalue (gfc_expr **result) /* If our new function returns a character, array or structure type, it might have subsequent references. */ - m = gfc_match_varspec (e, 0, false); + m = gfc_match_varspec (e, 0, false, true); if (m == MATCH_NO) m = MATCH_YES; @@ -2963,7 +2980,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) if (gfc_peek_ascii_char () == '%' && sym->ts.type == BT_UNKNOWN - && gfc_get_default_type (sym, implicit_ns)->type == BT_DERIVED) + && gfc_get_default_type (sym->name, implicit_ns)->type == BT_DERIVED) gfc_set_default_type (sym, 0, implicit_ns); } @@ -2975,7 +2992,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag) expr->where = where; /* Now see if we have to do more. */ - m = gfc_match_varspec (expr, equiv_flag, false); + m = gfc_match_varspec (expr, equiv_flag, false, false); if (m != MATCH_YES) { gfc_free_expr (expr); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fe79e4a6703..34cb365a562 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -528,14 +528,14 @@ resolve_entries (gfc_namespace *ns) fas = fas ? fas : ns->entries->sym->result->as; fts = &ns->entries->sym->result->ts; if (fts->type == BT_UNKNOWN) - fts = gfc_get_default_type (ns->entries->sym->result, NULL); + fts = gfc_get_default_type (ns->entries->sym->result->name, NULL); for (el = ns->entries->next; el; el = el->next) { ts = &el->sym->result->ts; as = el->sym->as; as = as ? as : el->sym->result->as; if (ts->type == BT_UNKNOWN) - ts = gfc_get_default_type (el->sym->result, NULL); + ts = gfc_get_default_type (el->sym->result->name, NULL); if (! gfc_compare_types (ts, fts) || (el->sym->result->attr.dimension @@ -612,7 +612,7 @@ resolve_entries (gfc_namespace *ns) { ts = &sym->ts; if (ts->type == BT_UNKNOWN) - ts = gfc_get_default_type (sym, NULL); + ts = gfc_get_default_type (sym->name, NULL); switch (ts->type) { case BT_INTEGER: @@ -878,7 +878,8 @@ resolve_structure_cons (gfc_expr *expr) } if (cons->expr->expr_type == EXPR_NULL - && !(comp->attr.pointer || comp->attr.allocatable)) + && !(comp->attr.pointer || comp->attr.allocatable + || comp->attr.proc_pointer)) { t = FAILURE; gfc_error ("The NULL in the derived type constructor at %L is " @@ -1215,6 +1216,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, gfc_symtree *parent_st; gfc_expr *e; int save_need_full_assumed_size; + gfc_component *comp; for (; arg; arg = arg->next) { @@ -1234,6 +1236,13 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, continue; } + if (is_proc_ptr_comp (e, &comp)) + { + e->ts = comp->ts; + e->expr_type = EXPR_VARIABLE; + goto argument_list; + } + if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.generic && no_formal_args @@ -1906,7 +1915,7 @@ set_type: expr->ts = sym->ts; else { - ts = gfc_get_default_type (sym, sym->ns); + ts = gfc_get_default_type (sym->name, sym->ns); if (ts->type == BT_UNKNOWN) { @@ -4804,6 +4813,61 @@ resolve_compcall (gfc_expr* e) } +/* Resolve a CALL to a Procedure Pointer Component (Subroutine). */ + +static gfc_try +resolve_ppc_call (gfc_code* c) +{ + gfc_component *comp; + gcc_assert (is_proc_ptr_comp (c->expr, &comp)); + + c->resolved_sym = c->expr->symtree->n.sym; + c->expr->expr_type = EXPR_VARIABLE; + c->ext.actual = c->expr->value.compcall.actual; + + if (!comp->attr.subroutine) + gfc_add_subroutine (&comp->attr, comp->name, &c->expr->where); + + if (resolve_actual_arglist (c->ext.actual, comp->attr.proc, + comp->formal == NULL) == FAILURE) + return FAILURE; + + /* TODO: Check actual arguments. + gfc_procedure_use (stree->n.sym, &c->expr->value.compcall.actual, + &c->expr->where);*/ + + return SUCCESS; +} + + +/* Resolve a Function Call to a Procedure Pointer Component (Function). */ + +static gfc_try +resolve_expr_ppc (gfc_expr* e) +{ + gfc_component *comp; + gcc_assert (is_proc_ptr_comp (e, &comp)); + + /* Convert to EXPR_FUNCTION. */ + e->expr_type = EXPR_FUNCTION; + e->value.function.isym = NULL; + e->value.function.actual = e->value.compcall.actual; + e->ts = comp->ts; + + if (!comp->attr.function) + gfc_add_function (&comp->attr, comp->name, &e->where); + + if (resolve_actual_arglist (e->value.function.actual, comp->attr.proc, + comp->formal == NULL) == FAILURE) + return FAILURE; + + /* TODO: Check actual arguments. + gfc_procedure_use (stree->n.sym, &e->value.compcall.actual, &e->where); */ + + return SUCCESS; +} + + /* Resolve an expression. That is, make sure that types of operands agree with their operators, intrinsic operators are converted to function calls for overloaded types and unresolved function references are resolved. */ @@ -4853,6 +4917,10 @@ gfc_resolve_expr (gfc_expr *e) t = SUCCESS; break; + case EXPR_PPC: + t = resolve_expr_ppc (e); + break; + case EXPR_ARRAY: t = FAILURE; if (resolve_ref (e) == FAILURE) @@ -6819,7 +6887,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) } t = SUCCESS; - if (code->op != EXEC_COMPCALL) + if (code->op != EXEC_COMPCALL && code->op != EXEC_CALL_PPC) t = gfc_resolve_expr (code->expr); forall_flag = forall_save; @@ -6931,6 +6999,10 @@ resolve_code (gfc_code *code, gfc_namespace *ns) resolve_typebound_call (code); break; + case EXEC_CALL_PPC: + resolve_ppc_call (code); + break; + case EXEC_SELECT: /* Select is complicated. Also, a SELECT construct could be a transformed computed GOTO. */ @@ -8906,6 +8978,78 @@ resolve_fl_derived (gfc_symbol *sym) for (c = sym->components; c != NULL; c = c->next) { + if (c->attr.proc_pointer && c->ts.interface) + { + if (c->ts.interface->attr.procedure) + gfc_error ("Interface '%s', used by procedure pointer component " + "'%s' at %L, is declared in a later PROCEDURE statement", + c->ts.interface->name, c->name, &c->loc); + + /* Get the attributes from the interface (now resolved). */ + if (c->ts.interface->attr.if_source + || c->ts.interface->attr.intrinsic) + { + gfc_symbol *ifc = c->ts.interface; + + if (ifc->attr.intrinsic) + resolve_intrinsic (ifc, &ifc->declared_at); + + if (ifc->result) + c->ts = ifc->result->ts; + else + c->ts = ifc->ts; + c->ts.interface = ifc; + c->attr.function = ifc->attr.function; + c->attr.subroutine = ifc->attr.subroutine; + /* TODO: gfc_copy_formal_args (c, ifc); */ + + c->attr.allocatable = ifc->attr.allocatable; + c->attr.pointer = ifc->attr.pointer; + c->attr.pure = ifc->attr.pure; + c->attr.elemental = ifc->attr.elemental; + c->attr.dimension = ifc->attr.dimension; + c->attr.recursive = ifc->attr.recursive; + c->attr.always_explicit = ifc->attr.always_explicit; + /* Copy array spec. */ + c->as = gfc_copy_array_spec (ifc->as); + /*if (c->as) + { + int i; + for (i = 0; i < c->as->rank; i++) + { + gfc_expr_replace_symbols (c->as->lower[i], c); + gfc_expr_replace_symbols (c->as->upper[i], c); + } + }*/ + /* Copy char length. */ + if (ifc->ts.cl) + { + c->ts.cl = gfc_get_charlen(); + c->ts.cl->resolved = ifc->ts.cl->resolved; + c->ts.cl->length = gfc_copy_expr (ifc->ts.cl->length); + /*gfc_expr_replace_symbols (c->ts.cl->length, c);*/ + /* Add charlen to namespace. */ + /*if (c->formal_ns) + { + c->ts.cl->next = c->formal_ns->cl_list; + c->formal_ns->cl_list = c->ts.cl; + }*/ + } + } + else if (c->ts.interface->name[0] != '\0') + { + gfc_error ("Interface '%s' of procedure pointer component " + "'%s' at %L must be explicit", c->ts.interface->name, + c->name, &c->loc); + return FAILURE; + } + } + else if (c->attr.proc_pointer && c->ts.type == BT_UNKNOWN) + { + c->ts = *gfc_get_default_type (c->name, NULL); + c->attr.implicit_type = 1; + } + /* Check type-spec if this is not the parent-type component. */ if ((!sym->attr.extension || c != sym->components) && resolve_typespec_used (&c->ts, &c->loc, c->name) == FAILURE) @@ -9157,7 +9301,8 @@ resolve_fl_parameter (gfc_symbol *sym) matches the implicit type, since PARAMETER statements can precede IMPLICIT statements. */ if (sym->attr.implicit_type - && !gfc_compare_types (&sym->ts, gfc_get_default_type (sym, sym->ns))) + && !gfc_compare_types (&sym->ts, gfc_get_default_type (sym->name, + sym->ns))) { gfc_error ("Implicitly typed PARAMETER '%s' at %L doesn't match a " "later IMPLICIT type", sym->name, &sym->declared_at); @@ -9237,7 +9382,8 @@ resolve_symbol (gfc_symbol *sym) sym->name,&sym->declared_at); /* Get the attributes from the interface (now resolved). */ - if (sym->ts.interface->attr.if_source || sym->ts.interface->attr.intrinsic) + if (sym->ts.interface->attr.if_source + || sym->ts.interface->attr.intrinsic) { gfc_symbol *ifc = sym->ts.interface; @@ -9320,13 +9466,14 @@ resolve_symbol (gfc_symbol *sym) if ((isym = gfc_find_function (sym->name))) { - if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising) + if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising + && !sym->attr.implicit_type) gfc_warning ("Type specified for intrinsic function '%s' at %L is" " ignored", sym->name, &sym->declared_at); } else if ((isym = gfc_find_subroutine (sym->name))) { - if (sym->ts.type != BT_UNKNOWN) + if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type) { gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type" " specifier", sym->name, &sym->declared_at); diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 4f82050bcc0..d0cdb0e868c 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -110,6 +110,7 @@ gfc_free_statement (gfc_code *p) break; case EXEC_COMPCALL: + case EXEC_CALL_PPC: case EXEC_CALL: case EXEC_ASSIGN_CALL: gfc_free_actual_arglist (p->ext.actual); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index a82e67558fb..2160afa14c0 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -219,11 +219,11 @@ gfc_merge_new_implicit (gfc_typespec *ts) /* Given a symbol, return a pointer to the typespec for its default type. */ gfc_typespec * -gfc_get_default_type (gfc_symbol *sym, gfc_namespace *ns) +gfc_get_default_type (const char *name, gfc_namespace *ns) { char letter; - letter = sym->name[0]; + letter = name[0]; if (gfc_option.flag_allow_leading_underscore && letter == '_') gfc_internal_error ("Option -fallow-leading-underscore is for use only by " @@ -231,7 +231,7 @@ gfc_get_default_type (gfc_symbol *sym, gfc_namespace *ns) "implicitly typed variables"); if (letter < 'a' || letter > 'z') - gfc_internal_error ("gfc_get_default_type(): Bad symbol '%s'",sym->name); + gfc_internal_error ("gfc_get_default_type(): Bad symbol '%s'", name); if (ns == NULL) ns = gfc_current_ns; @@ -252,7 +252,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) if (sym->ts.type != BT_UNKNOWN) gfc_internal_error ("gfc_set_default_type(): symbol already has a type"); - ts = gfc_get_default_type (sym, ns); + ts = gfc_get_default_type (sym->name, ns); if (ts->type == BT_UNKNOWN) { @@ -1779,6 +1779,7 @@ gfc_add_component (gfc_symbol *sym, const char *name, p->name = gfc_get_string (name); p->loc = gfc_current_locus; + p->ts.type = BT_UNKNOWN; *component = p; return SUCCESS; @@ -4494,3 +4495,4 @@ gfc_get_tbp_symtree (gfc_symtree **root, const char *name) return result; } + diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index a541a79eb33..280a1922a8b 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -476,7 +476,8 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref) se->string_length = tmp; } - if (c->attr.pointer && c->attr.dimension == 0 && c->ts.type != BT_CHARACTER) + if ((c->attr.pointer || c->attr.proc_pointer) && c->attr.dimension == 0 + && c->ts.type != BT_CHARACTER) se->expr = build_fold_indirect_ref (se->expr); } @@ -1487,11 +1488,13 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind) } static void -gfc_conv_function_val (gfc_se * se, gfc_symbol * sym) +conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr) { tree tmp; - if (sym->attr.dummy) + if (is_proc_ptr_comp (expr, NULL)) + tmp = gfc_get_proc_ptr_comp (se, expr); + else if (sym->attr.dummy) { tmp = gfc_get_symbol_decl (sym); if (sym->attr.proc_pointer) @@ -1527,7 +1530,7 @@ gfc_conv_function_val (gfc_se * se, gfc_symbol * sym) /* Translate the call for an elemental subroutine call used in an operator - assignment. This is a simplified version of gfc_conv_function_call. */ + assignment. This is a simplified version of gfc_conv_procedure_call. */ tree gfc_conv_operator_assign (gfc_se *lse, gfc_se *rse, gfc_symbol *sym) @@ -1556,7 +1559,7 @@ gfc_conv_operator_assign (gfc_se *lse, gfc_se *rse, gfc_symbol *sym) /* Build the function call. */ gfc_init_se (&se, NULL); - gfc_conv_function_val (&se, sym); + conv_function_val (&se, sym, NULL); tmp = TREE_TYPE (TREE_TYPE (TREE_TYPE (se.expr))); tmp = build_call_list (tmp, se.expr, args); gfc_add_expr_to_block (&block, tmp); @@ -2133,6 +2136,7 @@ gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping, break; case EXPR_COMPCALL: + case EXPR_PPC: gcc_unreachable (); break; } @@ -2402,11 +2406,13 @@ conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name) /* Generate code for a procedure call. Note can return se->post != NULL. If se->direct_byref is set then se->expr contains the return parameter. - Return nonzero, if the call has alternate specifiers. */ + Return nonzero, if the call has alternate specifiers. + 'expr' is only needed for procedure pointer components. */ int -gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, - gfc_actual_arglist * arg, tree append_args) +gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, + gfc_actual_arglist * arg, gfc_expr * expr, + tree append_args) { gfc_interface_mapping mapping; tree arglist; @@ -2496,16 +2502,20 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, gfc_add_block_to_block (&se->post, &cptrse.post); gfc_init_se (&fptrse, NULL); - if (sym->intmod_sym_id == ISOCBINDING_F_POINTER) - fptrse.want_pointer = 1; + if (sym->intmod_sym_id == ISOCBINDING_F_POINTER + || is_proc_ptr_comp (arg->next->expr, NULL)) + fptrse.want_pointer = 1; gfc_conv_expr (&fptrse, arg->next->expr); gfc_add_block_to_block (&se->pre, &fptrse.pre); gfc_add_block_to_block (&se->post, &fptrse.post); - tmp = arg->next->expr->symtree->n.sym->backend_decl; - se->expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (tmp), fptrse.expr, - fold_convert (TREE_TYPE (tmp), cptrse.expr)); + if (is_proc_ptr_comp (arg->next->expr, NULL)) + tmp = gfc_get_ppc_type (arg->next->expr->ref->u.c.component); + else + tmp = TREE_TYPE (arg->next->expr->symtree->n.sym->backend_decl); + se->expr = fold_build2 (MODIFY_EXPR, tmp, fptrse.expr, + fold_convert (tmp, cptrse.expr)); return 0; } @@ -2942,7 +2952,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, arglist = chainon (arglist, append_args); /* Generate the actual call. */ - gfc_conv_function_val (se, sym); + conv_function_val (se, sym, expr); /* If there are alternate return labels, function type should be integer. Can't modify the type in place though, since it can be shared @@ -2969,7 +2979,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, something like x = f() where f is pointer valued, we have to dereference the result. */ - if (!se->want_pointer && !byref && sym->attr.pointer) + if (!se->want_pointer && !byref && sym->attr.pointer + && !is_proc_ptr_comp (expr, NULL)) se->expr = build_fold_indirect_ref (se->expr); /* f2c calling conventions require a scalar default real function to @@ -3346,6 +3357,20 @@ gfc_conv_statement_function (gfc_se * se, gfc_expr * expr) } +/* Return the backend_decl for a procedure pointer component. */ + +tree +gfc_get_proc_ptr_comp (gfc_se *se, gfc_expr *e) +{ + gfc_se comp_se; + gfc_init_se (&comp_se, NULL); + e->expr_type = EXPR_VARIABLE; + gfc_conv_expr (&comp_se, e); + comp_se.expr = build_fold_addr_expr (comp_se.expr); + return gfc_evaluate_now (comp_se.expr, &se->pre); +} + + /* Translate a function expression. */ static void @@ -3372,7 +3397,9 @@ gfc_conv_function_expr (gfc_se * se, gfc_expr * expr) sym = expr->value.function.esym; if (!sym) sym = expr->symtree->n.sym; - gfc_conv_function_call (se, sym, expr->value.function.actual, NULL_TREE); + + gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, + NULL_TREE); } @@ -3794,7 +3821,8 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) continue; val = gfc_conv_initializer (c->expr, &cm->ts, - TREE_TYPE (cm->backend_decl), cm->attr.dimension, cm->attr.pointer); + TREE_TYPE (cm->backend_decl), cm->attr.dimension, + cm->attr.pointer || cm->attr.proc_pointer); /* Append it to the constructor list. */ CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 1d6e8bb3b51..d00a35b5eb8 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1702,7 +1702,8 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr) } } - gfc_conv_function_call (se, sym, expr->value.function.actual, append_args); + gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, + append_args); gfc_free (sym); } @@ -2877,7 +2878,8 @@ conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr, /* Build the call itself. */ sym = gfc_get_symbol_for_expr (expr); - gfc_conv_function_call (se, sym, expr->value.function.actual, append_args); + gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, + append_args); gfc_free (sym); } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index e96c0afc4c7..d695759477a 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -356,8 +356,8 @@ gfc_trans_call (gfc_code * code, bool dependency_check) /* Translate the call. */ has_alternate_specifier - = gfc_conv_function_call (&se, code->resolved_sym, code->ext.actual, - NULL_TREE); + = gfc_conv_procedure_call (&se, code->resolved_sym, code->ext.actual, + code->expr, NULL_TREE); /* A subroutine without side-effect, by definition, does nothing! */ TREE_SIDE_EFFECTS (se.expr) = 1; @@ -430,8 +430,8 @@ gfc_trans_call (gfc_code * code, bool dependency_check) gfc_init_block (&block); /* Add the subroutine call to the block. */ - gfc_conv_function_call (&loopse, code->resolved_sym, code->ext.actual, - NULL_TREE); + gfc_conv_procedure_call (&loopse, code->resolved_sym, code->ext.actual, + code->expr, NULL_TREE); gfc_add_expr_to_block (&loopse.pre, loopse.expr); gfc_add_block_to_block (&block, &loopse.pre); diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h index 5d92a9c756f..ff8a8384a4c 100644 --- a/gcc/fortran/trans-stmt.h +++ b/gcc/fortran/trans-stmt.h @@ -29,6 +29,7 @@ tree gfc_trans_code (gfc_code *); tree gfc_trans_assign (gfc_code *); tree gfc_trans_pointer_assign (gfc_code *); tree gfc_trans_init_assign (gfc_code *); +tree gfc_get_proc_ptr_comp (gfc_se *, gfc_expr *); /* trans-stmt.c */ tree gfc_trans_cycle (gfc_code *); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index e83215c0686..694d0e28980 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1777,6 +1777,21 @@ copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to) } +/* Build a tree node for a procedure pointer component. */ + +tree +gfc_get_ppc_type (gfc_component* c) +{ + tree t; + if (c->attr.function) + t = gfc_typenode_for_spec (&c->ts); + else + t = void_type_node; + /* TODO: Build argument list. */ + return build_pointer_type (build_function_type (t, NULL_TREE)); +} + + /* Build a tree node for a derived type. If there are equal derived types, with different local names, these are built at the same time. If an equal derived type has been built @@ -1823,16 +1838,9 @@ gfc_get_derived_type (gfc_symbol * derived) /* derived->backend_decl != 0 means we saw it before, but its components' backend_decl may have not been built. */ if (derived->backend_decl) - { - /* Its components' backend_decl have been built. */ - if (TYPE_FIELDS (derived->backend_decl)) - return derived->backend_decl; - else - typenode = derived->backend_decl; - } + return derived->backend_decl; else { - /* We see this derived type first time, so build the type node. */ typenode = make_node (RECORD_TYPE); TYPE_NAME (typenode) = get_identifier (derived->name); @@ -1881,6 +1889,8 @@ gfc_get_derived_type (gfc_symbol * derived) { if (c->ts.type == BT_DERIVED) field_type = c->ts.derived->backend_decl; + else if (c->attr.proc_pointer) + field_type = gfc_get_ppc_type (c); else { if (c->ts.type == BT_CHARACTER) diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 7074913d4ef..c3e51a11c8e 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -89,4 +89,6 @@ int gfc_is_nodesc_array (gfc_symbol *); /* Return the DTYPE for an array. */ tree gfc_get_dtype (tree); +tree gfc_get_ppc_type (gfc_component *); + #endif diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index e926a950fcf..54d40d7c3e3 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1115,6 +1115,10 @@ gfc_trans_code (gfc_code * code) } break; + case EXEC_CALL_PPC: + res = gfc_trans_call (code, false); + break; + case EXEC_ASSIGN_CALL: res = gfc_trans_call (code, true); break; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index b6b3279b4a9..c75f40eb6fe 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -71,7 +71,7 @@ typedef struct gfc_se are NULL. Used by intrinsic size. */ unsigned data_not_needed:1; - /* If set, gfc_conv_function_call does not put byref calls into se->pre. */ + /* If set, gfc_conv_procedure_call does not put byref calls into se->pre. */ unsigned no_function_call:1; /* Scalarization parameters. */ @@ -313,9 +313,10 @@ int gfc_is_intrinsic_libcall (gfc_expr *); /* Used to call the elemental subroutines used in operator assignments. */ tree gfc_conv_operator_assign (gfc_se *, gfc_se *, gfc_symbol *); -/* Also used to CALL subroutines. */ -int gfc_conv_function_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *, - tree); +/* Used to call ordinary functions/subroutines + and procedure pointer components. */ +int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *, + gfc_expr *, tree); void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent); diff --git a/gcc/gimple.def b/gcc/gimple.def index 23eaae2e86e..26aa719f660 100644 --- a/gcc/gimple.def +++ b/gcc/gimple.def @@ -102,16 +102,17 @@ DEFGSCODE(GIMPLE_CHANGE_DYNAMIC_TYPE, "gimple_change_dynamic_type", SUBCODE is the tree code for the expression computed by the RHS of the assignment. It must be one of the tree codes accepted by - get_gimple_rhs_class. + get_gimple_rhs_class. If LHS is not a gimple register according to + is_gimple_reg, SUBCODE must be of class GIMPLE_SINGLE_RHS. LHS is the operand on the LHS of the assignment. It must be a tree node - accepted by is_gimple_operand. + accepted by is_gimple_lvalue. - RHS1 is the first operand on the RHS of the assignment. It must be a tree - node accepted by is_gimple_operand. + RHS1 is the first operand on the RHS of the assignment. It must always be + present. It must be a tree node accepted by is_gimple_val. - RHS2 is the second operand on the RHS of the assignemnt. It must be a tree - node accepted by is_gimple_operand. This argument exists only if SUBCODE is + RHS2 is the second operand on the RHS of the assignment. It must be a tree + node accepted by is_gimple_val. This argument exists only if SUBCODE is of class GIMPLE_BINARY_RHS. */ DEFGSCODE(GIMPLE_ASSIGN, "gimple_assign", struct gimple_statement_with_memory_ops) diff --git a/gcc/opts.c b/gcc/opts.c index 1170967b949..aab540c0399 100644 --- a/gcc/opts.c +++ b/gcc/opts.c @@ -961,6 +961,27 @@ decode_options (unsigned int argc, const char **argv) handle_options (argc, argv, lang_mask); + /* Make DUMP_BASE_NAME relative to the AUX_BASE_NAME directory, + typically the directory to contain the object file. */ + if (aux_base_name && ! IS_ABSOLUTE_PATH (dump_base_name)) + { + const char *aux_base; + + base_of_path (aux_base_name, &aux_base); + if (aux_base_name != aux_base) + { + int dir_len = aux_base - aux_base_name; + char *new_dump_base_name = + XNEWVEC (char, strlen(dump_base_name) + dir_len + 1); + + /* Copy directory component from AUX_BASE_NAME. */ + memcpy (new_dump_base_name, aux_base_name, dir_len); + /* Append existing DUMP_BASE_NAME. */ + strcpy (new_dump_base_name + dir_len, dump_base_name); + dump_base_name = new_dump_base_name; + } + } + /* Handle related options for unit-at-a-time, toplevel-reorder, and section-anchors. */ if (!flag_unit_at_a_time) diff --git a/gcc/plugin.c b/gcc/plugin.c index a8c2eeaffb2..dec336d70b7 100644 --- a/gcc/plugin.c +++ b/gcc/plugin.c @@ -816,7 +816,6 @@ bool plugin_default_version_check (struct plugin_gcc_version *gcc_version, struct plugin_gcc_version *plugin_version) { - /* version is NULL if the plugin was not linked with plugin-version.o */ if (!gcc_version || !plugin_version) return false; diff --git a/gcc/regcprop.c b/gcc/regcprop.c new file mode 100644 index 00000000000..87aaf02c409 --- /dev/null +++ b/gcc/regcprop.c @@ -0,0 +1,1005 @@ +/* Copy propagation on hard registers for the GNU compiler. + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 + Free Software Foundation, Inc. + + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + <http://www.gnu.org/licenses/>. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tm.h" +#include "rtl.h" +#include "tm_p.h" +#include "insn-config.h" +#include "regs.h" +#include "addresses.h" +#include "hard-reg-set.h" +#include "basic-block.h" +#include "reload.h" +#include "output.h" +#include "function.h" +#include "recog.h" +#include "flags.h" +#include "toplev.h" +#include "obstack.h" +#include "timevar.h" +#include "tree-pass.h" +#include "df.h" + +/* The following code does forward propagation of hard register copies. + The object is to eliminate as many dependencies as possible, so that + we have the most scheduling freedom. As a side effect, we also clean + up some silly register allocation decisions made by reload. This + code may be obsoleted by a new register allocator. */ + +/* For each register, we have a list of registers that contain the same + value. The OLDEST_REGNO field points to the head of the list, and + the NEXT_REGNO field runs through the list. The MODE field indicates + what mode the data is known to be in; this field is VOIDmode when the + register is not known to contain valid data. */ + +struct value_data_entry +{ + enum machine_mode mode; + unsigned int oldest_regno; + unsigned int next_regno; +}; + +struct value_data +{ + struct value_data_entry e[FIRST_PSEUDO_REGISTER]; + unsigned int max_value_regs; +}; + +static void kill_value_one_regno (unsigned, struct value_data *); +static void kill_value_regno (unsigned, unsigned, struct value_data *); +static void kill_value (rtx, struct value_data *); +static void set_value_regno (unsigned, enum machine_mode, struct value_data *); +static void init_value_data (struct value_data *); +static void kill_clobbered_value (rtx, const_rtx, void *); +static void kill_set_value (rtx, const_rtx, void *); +static int kill_autoinc_value (rtx *, void *); +static void copy_value (rtx, rtx, struct value_data *); +static bool mode_change_ok (enum machine_mode, enum machine_mode, + unsigned int); +static rtx maybe_mode_change (enum machine_mode, enum machine_mode, + enum machine_mode, unsigned int, unsigned int); +static rtx find_oldest_value_reg (enum reg_class, rtx, struct value_data *); +static bool replace_oldest_value_reg (rtx *, enum reg_class, rtx, + struct value_data *); +static bool replace_oldest_value_addr (rtx *, enum reg_class, + enum machine_mode, rtx, + struct value_data *); +static bool replace_oldest_value_mem (rtx, rtx, struct value_data *); +static bool copyprop_hardreg_forward_1 (basic_block, struct value_data *); +extern void debug_value_data (struct value_data *); +#ifdef ENABLE_CHECKING +static void validate_value_data (struct value_data *); +#endif + +/* Kill register REGNO. This involves removing it from any value + lists, and resetting the value mode to VOIDmode. This is only a + helper function; it does not handle any hard registers overlapping + with REGNO. */ + +static void +kill_value_one_regno (unsigned int regno, struct value_data *vd) +{ + unsigned int i, next; + + if (vd->e[regno].oldest_regno != regno) + { + for (i = vd->e[regno].oldest_regno; + vd->e[i].next_regno != regno; + i = vd->e[i].next_regno) + continue; + vd->e[i].next_regno = vd->e[regno].next_regno; + } + else if ((next = vd->e[regno].next_regno) != INVALID_REGNUM) + { + for (i = next; i != INVALID_REGNUM; i = vd->e[i].next_regno) + vd->e[i].oldest_regno = next; + } + + vd->e[regno].mode = VOIDmode; + vd->e[regno].oldest_regno = regno; + vd->e[regno].next_regno = INVALID_REGNUM; + +#ifdef ENABLE_CHECKING + validate_value_data (vd); +#endif +} + +/* Kill the value in register REGNO for NREGS, and any other registers + whose values overlap. */ + +static void +kill_value_regno (unsigned int regno, unsigned int nregs, + struct value_data *vd) +{ + unsigned int j; + + /* Kill the value we're told to kill. */ + for (j = 0; j < nregs; ++j) + kill_value_one_regno (regno + j, vd); + + /* Kill everything that overlapped what we're told to kill. */ + if (regno < vd->max_value_regs) + j = 0; + else + j = regno - vd->max_value_regs; + for (; j < regno; ++j) + { + unsigned int i, n; + if (vd->e[j].mode == VOIDmode) + continue; + n = hard_regno_nregs[j][vd->e[j].mode]; + if (j + n > regno) + for (i = 0; i < n; ++i) + kill_value_one_regno (j + i, vd); + } +} + +/* Kill X. This is a convenience function wrapping kill_value_regno + so that we mind the mode the register is in. */ + +static void +kill_value (rtx x, struct value_data *vd) +{ + rtx orig_rtx = x; + + if (GET_CODE (x) == SUBREG) + { + x = simplify_subreg (GET_MODE (x), SUBREG_REG (x), + GET_MODE (SUBREG_REG (x)), SUBREG_BYTE (x)); + if (x == NULL_RTX) + x = SUBREG_REG (orig_rtx); + } + if (REG_P (x)) + { + unsigned int regno = REGNO (x); + unsigned int n = hard_regno_nregs[regno][GET_MODE (x)]; + + kill_value_regno (regno, n, vd); + } +} + +/* Remember that REGNO is valid in MODE. */ + +static void +set_value_regno (unsigned int regno, enum machine_mode mode, + struct value_data *vd) +{ + unsigned int nregs; + + vd->e[regno].mode = mode; + + nregs = hard_regno_nregs[regno][mode]; + if (nregs > vd->max_value_regs) + vd->max_value_regs = nregs; +} + +/* Initialize VD such that there are no known relationships between regs. */ + +static void +init_value_data (struct value_data *vd) +{ + int i; + for (i = 0; i < FIRST_PSEUDO_REGISTER; ++i) + { + vd->e[i].mode = VOIDmode; + vd->e[i].oldest_regno = i; + vd->e[i].next_regno = INVALID_REGNUM; + } + vd->max_value_regs = 0; +} + +/* Called through note_stores. If X is clobbered, kill its value. */ + +static void +kill_clobbered_value (rtx x, const_rtx set, void *data) +{ + struct value_data *const vd = (struct value_data *) data; + if (GET_CODE (set) == CLOBBER) + kill_value (x, vd); +} + +/* Called through note_stores. If X is set, not clobbered, kill its + current value and install it as the root of its own value list. */ + +static void +kill_set_value (rtx x, const_rtx set, void *data) +{ + struct value_data *const vd = (struct value_data *) data; + if (GET_CODE (set) != CLOBBER) + { + kill_value (x, vd); + if (REG_P (x)) + set_value_regno (REGNO (x), GET_MODE (x), vd); + } +} + +/* Called through for_each_rtx. Kill any register used as the base of an + auto-increment expression, and install that register as the root of its + own value list. */ + +static int +kill_autoinc_value (rtx *px, void *data) +{ + rtx x = *px; + struct value_data *const vd = (struct value_data *) data; + + if (GET_RTX_CLASS (GET_CODE (x)) == RTX_AUTOINC) + { + x = XEXP (x, 0); + kill_value (x, vd); + set_value_regno (REGNO (x), Pmode, vd); + return -1; + } + + return 0; +} + +/* Assert that SRC has been copied to DEST. Adjust the data structures + to reflect that SRC contains an older copy of the shared value. */ + +static void +copy_value (rtx dest, rtx src, struct value_data *vd) +{ + unsigned int dr = REGNO (dest); + unsigned int sr = REGNO (src); + unsigned int dn, sn; + unsigned int i; + + /* ??? At present, it's possible to see noop sets. It'd be nice if + this were cleaned up beforehand... */ + if (sr == dr) + return; + + /* Do not propagate copies to the stack pointer, as that can leave + memory accesses with no scheduling dependency on the stack update. */ + if (dr == STACK_POINTER_REGNUM) + return; + + /* Likewise with the frame pointer, if we're using one. */ + if (frame_pointer_needed && dr == HARD_FRAME_POINTER_REGNUM) + return; + + /* Do not propagate copies to fixed or global registers, patterns + can be relying to see particular fixed register or users can + expect the chosen global register in asm. */ + if (fixed_regs[dr] || global_regs[dr]) + return; + + /* If SRC and DEST overlap, don't record anything. */ + dn = hard_regno_nregs[dr][GET_MODE (dest)]; + sn = hard_regno_nregs[sr][GET_MODE (dest)]; + if ((dr > sr && dr < sr + sn) + || (sr > dr && sr < dr + dn)) + return; + + /* If SRC had no assigned mode (i.e. we didn't know it was live) + assign it now and assume the value came from an input argument + or somesuch. */ + if (vd->e[sr].mode == VOIDmode) + set_value_regno (sr, vd->e[dr].mode, vd); + + /* If we are narrowing the input to a smaller number of hard regs, + and it is in big endian, we are really extracting a high part. + Since we generally associate a low part of a value with the value itself, + we must not do the same for the high part. + Note we can still get low parts for the same mode combination through + a two-step copy involving differently sized hard regs. + Assume hard regs fr* are 32 bits bits each, while r* are 64 bits each: + (set (reg:DI r0) (reg:DI fr0)) + (set (reg:SI fr2) (reg:SI r0)) + loads the low part of (reg:DI fr0) - i.e. fr1 - into fr2, while: + (set (reg:SI fr2) (reg:SI fr0)) + loads the high part of (reg:DI fr0) into fr2. + + We can't properly represent the latter case in our tables, so don't + record anything then. */ + else if (sn < (unsigned int) hard_regno_nregs[sr][vd->e[sr].mode] + && (GET_MODE_SIZE (vd->e[sr].mode) > UNITS_PER_WORD + ? WORDS_BIG_ENDIAN : BYTES_BIG_ENDIAN)) + return; + + /* If SRC had been assigned a mode narrower than the copy, we can't + link DEST into the chain, because not all of the pieces of the + copy came from oldest_regno. */ + else if (sn > (unsigned int) hard_regno_nregs[sr][vd->e[sr].mode]) + return; + + /* Link DR at the end of the value chain used by SR. */ + + vd->e[dr].oldest_regno = vd->e[sr].oldest_regno; + + for (i = sr; vd->e[i].next_regno != INVALID_REGNUM; i = vd->e[i].next_regno) + continue; + vd->e[i].next_regno = dr; + +#ifdef ENABLE_CHECKING + validate_value_data (vd); +#endif +} + +/* Return true if a mode change from ORIG to NEW is allowed for REGNO. */ + +static bool +mode_change_ok (enum machine_mode orig_mode, enum machine_mode new_mode, + unsigned int regno ATTRIBUTE_UNUSED) +{ + if (GET_MODE_SIZE (orig_mode) < GET_MODE_SIZE (new_mode)) + return false; + +#ifdef CANNOT_CHANGE_MODE_CLASS + return !REG_CANNOT_CHANGE_MODE_P (regno, orig_mode, new_mode); +#endif + + return true; +} + +/* Register REGNO was originally set in ORIG_MODE. It - or a copy of it - + was copied in COPY_MODE to COPY_REGNO, and then COPY_REGNO was accessed + in NEW_MODE. + Return a NEW_MODE rtx for REGNO if that's OK, otherwise return NULL_RTX. */ + +static rtx +maybe_mode_change (enum machine_mode orig_mode, enum machine_mode copy_mode, + enum machine_mode new_mode, unsigned int regno, + unsigned int copy_regno ATTRIBUTE_UNUSED) +{ + if (GET_MODE_SIZE (copy_mode) < GET_MODE_SIZE (orig_mode) + && GET_MODE_SIZE (copy_mode) < GET_MODE_SIZE (new_mode)) + return NULL_RTX; + + if (orig_mode == new_mode) + return gen_rtx_raw_REG (new_mode, regno); + else if (mode_change_ok (orig_mode, new_mode, regno)) + { + int copy_nregs = hard_regno_nregs[copy_regno][copy_mode]; + int use_nregs = hard_regno_nregs[copy_regno][new_mode]; + int copy_offset + = GET_MODE_SIZE (copy_mode) / copy_nregs * (copy_nregs - use_nregs); + int offset + = GET_MODE_SIZE (orig_mode) - GET_MODE_SIZE (new_mode) - copy_offset; + int byteoffset = offset % UNITS_PER_WORD; + int wordoffset = offset - byteoffset; + + offset = ((WORDS_BIG_ENDIAN ? wordoffset : 0) + + (BYTES_BIG_ENDIAN ? byteoffset : 0)); + return gen_rtx_raw_REG (new_mode, + regno + subreg_regno_offset (regno, orig_mode, + offset, + new_mode)); + } + return NULL_RTX; +} + +/* Find the oldest copy of the value contained in REGNO that is in + register class CL and has mode MODE. If found, return an rtx + of that oldest register, otherwise return NULL. */ + +static rtx +find_oldest_value_reg (enum reg_class cl, rtx reg, struct value_data *vd) +{ + unsigned int regno = REGNO (reg); + enum machine_mode mode = GET_MODE (reg); + unsigned int i; + + /* If we are accessing REG in some mode other that what we set it in, + make sure that the replacement is valid. In particular, consider + (set (reg:DI r11) (...)) + (set (reg:SI r9) (reg:SI r11)) + (set (reg:SI r10) (...)) + (set (...) (reg:DI r9)) + Replacing r9 with r11 is invalid. */ + if (mode != vd->e[regno].mode) + { + if (hard_regno_nregs[regno][mode] + > hard_regno_nregs[regno][vd->e[regno].mode]) + return NULL_RTX; + } + + for (i = vd->e[regno].oldest_regno; i != regno; i = vd->e[i].next_regno) + { + enum machine_mode oldmode = vd->e[i].mode; + rtx new_rtx; + + if (!in_hard_reg_set_p (reg_class_contents[cl], mode, i)) + return NULL_RTX; + + new_rtx = maybe_mode_change (oldmode, vd->e[regno].mode, mode, i, regno); + if (new_rtx) + { + ORIGINAL_REGNO (new_rtx) = ORIGINAL_REGNO (reg); + REG_ATTRS (new_rtx) = REG_ATTRS (reg); + REG_POINTER (new_rtx) = REG_POINTER (reg); + return new_rtx; + } + } + + return NULL_RTX; +} + +/* If possible, replace the register at *LOC with the oldest register + in register class CL. Return true if successfully replaced. */ + +static bool +replace_oldest_value_reg (rtx *loc, enum reg_class cl, rtx insn, + struct value_data *vd) +{ + rtx new_rtx = find_oldest_value_reg (cl, *loc, vd); + if (new_rtx) + { + if (dump_file) + fprintf (dump_file, "insn %u: replaced reg %u with %u\n", + INSN_UID (insn), REGNO (*loc), REGNO (new_rtx)); + + validate_change (insn, loc, new_rtx, 1); + return true; + } + return false; +} + +/* Similar to replace_oldest_value_reg, but *LOC contains an address. + Adapted from find_reloads_address_1. CL is INDEX_REG_CLASS or + BASE_REG_CLASS depending on how the register is being considered. */ + +static bool +replace_oldest_value_addr (rtx *loc, enum reg_class cl, + enum machine_mode mode, rtx insn, + struct value_data *vd) +{ + rtx x = *loc; + RTX_CODE code = GET_CODE (x); + const char *fmt; + int i, j; + bool changed = false; + + switch (code) + { + case PLUS: + { + rtx orig_op0 = XEXP (x, 0); + rtx orig_op1 = XEXP (x, 1); + RTX_CODE code0 = GET_CODE (orig_op0); + RTX_CODE code1 = GET_CODE (orig_op1); + rtx op0 = orig_op0; + rtx op1 = orig_op1; + rtx *locI = NULL; + rtx *locB = NULL; + enum rtx_code index_code = SCRATCH; + + if (GET_CODE (op0) == SUBREG) + { + op0 = SUBREG_REG (op0); + code0 = GET_CODE (op0); + } + + if (GET_CODE (op1) == SUBREG) + { + op1 = SUBREG_REG (op1); + code1 = GET_CODE (op1); + } + + if (code0 == MULT || code0 == SIGN_EXTEND || code0 == TRUNCATE + || code0 == ZERO_EXTEND || code1 == MEM) + { + locI = &XEXP (x, 0); + locB = &XEXP (x, 1); + index_code = GET_CODE (*locI); + } + else if (code1 == MULT || code1 == SIGN_EXTEND || code1 == TRUNCATE + || code1 == ZERO_EXTEND || code0 == MEM) + { + locI = &XEXP (x, 1); + locB = &XEXP (x, 0); + index_code = GET_CODE (*locI); + } + else if (code0 == CONST_INT || code0 == CONST + || code0 == SYMBOL_REF || code0 == LABEL_REF) + { + locB = &XEXP (x, 1); + index_code = GET_CODE (XEXP (x, 0)); + } + else if (code1 == CONST_INT || code1 == CONST + || code1 == SYMBOL_REF || code1 == LABEL_REF) + { + locB = &XEXP (x, 0); + index_code = GET_CODE (XEXP (x, 1)); + } + else if (code0 == REG && code1 == REG) + { + int index_op; + unsigned regno0 = REGNO (op0), regno1 = REGNO (op1); + + if (REGNO_OK_FOR_INDEX_P (regno1) + && regno_ok_for_base_p (regno0, mode, PLUS, REG)) + index_op = 1; + else if (REGNO_OK_FOR_INDEX_P (regno0) + && regno_ok_for_base_p (regno1, mode, PLUS, REG)) + index_op = 0; + else if (regno_ok_for_base_p (regno0, mode, PLUS, REG) + || REGNO_OK_FOR_INDEX_P (regno1)) + index_op = 1; + else if (regno_ok_for_base_p (regno1, mode, PLUS, REG)) + index_op = 0; + else + index_op = 1; + + locI = &XEXP (x, index_op); + locB = &XEXP (x, !index_op); + index_code = GET_CODE (*locI); + } + else if (code0 == REG) + { + locI = &XEXP (x, 0); + locB = &XEXP (x, 1); + index_code = GET_CODE (*locI); + } + else if (code1 == REG) + { + locI = &XEXP (x, 1); + locB = &XEXP (x, 0); + index_code = GET_CODE (*locI); + } + + if (locI) + changed |= replace_oldest_value_addr (locI, INDEX_REG_CLASS, mode, + insn, vd); + if (locB) + changed |= replace_oldest_value_addr (locB, + base_reg_class (mode, PLUS, + index_code), + mode, insn, vd); + return changed; + } + + case POST_INC: + case POST_DEC: + case POST_MODIFY: + case PRE_INC: + case PRE_DEC: + case PRE_MODIFY: + return false; + + case MEM: + return replace_oldest_value_mem (x, insn, vd); + + case REG: + return replace_oldest_value_reg (loc, cl, insn, vd); + + default: + break; + } + + fmt = GET_RTX_FORMAT (code); + for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) + { + if (fmt[i] == 'e') + changed |= replace_oldest_value_addr (&XEXP (x, i), cl, mode, + insn, vd); + else if (fmt[i] == 'E') + for (j = XVECLEN (x, i) - 1; j >= 0; j--) + changed |= replace_oldest_value_addr (&XVECEXP (x, i, j), cl, + mode, insn, vd); + } + + return changed; +} + +/* Similar to replace_oldest_value_reg, but X contains a memory. */ + +static bool +replace_oldest_value_mem (rtx x, rtx insn, struct value_data *vd) +{ + return replace_oldest_value_addr (&XEXP (x, 0), + base_reg_class (GET_MODE (x), MEM, + SCRATCH), + GET_MODE (x), insn, vd); +} + +/* Perform the forward copy propagation on basic block BB. */ + +static bool +copyprop_hardreg_forward_1 (basic_block bb, struct value_data *vd) +{ + bool changed = false; + rtx insn; + + for (insn = BB_HEAD (bb); ; insn = NEXT_INSN (insn)) + { + int n_ops, i, alt, predicated; + bool is_asm, any_replacements; + rtx set; + bool replaced[MAX_RECOG_OPERANDS]; + + if (! INSN_P (insn)) + { + if (insn == BB_END (bb)) + break; + else + continue; + } + + set = single_set (insn); + extract_insn (insn); + if (! constrain_operands (1)) + fatal_insn_not_found (insn); + preprocess_constraints (); + alt = which_alternative; + n_ops = recog_data.n_operands; + is_asm = asm_noperands (PATTERN (insn)) >= 0; + + /* Simplify the code below by rewriting things to reflect + matching constraints. Also promote OP_OUT to OP_INOUT + in predicated instructions. */ + + predicated = GET_CODE (PATTERN (insn)) == COND_EXEC; + for (i = 0; i < n_ops; ++i) + { + int matches = recog_op_alt[i][alt].matches; + if (matches >= 0) + recog_op_alt[i][alt].cl = recog_op_alt[matches][alt].cl; + if (matches >= 0 || recog_op_alt[i][alt].matched >= 0 + || (predicated && recog_data.operand_type[i] == OP_OUT)) + recog_data.operand_type[i] = OP_INOUT; + } + + /* For each earlyclobber operand, zap the value data. */ + for (i = 0; i < n_ops; i++) + if (recog_op_alt[i][alt].earlyclobber) + kill_value (recog_data.operand[i], vd); + + /* Within asms, a clobber cannot overlap inputs or outputs. + I wouldn't think this were true for regular insns, but + scan_rtx treats them like that... */ + note_stores (PATTERN (insn), kill_clobbered_value, vd); + + /* Kill all auto-incremented values. */ + /* ??? REG_INC is useless, since stack pushes aren't done that way. */ + for_each_rtx (&PATTERN (insn), kill_autoinc_value, vd); + + /* Kill all early-clobbered operands. */ + for (i = 0; i < n_ops; i++) + if (recog_op_alt[i][alt].earlyclobber) + kill_value (recog_data.operand[i], vd); + + /* Special-case plain move instructions, since we may well + be able to do the move from a different register class. */ + if (set && REG_P (SET_SRC (set))) + { + rtx src = SET_SRC (set); + unsigned int regno = REGNO (src); + enum machine_mode mode = GET_MODE (src); + unsigned int i; + rtx new_rtx; + + /* If we are accessing SRC in some mode other that what we + set it in, make sure that the replacement is valid. */ + if (mode != vd->e[regno].mode) + { + if (hard_regno_nregs[regno][mode] + > hard_regno_nregs[regno][vd->e[regno].mode]) + goto no_move_special_case; + } + + /* If the destination is also a register, try to find a source + register in the same class. */ + if (REG_P (SET_DEST (set))) + { + new_rtx = find_oldest_value_reg (REGNO_REG_CLASS (regno), src, vd); + if (new_rtx && validate_change (insn, &SET_SRC (set), new_rtx, 0)) + { + if (dump_file) + fprintf (dump_file, + "insn %u: replaced reg %u with %u\n", + INSN_UID (insn), regno, REGNO (new_rtx)); + changed = true; + goto did_replacement; + } + } + + /* Otherwise, try all valid registers and see if its valid. */ + for (i = vd->e[regno].oldest_regno; i != regno; + i = vd->e[i].next_regno) + { + new_rtx = maybe_mode_change (vd->e[i].mode, vd->e[regno].mode, + mode, i, regno); + if (new_rtx != NULL_RTX) + { + if (validate_change (insn, &SET_SRC (set), new_rtx, 0)) + { + ORIGINAL_REGNO (new_rtx) = ORIGINAL_REGNO (src); + REG_ATTRS (new_rtx) = REG_ATTRS (src); + REG_POINTER (new_rtx) = REG_POINTER (src); + if (dump_file) + fprintf (dump_file, + "insn %u: replaced reg %u with %u\n", + INSN_UID (insn), regno, REGNO (new_rtx)); + changed = true; + goto did_replacement; + } + } + } + } + no_move_special_case: + + any_replacements = false; + + /* For each input operand, replace a hard register with the + eldest live copy that's in an appropriate register class. */ + for (i = 0; i < n_ops; i++) + { + replaced[i] = false; + + /* Don't scan match_operand here, since we've no reg class + information to pass down. Any operands that we could + substitute in will be represented elsewhere. */ + if (recog_data.constraints[i][0] == '\0') + continue; + + /* Don't replace in asms intentionally referencing hard regs. */ + if (is_asm && REG_P (recog_data.operand[i]) + && (REGNO (recog_data.operand[i]) + == ORIGINAL_REGNO (recog_data.operand[i]))) + continue; + + if (recog_data.operand_type[i] == OP_IN) + { + if (recog_op_alt[i][alt].is_address) + replaced[i] + = replace_oldest_value_addr (recog_data.operand_loc[i], + recog_op_alt[i][alt].cl, + VOIDmode, insn, vd); + else if (REG_P (recog_data.operand[i])) + replaced[i] + = replace_oldest_value_reg (recog_data.operand_loc[i], + recog_op_alt[i][alt].cl, + insn, vd); + else if (MEM_P (recog_data.operand[i])) + replaced[i] = replace_oldest_value_mem (recog_data.operand[i], + insn, vd); + } + else if (MEM_P (recog_data.operand[i])) + replaced[i] = replace_oldest_value_mem (recog_data.operand[i], + insn, vd); + + /* If we performed any replacement, update match_dups. */ + if (replaced[i]) + { + int j; + rtx new_rtx; + + new_rtx = *recog_data.operand_loc[i]; + recog_data.operand[i] = new_rtx; + for (j = 0; j < recog_data.n_dups; j++) + if (recog_data.dup_num[j] == i) + validate_unshare_change (insn, recog_data.dup_loc[j], new_rtx, 1); + + any_replacements = true; + } + } + + if (any_replacements) + { + if (! apply_change_group ()) + { + for (i = 0; i < n_ops; i++) + if (replaced[i]) + { + rtx old = *recog_data.operand_loc[i]; + recog_data.operand[i] = old; + } + + if (dump_file) + fprintf (dump_file, + "insn %u: reg replacements not verified\n", + INSN_UID (insn)); + } + else + changed = true; + } + + did_replacement: + /* Clobber call-clobbered registers. */ + if (CALL_P (insn)) + for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) + if (TEST_HARD_REG_BIT (regs_invalidated_by_call, i)) + kill_value_regno (i, 1, vd); + + /* Notice stores. */ + note_stores (PATTERN (insn), kill_set_value, vd); + + /* Notice copies. */ + if (set && REG_P (SET_DEST (set)) && REG_P (SET_SRC (set))) + copy_value (SET_DEST (set), SET_SRC (set), vd); + + if (insn == BB_END (bb)) + break; + } + + return changed; +} + +/* Main entry point for the forward copy propagation optimization. */ + +static unsigned int +copyprop_hardreg_forward (void) +{ + struct value_data *all_vd; + basic_block bb; + sbitmap visited; + + all_vd = XNEWVEC (struct value_data, last_basic_block); + + visited = sbitmap_alloc (last_basic_block); + sbitmap_zero (visited); + + FOR_EACH_BB (bb) + { + SET_BIT (visited, bb->index); + + /* If a block has a single predecessor, that we've already + processed, begin with the value data that was live at + the end of the predecessor block. */ + /* ??? Ought to use more intelligent queuing of blocks. */ + if (single_pred_p (bb) + && TEST_BIT (visited, single_pred (bb)->index) + && ! (single_pred_edge (bb)->flags & (EDGE_ABNORMAL_CALL | EDGE_EH))) + all_vd[bb->index] = all_vd[single_pred (bb)->index]; + else + init_value_data (all_vd + bb->index); + + copyprop_hardreg_forward_1 (bb, all_vd + bb->index); + } + + sbitmap_free (visited); + free (all_vd); + return 0; +} + +/* Dump the value chain data to stderr. */ + +void +debug_value_data (struct value_data *vd) +{ + HARD_REG_SET set; + unsigned int i, j; + + CLEAR_HARD_REG_SET (set); + + for (i = 0; i < FIRST_PSEUDO_REGISTER; ++i) + if (vd->e[i].oldest_regno == i) + { + if (vd->e[i].mode == VOIDmode) + { + if (vd->e[i].next_regno != INVALID_REGNUM) + fprintf (stderr, "[%u] Bad next_regno for empty chain (%u)\n", + i, vd->e[i].next_regno); + continue; + } + + SET_HARD_REG_BIT (set, i); + fprintf (stderr, "[%u %s] ", i, GET_MODE_NAME (vd->e[i].mode)); + + for (j = vd->e[i].next_regno; + j != INVALID_REGNUM; + j = vd->e[j].next_regno) + { + if (TEST_HARD_REG_BIT (set, j)) + { + fprintf (stderr, "[%u] Loop in regno chain\n", j); + return; + } + + if (vd->e[j].oldest_regno != i) + { + fprintf (stderr, "[%u] Bad oldest_regno (%u)\n", + j, vd->e[j].oldest_regno); + return; + } + SET_HARD_REG_BIT (set, j); + fprintf (stderr, "[%u %s] ", j, GET_MODE_NAME (vd->e[j].mode)); + } + fputc ('\n', stderr); + } + + for (i = 0; i < FIRST_PSEUDO_REGISTER; ++i) + if (! TEST_HARD_REG_BIT (set, i) + && (vd->e[i].mode != VOIDmode + || vd->e[i].oldest_regno != i + || vd->e[i].next_regno != INVALID_REGNUM)) + fprintf (stderr, "[%u] Non-empty reg in chain (%s %u %i)\n", + i, GET_MODE_NAME (vd->e[i].mode), vd->e[i].oldest_regno, + vd->e[i].next_regno); +} + +#ifdef ENABLE_CHECKING +static void +validate_value_data (struct value_data *vd) +{ + HARD_REG_SET set; + unsigned int i, j; + + CLEAR_HARD_REG_SET (set); + + for (i = 0; i < FIRST_PSEUDO_REGISTER; ++i) + if (vd->e[i].oldest_regno == i) + { + if (vd->e[i].mode == VOIDmode) + { + if (vd->e[i].next_regno != INVALID_REGNUM) + internal_error ("validate_value_data: [%u] Bad next_regno for empty chain (%u)", + i, vd->e[i].next_regno); + continue; + } + + SET_HARD_REG_BIT (set, i); + + for (j = vd->e[i].next_regno; + j != INVALID_REGNUM; + j = vd->e[j].next_regno) + { + if (TEST_HARD_REG_BIT (set, j)) + internal_error ("validate_value_data: Loop in regno chain (%u)", + j); + if (vd->e[j].oldest_regno != i) + internal_error ("validate_value_data: [%u] Bad oldest_regno (%u)", + j, vd->e[j].oldest_regno); + + SET_HARD_REG_BIT (set, j); + } + } + + for (i = 0; i < FIRST_PSEUDO_REGISTER; ++i) + if (! TEST_HARD_REG_BIT (set, i) + && (vd->e[i].mode != VOIDmode + || vd->e[i].oldest_regno != i + || vd->e[i].next_regno != INVALID_REGNUM)) + internal_error ("validate_value_data: [%u] Non-empty reg in chain (%s %u %i)", + i, GET_MODE_NAME (vd->e[i].mode), vd->e[i].oldest_regno, + vd->e[i].next_regno); +} +#endif + +static bool +gate_handle_cprop (void) +{ + return (optimize > 0 && (flag_cprop_registers)); +} + + +struct rtl_opt_pass pass_cprop_hardreg = +{ + { + RTL_PASS, + "cprop_hardreg", /* name */ + gate_handle_cprop, /* gate */ + copyprop_hardreg_forward, /* execute */ + NULL, /* sub */ + NULL, /* next */ + 0, /* static_pass_number */ + TV_CPROP_REGISTERS, /* tv_id */ + 0, /* properties_required */ + 0, /* properties_provided */ + 0, /* properties_destroyed */ + 0, /* todo_flags_start */ + TODO_dump_func | TODO_verify_rtl_sharing /* todo_flags_finish */ + } +}; diff --git a/gcc/regrename.c b/gcc/regrename.c index c678a093ca9..fcdaaf79e81 100644 --- a/gcc/regrename.c +++ b/gcc/regrename.c @@ -180,7 +180,7 @@ merge_overlapping_regs (basic_block b, HARD_REG_SET *pset, /* Perform register renaming on the current function. */ -static void +static unsigned int regrename_optimize (void) { int tick[FIRST_PSEUDO_REGISTER]; @@ -355,6 +355,8 @@ regrename_optimize (void) if (dump_file) fputc ('\n', dump_file); + + return 0; } static void @@ -999,943 +1001,7 @@ dump_def_use_chain (struct du_chain *chains) chains = chains->next_chain; } } - -/* The following code does forward propagation of hard register copies. - The object is to eliminate as many dependencies as possible, so that - we have the most scheduling freedom. As a side effect, we also clean - up some silly register allocation decisions made by reload. This - code may be obsoleted by a new register allocator. */ - -/* For each register, we have a list of registers that contain the same - value. The OLDEST_REGNO field points to the head of the list, and - the NEXT_REGNO field runs through the list. The MODE field indicates - what mode the data is known to be in; this field is VOIDmode when the - register is not known to contain valid data. */ - -struct value_data_entry -{ - enum machine_mode mode; - unsigned int oldest_regno; - unsigned int next_regno; -}; - -struct value_data -{ - struct value_data_entry e[FIRST_PSEUDO_REGISTER]; - unsigned int max_value_regs; -}; - -static void kill_value_one_regno (unsigned, struct value_data *); -static void kill_value_regno (unsigned, unsigned, struct value_data *); -static void kill_value (rtx, struct value_data *); -static void set_value_regno (unsigned, enum machine_mode, struct value_data *); -static void init_value_data (struct value_data *); -static void kill_clobbered_value (rtx, const_rtx, void *); -static void kill_set_value (rtx, const_rtx, void *); -static int kill_autoinc_value (rtx *, void *); -static void copy_value (rtx, rtx, struct value_data *); -static bool mode_change_ok (enum machine_mode, enum machine_mode, - unsigned int); -static rtx maybe_mode_change (enum machine_mode, enum machine_mode, - enum machine_mode, unsigned int, unsigned int); -static rtx find_oldest_value_reg (enum reg_class, rtx, struct value_data *); -static bool replace_oldest_value_reg (rtx *, enum reg_class, rtx, - struct value_data *); -static bool replace_oldest_value_addr (rtx *, enum reg_class, - enum machine_mode, rtx, - struct value_data *); -static bool replace_oldest_value_mem (rtx, rtx, struct value_data *); -static bool copyprop_hardreg_forward_1 (basic_block, struct value_data *); -extern void debug_value_data (struct value_data *); -#ifdef ENABLE_CHECKING -static void validate_value_data (struct value_data *); -#endif - -/* Kill register REGNO. This involves removing it from any value - lists, and resetting the value mode to VOIDmode. This is only a - helper function; it does not handle any hard registers overlapping - with REGNO. */ - -static void -kill_value_one_regno (unsigned int regno, struct value_data *vd) -{ - unsigned int i, next; - - if (vd->e[regno].oldest_regno != regno) - { - for (i = vd->e[regno].oldest_regno; - vd->e[i].next_regno != regno; - i = vd->e[i].next_regno) - continue; - vd->e[i].next_regno = vd->e[regno].next_regno; - } - else if ((next = vd->e[regno].next_regno) != INVALID_REGNUM) - { - for (i = next; i != INVALID_REGNUM; i = vd->e[i].next_regno) - vd->e[i].oldest_regno = next; - } - - vd->e[regno].mode = VOIDmode; - vd->e[regno].oldest_regno = regno; - vd->e[regno].next_regno = INVALID_REGNUM; - -#ifdef ENABLE_CHECKING - validate_value_data (vd); -#endif -} - -/* Kill the value in register REGNO for NREGS, and any other registers - whose values overlap. */ - -static void -kill_value_regno (unsigned int regno, unsigned int nregs, - struct value_data *vd) -{ - unsigned int j; - - /* Kill the value we're told to kill. */ - for (j = 0; j < nregs; ++j) - kill_value_one_regno (regno + j, vd); - - /* Kill everything that overlapped what we're told to kill. */ - if (regno < vd->max_value_regs) - j = 0; - else - j = regno - vd->max_value_regs; - for (; j < regno; ++j) - { - unsigned int i, n; - if (vd->e[j].mode == VOIDmode) - continue; - n = hard_regno_nregs[j][vd->e[j].mode]; - if (j + n > regno) - for (i = 0; i < n; ++i) - kill_value_one_regno (j + i, vd); - } -} - -/* Kill X. This is a convenience function wrapping kill_value_regno - so that we mind the mode the register is in. */ - -static void -kill_value (rtx x, struct value_data *vd) -{ - rtx orig_rtx = x; - - if (GET_CODE (x) == SUBREG) - { - x = simplify_subreg (GET_MODE (x), SUBREG_REG (x), - GET_MODE (SUBREG_REG (x)), SUBREG_BYTE (x)); - if (x == NULL_RTX) - x = SUBREG_REG (orig_rtx); - } - if (REG_P (x)) - { - unsigned int regno = REGNO (x); - unsigned int n = hard_regno_nregs[regno][GET_MODE (x)]; - kill_value_regno (regno, n, vd); - } -} - -/* Remember that REGNO is valid in MODE. */ - -static void -set_value_regno (unsigned int regno, enum machine_mode mode, - struct value_data *vd) -{ - unsigned int nregs; - - vd->e[regno].mode = mode; - - nregs = hard_regno_nregs[regno][mode]; - if (nregs > vd->max_value_regs) - vd->max_value_regs = nregs; -} - -/* Initialize VD such that there are no known relationships between regs. */ - -static void -init_value_data (struct value_data *vd) -{ - int i; - for (i = 0; i < FIRST_PSEUDO_REGISTER; ++i) - { - vd->e[i].mode = VOIDmode; - vd->e[i].oldest_regno = i; - vd->e[i].next_regno = INVALID_REGNUM; - } - vd->max_value_regs = 0; -} - -/* Called through note_stores. If X is clobbered, kill its value. */ - -static void -kill_clobbered_value (rtx x, const_rtx set, void *data) -{ - struct value_data *const vd = (struct value_data *) data; - if (GET_CODE (set) == CLOBBER) - kill_value (x, vd); -} - -/* Called through note_stores. If X is set, not clobbered, kill its - current value and install it as the root of its own value list. */ - -static void -kill_set_value (rtx x, const_rtx set, void *data) -{ - struct value_data *const vd = (struct value_data *) data; - if (GET_CODE (set) != CLOBBER) - { - kill_value (x, vd); - if (REG_P (x)) - set_value_regno (REGNO (x), GET_MODE (x), vd); - } -} - -/* Called through for_each_rtx. Kill any register used as the base of an - auto-increment expression, and install that register as the root of its - own value list. */ - -static int -kill_autoinc_value (rtx *px, void *data) -{ - rtx x = *px; - struct value_data *const vd = (struct value_data *) data; - - if (GET_RTX_CLASS (GET_CODE (x)) == RTX_AUTOINC) - { - x = XEXP (x, 0); - kill_value (x, vd); - set_value_regno (REGNO (x), Pmode, vd); - return -1; - } - - return 0; -} - -/* Assert that SRC has been copied to DEST. Adjust the data structures - to reflect that SRC contains an older copy of the shared value. */ - -static void -copy_value (rtx dest, rtx src, struct value_data *vd) -{ - unsigned int dr = REGNO (dest); - unsigned int sr = REGNO (src); - unsigned int dn, sn; - unsigned int i; - - /* ??? At present, it's possible to see noop sets. It'd be nice if - this were cleaned up beforehand... */ - if (sr == dr) - return; - - /* Do not propagate copies to the stack pointer, as that can leave - memory accesses with no scheduling dependency on the stack update. */ - if (dr == STACK_POINTER_REGNUM) - return; - - /* Likewise with the frame pointer, if we're using one. */ - if (frame_pointer_needed && dr == HARD_FRAME_POINTER_REGNUM) - return; - - /* Do not propagate copies to fixed or global registers, patterns - can be relying to see particular fixed register or users can - expect the chosen global register in asm. */ - if (fixed_regs[dr] || global_regs[dr]) - return; - - /* If SRC and DEST overlap, don't record anything. */ - dn = hard_regno_nregs[dr][GET_MODE (dest)]; - sn = hard_regno_nregs[sr][GET_MODE (dest)]; - if ((dr > sr && dr < sr + sn) - || (sr > dr && sr < dr + dn)) - return; - - /* If SRC had no assigned mode (i.e. we didn't know it was live) - assign it now and assume the value came from an input argument - or somesuch. */ - if (vd->e[sr].mode == VOIDmode) - set_value_regno (sr, vd->e[dr].mode, vd); - - /* If we are narrowing the input to a smaller number of hard regs, - and it is in big endian, we are really extracting a high part. - Since we generally associate a low part of a value with the value itself, - we must not do the same for the high part. - Note we can still get low parts for the same mode combination through - a two-step copy involving differently sized hard regs. - Assume hard regs fr* are 32 bits bits each, while r* are 64 bits each: - (set (reg:DI r0) (reg:DI fr0)) - (set (reg:SI fr2) (reg:SI r0)) - loads the low part of (reg:DI fr0) - i.e. fr1 - into fr2, while: - (set (reg:SI fr2) (reg:SI fr0)) - loads the high part of (reg:DI fr0) into fr2. - - We can't properly represent the latter case in our tables, so don't - record anything then. */ - else if (sn < (unsigned int) hard_regno_nregs[sr][vd->e[sr].mode] - && (GET_MODE_SIZE (vd->e[sr].mode) > UNITS_PER_WORD - ? WORDS_BIG_ENDIAN : BYTES_BIG_ENDIAN)) - return; - - /* If SRC had been assigned a mode narrower than the copy, we can't - link DEST into the chain, because not all of the pieces of the - copy came from oldest_regno. */ - else if (sn > (unsigned int) hard_regno_nregs[sr][vd->e[sr].mode]) - return; - - /* Link DR at the end of the value chain used by SR. */ - - vd->e[dr].oldest_regno = vd->e[sr].oldest_regno; - - for (i = sr; vd->e[i].next_regno != INVALID_REGNUM; i = vd->e[i].next_regno) - continue; - vd->e[i].next_regno = dr; - -#ifdef ENABLE_CHECKING - validate_value_data (vd); -#endif -} - -/* Return true if a mode change from ORIG to NEW is allowed for REGNO. */ - -static bool -mode_change_ok (enum machine_mode orig_mode, enum machine_mode new_mode, - unsigned int regno ATTRIBUTE_UNUSED) -{ - if (GET_MODE_SIZE (orig_mode) < GET_MODE_SIZE (new_mode)) - return false; - -#ifdef CANNOT_CHANGE_MODE_CLASS - return !REG_CANNOT_CHANGE_MODE_P (regno, orig_mode, new_mode); -#endif - - return true; -} - -/* Register REGNO was originally set in ORIG_MODE. It - or a copy of it - - was copied in COPY_MODE to COPY_REGNO, and then COPY_REGNO was accessed - in NEW_MODE. - Return a NEW_MODE rtx for REGNO if that's OK, otherwise return NULL_RTX. */ - -static rtx -maybe_mode_change (enum machine_mode orig_mode, enum machine_mode copy_mode, - enum machine_mode new_mode, unsigned int regno, - unsigned int copy_regno ATTRIBUTE_UNUSED) -{ - if (GET_MODE_SIZE (copy_mode) < GET_MODE_SIZE (orig_mode) - && GET_MODE_SIZE (copy_mode) < GET_MODE_SIZE (new_mode)) - return NULL_RTX; - - if (orig_mode == new_mode) - return gen_rtx_raw_REG (new_mode, regno); - else if (mode_change_ok (orig_mode, new_mode, regno)) - { - int copy_nregs = hard_regno_nregs[copy_regno][copy_mode]; - int use_nregs = hard_regno_nregs[copy_regno][new_mode]; - int copy_offset - = GET_MODE_SIZE (copy_mode) / copy_nregs * (copy_nregs - use_nregs); - int offset - = GET_MODE_SIZE (orig_mode) - GET_MODE_SIZE (new_mode) - copy_offset; - int byteoffset = offset % UNITS_PER_WORD; - int wordoffset = offset - byteoffset; - - offset = ((WORDS_BIG_ENDIAN ? wordoffset : 0) - + (BYTES_BIG_ENDIAN ? byteoffset : 0)); - return gen_rtx_raw_REG (new_mode, - regno + subreg_regno_offset (regno, orig_mode, - offset, - new_mode)); - } - return NULL_RTX; -} - -/* Find the oldest copy of the value contained in REGNO that is in - register class CL and has mode MODE. If found, return an rtx - of that oldest register, otherwise return NULL. */ - -static rtx -find_oldest_value_reg (enum reg_class cl, rtx reg, struct value_data *vd) -{ - unsigned int regno = REGNO (reg); - enum machine_mode mode = GET_MODE (reg); - unsigned int i; - - /* If we are accessing REG in some mode other that what we set it in, - make sure that the replacement is valid. In particular, consider - (set (reg:DI r11) (...)) - (set (reg:SI r9) (reg:SI r11)) - (set (reg:SI r10) (...)) - (set (...) (reg:DI r9)) - Replacing r9 with r11 is invalid. */ - if (mode != vd->e[regno].mode) - { - if (hard_regno_nregs[regno][mode] - > hard_regno_nregs[regno][vd->e[regno].mode]) - return NULL_RTX; - } - - for (i = vd->e[regno].oldest_regno; i != regno; i = vd->e[i].next_regno) - { - enum machine_mode oldmode = vd->e[i].mode; - rtx new_rtx; - - if (!in_hard_reg_set_p (reg_class_contents[cl], mode, i)) - return NULL_RTX; - - new_rtx = maybe_mode_change (oldmode, vd->e[regno].mode, mode, i, regno); - if (new_rtx) - { - ORIGINAL_REGNO (new_rtx) = ORIGINAL_REGNO (reg); - REG_ATTRS (new_rtx) = REG_ATTRS (reg); - REG_POINTER (new_rtx) = REG_POINTER (reg); - return new_rtx; - } - } - - return NULL_RTX; -} - -/* If possible, replace the register at *LOC with the oldest register - in register class CL. Return true if successfully replaced. */ - -static bool -replace_oldest_value_reg (rtx *loc, enum reg_class cl, rtx insn, - struct value_data *vd) -{ - rtx new_rtx = find_oldest_value_reg (cl, *loc, vd); - if (new_rtx) - { - if (dump_file) - fprintf (dump_file, "insn %u: replaced reg %u with %u\n", - INSN_UID (insn), REGNO (*loc), REGNO (new_rtx)); - - validate_change (insn, loc, new_rtx, 1); - return true; - } - return false; -} - -/* Similar to replace_oldest_value_reg, but *LOC contains an address. - Adapted from find_reloads_address_1. CL is INDEX_REG_CLASS or - BASE_REG_CLASS depending on how the register is being considered. */ - -static bool -replace_oldest_value_addr (rtx *loc, enum reg_class cl, - enum machine_mode mode, rtx insn, - struct value_data *vd) -{ - rtx x = *loc; - RTX_CODE code = GET_CODE (x); - const char *fmt; - int i, j; - bool changed = false; - - switch (code) - { - case PLUS: - { - rtx orig_op0 = XEXP (x, 0); - rtx orig_op1 = XEXP (x, 1); - RTX_CODE code0 = GET_CODE (orig_op0); - RTX_CODE code1 = GET_CODE (orig_op1); - rtx op0 = orig_op0; - rtx op1 = orig_op1; - rtx *locI = NULL; - rtx *locB = NULL; - enum rtx_code index_code = SCRATCH; - - if (GET_CODE (op0) == SUBREG) - { - op0 = SUBREG_REG (op0); - code0 = GET_CODE (op0); - } - - if (GET_CODE (op1) == SUBREG) - { - op1 = SUBREG_REG (op1); - code1 = GET_CODE (op1); - } - - if (code0 == MULT || code0 == SIGN_EXTEND || code0 == TRUNCATE - || code0 == ZERO_EXTEND || code1 == MEM) - { - locI = &XEXP (x, 0); - locB = &XEXP (x, 1); - index_code = GET_CODE (*locI); - } - else if (code1 == MULT || code1 == SIGN_EXTEND || code1 == TRUNCATE - || code1 == ZERO_EXTEND || code0 == MEM) - { - locI = &XEXP (x, 1); - locB = &XEXP (x, 0); - index_code = GET_CODE (*locI); - } - else if (code0 == CONST_INT || code0 == CONST - || code0 == SYMBOL_REF || code0 == LABEL_REF) - { - locB = &XEXP (x, 1); - index_code = GET_CODE (XEXP (x, 0)); - } - else if (code1 == CONST_INT || code1 == CONST - || code1 == SYMBOL_REF || code1 == LABEL_REF) - { - locB = &XEXP (x, 0); - index_code = GET_CODE (XEXP (x, 1)); - } - else if (code0 == REG && code1 == REG) - { - int index_op; - unsigned regno0 = REGNO (op0), regno1 = REGNO (op1); - - if (REGNO_OK_FOR_INDEX_P (regno1) - && regno_ok_for_base_p (regno0, mode, PLUS, REG)) - index_op = 1; - else if (REGNO_OK_FOR_INDEX_P (regno0) - && regno_ok_for_base_p (regno1, mode, PLUS, REG)) - index_op = 0; - else if (regno_ok_for_base_p (regno0, mode, PLUS, REG) - || REGNO_OK_FOR_INDEX_P (regno1)) - index_op = 1; - else if (regno_ok_for_base_p (regno1, mode, PLUS, REG)) - index_op = 0; - else - index_op = 1; - - locI = &XEXP (x, index_op); - locB = &XEXP (x, !index_op); - index_code = GET_CODE (*locI); - } - else if (code0 == REG) - { - locI = &XEXP (x, 0); - locB = &XEXP (x, 1); - index_code = GET_CODE (*locI); - } - else if (code1 == REG) - { - locI = &XEXP (x, 1); - locB = &XEXP (x, 0); - index_code = GET_CODE (*locI); - } - - if (locI) - changed |= replace_oldest_value_addr (locI, INDEX_REG_CLASS, mode, - insn, vd); - if (locB) - changed |= replace_oldest_value_addr (locB, - base_reg_class (mode, PLUS, - index_code), - mode, insn, vd); - return changed; - } - - case POST_INC: - case POST_DEC: - case POST_MODIFY: - case PRE_INC: - case PRE_DEC: - case PRE_MODIFY: - return false; - - case MEM: - return replace_oldest_value_mem (x, insn, vd); - - case REG: - return replace_oldest_value_reg (loc, cl, insn, vd); - - default: - break; - } - - fmt = GET_RTX_FORMAT (code); - for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--) - { - if (fmt[i] == 'e') - changed |= replace_oldest_value_addr (&XEXP (x, i), cl, mode, - insn, vd); - else if (fmt[i] == 'E') - for (j = XVECLEN (x, i) - 1; j >= 0; j--) - changed |= replace_oldest_value_addr (&XVECEXP (x, i, j), cl, - mode, insn, vd); - } - - return changed; -} - -/* Similar to replace_oldest_value_reg, but X contains a memory. */ - -static bool -replace_oldest_value_mem (rtx x, rtx insn, struct value_data *vd) -{ - return replace_oldest_value_addr (&XEXP (x, 0), - base_reg_class (GET_MODE (x), MEM, - SCRATCH), - GET_MODE (x), insn, vd); -} - -/* Perform the forward copy propagation on basic block BB. */ - -static bool -copyprop_hardreg_forward_1 (basic_block bb, struct value_data *vd) -{ - bool changed = false; - rtx insn; - - for (insn = BB_HEAD (bb); ; insn = NEXT_INSN (insn)) - { - int n_ops, i, alt, predicated; - bool is_asm, any_replacements; - rtx set; - bool replaced[MAX_RECOG_OPERANDS]; - - if (! INSN_P (insn)) - { - if (insn == BB_END (bb)) - break; - else - continue; - } - - set = single_set (insn); - extract_insn (insn); - if (! constrain_operands (1)) - fatal_insn_not_found (insn); - preprocess_constraints (); - alt = which_alternative; - n_ops = recog_data.n_operands; - is_asm = asm_noperands (PATTERN (insn)) >= 0; - - /* Simplify the code below by rewriting things to reflect - matching constraints. Also promote OP_OUT to OP_INOUT - in predicated instructions. */ - - predicated = GET_CODE (PATTERN (insn)) == COND_EXEC; - for (i = 0; i < n_ops; ++i) - { - int matches = recog_op_alt[i][alt].matches; - if (matches >= 0) - recog_op_alt[i][alt].cl = recog_op_alt[matches][alt].cl; - if (matches >= 0 || recog_op_alt[i][alt].matched >= 0 - || (predicated && recog_data.operand_type[i] == OP_OUT)) - recog_data.operand_type[i] = OP_INOUT; - } - - /* For each earlyclobber operand, zap the value data. */ - for (i = 0; i < n_ops; i++) - if (recog_op_alt[i][alt].earlyclobber) - kill_value (recog_data.operand[i], vd); - - /* Within asms, a clobber cannot overlap inputs or outputs. - I wouldn't think this were true for regular insns, but - scan_rtx treats them like that... */ - note_stores (PATTERN (insn), kill_clobbered_value, vd); - - /* Kill all auto-incremented values. */ - /* ??? REG_INC is useless, since stack pushes aren't done that way. */ - for_each_rtx (&PATTERN (insn), kill_autoinc_value, vd); - - /* Kill all early-clobbered operands. */ - for (i = 0; i < n_ops; i++) - if (recog_op_alt[i][alt].earlyclobber) - kill_value (recog_data.operand[i], vd); - - /* Special-case plain move instructions, since we may well - be able to do the move from a different register class. */ - if (set && REG_P (SET_SRC (set))) - { - rtx src = SET_SRC (set); - unsigned int regno = REGNO (src); - enum machine_mode mode = GET_MODE (src); - unsigned int i; - rtx new_rtx; - - /* If we are accessing SRC in some mode other that what we - set it in, make sure that the replacement is valid. */ - if (mode != vd->e[regno].mode) - { - if (hard_regno_nregs[regno][mode] - > hard_regno_nregs[regno][vd->e[regno].mode]) - goto no_move_special_case; - } - - /* If the destination is also a register, try to find a source - register in the same class. */ - if (REG_P (SET_DEST (set))) - { - new_rtx = find_oldest_value_reg (REGNO_REG_CLASS (regno), src, vd); - if (new_rtx && validate_change (insn, &SET_SRC (set), new_rtx, 0)) - { - if (dump_file) - fprintf (dump_file, - "insn %u: replaced reg %u with %u\n", - INSN_UID (insn), regno, REGNO (new_rtx)); - changed = true; - goto did_replacement; - } - } - - /* Otherwise, try all valid registers and see if its valid. */ - for (i = vd->e[regno].oldest_regno; i != regno; - i = vd->e[i].next_regno) - { - new_rtx = maybe_mode_change (vd->e[i].mode, vd->e[regno].mode, - mode, i, regno); - if (new_rtx != NULL_RTX) - { - if (validate_change (insn, &SET_SRC (set), new_rtx, 0)) - { - ORIGINAL_REGNO (new_rtx) = ORIGINAL_REGNO (src); - REG_ATTRS (new_rtx) = REG_ATTRS (src); - REG_POINTER (new_rtx) = REG_POINTER (src); - if (dump_file) - fprintf (dump_file, - "insn %u: replaced reg %u with %u\n", - INSN_UID (insn), regno, REGNO (new_rtx)); - changed = true; - goto did_replacement; - } - } - } - } - no_move_special_case: - - any_replacements = false; - - /* For each input operand, replace a hard register with the - eldest live copy that's in an appropriate register class. */ - for (i = 0; i < n_ops; i++) - { - replaced[i] = false; - - /* Don't scan match_operand here, since we've no reg class - information to pass down. Any operands that we could - substitute in will be represented elsewhere. */ - if (recog_data.constraints[i][0] == '\0') - continue; - - /* Don't replace in asms intentionally referencing hard regs. */ - if (is_asm && REG_P (recog_data.operand[i]) - && (REGNO (recog_data.operand[i]) - == ORIGINAL_REGNO (recog_data.operand[i]))) - continue; - - if (recog_data.operand_type[i] == OP_IN) - { - if (recog_op_alt[i][alt].is_address) - replaced[i] - = replace_oldest_value_addr (recog_data.operand_loc[i], - recog_op_alt[i][alt].cl, - VOIDmode, insn, vd); - else if (REG_P (recog_data.operand[i])) - replaced[i] - = replace_oldest_value_reg (recog_data.operand_loc[i], - recog_op_alt[i][alt].cl, - insn, vd); - else if (MEM_P (recog_data.operand[i])) - replaced[i] = replace_oldest_value_mem (recog_data.operand[i], - insn, vd); - } - else if (MEM_P (recog_data.operand[i])) - replaced[i] = replace_oldest_value_mem (recog_data.operand[i], - insn, vd); - - /* If we performed any replacement, update match_dups. */ - if (replaced[i]) - { - int j; - rtx new_rtx; - - new_rtx = *recog_data.operand_loc[i]; - recog_data.operand[i] = new_rtx; - for (j = 0; j < recog_data.n_dups; j++) - if (recog_data.dup_num[j] == i) - validate_unshare_change (insn, recog_data.dup_loc[j], new_rtx, 1); - - any_replacements = true; - } - } - - if (any_replacements) - { - if (! apply_change_group ()) - { - for (i = 0; i < n_ops; i++) - if (replaced[i]) - { - rtx old = *recog_data.operand_loc[i]; - recog_data.operand[i] = old; - } - - if (dump_file) - fprintf (dump_file, - "insn %u: reg replacements not verified\n", - INSN_UID (insn)); - } - else - changed = true; - } - - did_replacement: - /* Clobber call-clobbered registers. */ - if (CALL_P (insn)) - for (i = 0; i < FIRST_PSEUDO_REGISTER; i++) - if (TEST_HARD_REG_BIT (regs_invalidated_by_call, i)) - kill_value_regno (i, 1, vd); - - /* Notice stores. */ - note_stores (PATTERN (insn), kill_set_value, vd); - - /* Notice copies. */ - if (set && REG_P (SET_DEST (set)) && REG_P (SET_SRC (set))) - copy_value (SET_DEST (set), SET_SRC (set), vd); - - if (insn == BB_END (bb)) - break; - } - - return changed; -} - -/* Main entry point for the forward copy propagation optimization. */ - -static void -copyprop_hardreg_forward (void) -{ - struct value_data *all_vd; - basic_block bb; - sbitmap visited; - - all_vd = XNEWVEC (struct value_data, last_basic_block); - - visited = sbitmap_alloc (last_basic_block); - sbitmap_zero (visited); - - FOR_EACH_BB (bb) - { - SET_BIT (visited, bb->index); - - /* If a block has a single predecessor, that we've already - processed, begin with the value data that was live at - the end of the predecessor block. */ - /* ??? Ought to use more intelligent queuing of blocks. */ - if (single_pred_p (bb) - && TEST_BIT (visited, single_pred (bb)->index) - && ! (single_pred_edge (bb)->flags & (EDGE_ABNORMAL_CALL | EDGE_EH))) - all_vd[bb->index] = all_vd[single_pred (bb)->index]; - else - init_value_data (all_vd + bb->index); - - copyprop_hardreg_forward_1 (bb, all_vd + bb->index); - } - - sbitmap_free (visited); - free (all_vd); -} - -/* Dump the value chain data to stderr. */ - -void -debug_value_data (struct value_data *vd) -{ - HARD_REG_SET set; - unsigned int i, j; - - CLEAR_HARD_REG_SET (set); - - for (i = 0; i < FIRST_PSEUDO_REGISTER; ++i) - if (vd->e[i].oldest_regno == i) - { - if (vd->e[i].mode == VOIDmode) - { - if (vd->e[i].next_regno != INVALID_REGNUM) - fprintf (stderr, "[%u] Bad next_regno for empty chain (%u)\n", - i, vd->e[i].next_regno); - continue; - } - - SET_HARD_REG_BIT (set, i); - fprintf (stderr, "[%u %s] ", i, GET_MODE_NAME (vd->e[i].mode)); - - for (j = vd->e[i].next_regno; - j != INVALID_REGNUM; - j = vd->e[j].next_regno) - { - if (TEST_HARD_REG_BIT (set, j)) - { - fprintf (stderr, "[%u] Loop in regno chain\n", j); - return; - } - - if (vd->e[j].oldest_regno != i) - { - fprintf (stderr, "[%u] Bad oldest_regno (%u)\n", - j, vd->e[j].oldest_regno); - return; - } - SET_HARD_REG_BIT (set, j); - fprintf (stderr, "[%u %s] ", j, GET_MODE_NAME (vd->e[j].mode)); - } - fputc ('\n', stderr); - } - - for (i = 0; i < FIRST_PSEUDO_REGISTER; ++i) - if (! TEST_HARD_REG_BIT (set, i) - && (vd->e[i].mode != VOIDmode - || vd->e[i].oldest_regno != i - || vd->e[i].next_regno != INVALID_REGNUM)) - fprintf (stderr, "[%u] Non-empty reg in chain (%s %u %i)\n", - i, GET_MODE_NAME (vd->e[i].mode), vd->e[i].oldest_regno, - vd->e[i].next_regno); -} - -#ifdef ENABLE_CHECKING -static void -validate_value_data (struct value_data *vd) -{ - HARD_REG_SET set; - unsigned int i, j; - - CLEAR_HARD_REG_SET (set); - - for (i = 0; i < FIRST_PSEUDO_REGISTER; ++i) - if (vd->e[i].oldest_regno == i) - { - if (vd->e[i].mode == VOIDmode) - { - if (vd->e[i].next_regno != INVALID_REGNUM) - internal_error ("validate_value_data: [%u] Bad next_regno for empty chain (%u)", - i, vd->e[i].next_regno); - continue; - } - - SET_HARD_REG_BIT (set, i); - - for (j = vd->e[i].next_regno; - j != INVALID_REGNUM; - j = vd->e[j].next_regno) - { - if (TEST_HARD_REG_BIT (set, j)) - internal_error ("validate_value_data: Loop in regno chain (%u)", - j); - if (vd->e[j].oldest_regno != i) - internal_error ("validate_value_data: [%u] Bad oldest_regno (%u)", - j, vd->e[j].oldest_regno); - - SET_HARD_REG_BIT (set, j); - } - } - - for (i = 0; i < FIRST_PSEUDO_REGISTER; ++i) - if (! TEST_HARD_REG_BIT (set, i) - && (vd->e[i].mode != VOIDmode - || vd->e[i].oldest_regno != i - || vd->e[i].next_regno != INVALID_REGNUM)) - internal_error ("validate_value_data: [%u] Non-empty reg in chain (%s %u %i)", - i, GET_MODE_NAME (vd->e[i].mode), vd->e[i].oldest_regno, - vd->e[i].next_regno); -} -#endif static bool gate_handle_regrename (void) @@ -1943,22 +1009,13 @@ gate_handle_regrename (void) return (optimize > 0 && (flag_rename_registers)); } - -/* Run the regrename and cprop passes. */ -static unsigned int -rest_of_handle_regrename (void) -{ - regrename_optimize (); - return 0; -} - struct rtl_opt_pass pass_regrename = { { RTL_PASS, "rnreg", /* name */ gate_handle_regrename, /* gate */ - rest_of_handle_regrename, /* execute */ + regrename_optimize, /* execute */ NULL, /* sub */ NULL, /* next */ 0, /* static_pass_number */ @@ -1972,36 +1029,3 @@ struct rtl_opt_pass pass_regrename = } }; -static bool -gate_handle_cprop (void) -{ - return (optimize > 0 && (flag_cprop_registers)); -} - - -/* Run the regrename and cprop passes. */ -static unsigned int -rest_of_handle_cprop (void) -{ - copyprop_hardreg_forward (); - return 0; -} - -struct rtl_opt_pass pass_cprop_hardreg = -{ - { - RTL_PASS, - "cprop_hardreg", /* name */ - gate_handle_cprop, /* gate */ - rest_of_handle_cprop, /* execute */ - NULL, /* sub */ - NULL, /* next */ - 0, /* static_pass_number */ - TV_RENAME_REGISTERS, /* tv_id */ - 0, /* properties_required */ - 0, /* properties_provided */ - 0, /* properties_destroyed */ - 0, /* todo_flags_start */ - TODO_dump_func | TODO_verify_rtl_sharing /* todo_flags_finish */ - } -}; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 880a5d4d670..2dc3dd9e3e9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,94 @@ +2009-05-07 Janis Johnson <janis187@us.ibm.com> + + PR c/39037 + * gcc.dg/Wunsuffixed-float-constants-1.c: New test. + * gcc.dg/cpp/pragma-float-const-decimal64-1.c: New test. + * gcc.dg/dfp/float-constant-double.c: New test. + * gcc.dg/dfp/pragma-float-const-decimal64-1.c: New test. + * gcc.dg/dfp/pragma-float-const-decimal64-2.c: New test. + * gcc.dg/dfp/pragma-float-const-decimal64-3.c: New test. + * gcc.dg/dfp/pragma-float-const-decimal64-4.c: New test. + * gcc.dg/dfp/pragma-float-const-decimal64-5.c: New test. + * gcc.dg/dfp/pragma-float-const-decimal64-6.c: New test. + * gcc.dg/dfp/pragma-float-const-decimal64-7.c: New test. + * gcc.dg/dfp/pragma-float-const-decimal64-8.c: New test. + * g++.dg/cpp/pragma-float-const-decimal64-1.C: New test. + +2009-05-07 Jakub Jelinek <jakub@redhat.com> + + PR middle-end/40057 + * gcc.c-torture/execute/pr40057.c: New test. + +2009-05-06 James E. Wilson <wilson@codesourcery.com> + + * gcc.c-torture/compile/const-high-part.c: New test. + +2009-05-06 H.J. Lu <hongjiu.lu@intel.com> + + PR testsuite/40050 + * lib/plugin-support.exp (plugin-test-execute): Use HOSTCC to + build plugin. + +2009-05-06 Janus Weil <janus@gcc.gnu.org> + + PR fortran/39630 + * gfortran.dg/proc_decl_1.f90: Modified. + * gfortran.dg/proc_ptr_comp_1.f90: New. + * gfortran.dg/proc_ptr_comp_2.f90: New. + * gfortran.dg/proc_ptr_comp_3.f90: New. + * gfortran.dg/proc_ptr_comp_4.f90: New. + * gfortran.dg/proc_ptr_comp_5.f90: New. + * gfortran.dg/proc_ptr_comp_6.f90: New. + +2009-05-06 Dodji Seketeli <dodji@redhat.com> + + PR c++/17395 + * g++.dg/template/call7.C: New test. + +2009-05-06 Diego Novillo <dnovillo@google.com> + + * lib/plugin-support.exp: Do not prefix $GMPINC with -I. + +2009-05-06 H.J. Lu <hongjiu.lu@intel.com> + + * gfortran.dg/pr40021.f: Moved to ... + * gfortran.fortran-torture/execute/pr40021.f: Here. + +2009-05-06 Janis Johnson <janis187@us.ibm.com> + + PR middle-end/39986 + * gcc.dg/dfp/pr39986.c: New test. + +2009-05-06 Michael Matz <matz@suse.de> + + PR middle-end/40021 + * gfortran.dg/pr40021.f: New test. + +2009-05-06 Le-Chun Wu <lcwu@google.com> + + * lib/plugin-support.exp: New file containing support procs for + plugin testcases. + * lib/target-supports.exp (check_plugin_available): New proc. + * gcc.dg/plugin/plugin.exp: New driver script for gcc testcases. + * gcc.dg/plugin/selfassign.c: New plugin source file. + * gcc.dg/plugin/self-assign-test-1.c: New test. + * gcc.dg/plugin/self-assign-test-2.c: Likewise. + * g++.dg/README: Add description for plugin test. + * g++.dg/dg.exp: Exclude plugin tests from the general test list. + * g++.dg/plugin/plugin.exp: New driver script for g++ testcases. + * g++.dg/plugin/selfassign.c: New plugin source file. + * g++.dg/plugin/self-assign-test-1.C: New test. + * g++.dg/plugin/self-assign-test-2.C: Likewise. + * g++.dg/plugin/self-assign-test-3.C: Likewise. + * g++.dg/plugin/dumb_plugin.c: New plugin source file. + * g++.dg/plugin/dumb-plugin-test-1.C: New test. + +2009-05-06 Tobias Burnus <burnus@net-b.de> + + PR fortran/40041 + * gfortran.dg/intrinsic_2.f90: New test. + * gfortran.dg/intrinsic.f90: Add old and this PR as comment. + 2009-05-06 Joseph Myers <joseph@codesourcery.com> PR c/40032 @@ -47,13 +138,11 @@ 2009-05-04 Joseph Myers <joseph@codesourcery.com> - * gcc.dg/ucnid-11.c, gcc.dg/ucnid-12.c, gcc.dg/ucnid-13.c: New - tests. + * gcc.dg/ucnid-11.c, gcc.dg/ucnid-12.c, gcc.dg/ucnid-13.c: New tests. 2009-05-04 Joseph Myers <joseph@codesourcery.com> - * gcc.dg/ucnid-8.c, gcc.dg/ucnid-9.c, gcc.dg/ucnid-10.c: New - tests. + * gcc.dg/ucnid-8.c, gcc.dg/ucnid-9.c, gcc.dg/ucnid-10.c: New tests. * gcc.dg/declspec-9.c, gcc.dg/declspec-10.c, gcc.dg/declspec-11.c: Update expected errors. diff --git a/gcc/testsuite/g++.dg/README b/gcc/testsuite/g++.dg/README index c63f7ccf53c..cdf6b14aee6 100644 --- a/gcc/testsuite/g++.dg/README +++ b/gcc/testsuite/g++.dg/README @@ -18,6 +18,7 @@ opt Tests for fixes of bugs with particular optimizations. overload Tests for overload resolution and conversions. parse Tests for parsing. pch Tests for precompiled headers. +plugin Tests for plugin support. rtti Tests for run-time type identification (typeid, dynamic_cast, etc.) template Tests for templates. tc1 Tests for Technical Corrigendum 1 conformance. diff --git a/gcc/testsuite/g++.dg/cpp/pragma-float-const-decimal64-1.C b/gcc/testsuite/g++.dg/cpp/pragma-float-const-decimal64-1.C new file mode 100644 index 00000000000..31e1ad6d507 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp/pragma-float-const-decimal64-1.C @@ -0,0 +1,5 @@ +// { dg-do compile } +// { dg-options "-Wunknown-pragmas" } + +#pragma STDC FLOAT_CONST_DECIMAL64 ON // { dg-warning "not supported for C\\\+\\\+" } +double d = 1.0; diff --git a/gcc/testsuite/g++.dg/dg.exp b/gcc/testsuite/g++.dg/dg.exp index 86565a98a1e..a19bc2c2b60 100644 --- a/gcc/testsuite/g++.dg/dg.exp +++ b/gcc/testsuite/g++.dg/dg.exp @@ -37,6 +37,7 @@ set tests [prune $tests $srcdir/$subdir/compat/*] set tests [prune $tests $srcdir/$subdir/debug/*] set tests [prune $tests $srcdir/$subdir/gcov/*] set tests [prune $tests $srcdir/$subdir/pch/*] +set tests [prune $tests $srcdir/$subdir/plugin/*] set tests [prune $tests $srcdir/$subdir/special/*] set tests [prune $tests $srcdir/$subdir/tls/*] set tests [prune $tests $srcdir/$subdir/vect/*] diff --git a/gcc/testsuite/g++.dg/plugin/dumb-plugin-test-1.C b/gcc/testsuite/g++.dg/plugin/dumb-plugin-test-1.C new file mode 100644 index 00000000000..70101c86826 --- /dev/null +++ b/gcc/testsuite/g++.dg/plugin/dumb-plugin-test-1.C @@ -0,0 +1,53 @@ +// Test case for the dumb plugin. +// { dg-do compile } +// { dg-options "-O -fplugin-arg-dumb_plugin-ref-pass-name=ccp -fplugin-arg-dumb_plugin-ref-pass-instance-num=1" } + +class Foo { + private: + int a_; + + public: + Foo() : a_(a_) {} // { dg-warning "Before genericizing function" } + + void setA(int a) { + a_ = a_; + } // { dg-warning "Before genericizing function" } + + void operator=(Foo& rhs) { + this->a_ = rhs.a_; + } // { dg-warning "Before genericizing function" } +}; // { dg-warning "Process struct Foo" } + +struct Bar { + int b_; + int c_; +}; // { dg-warning "Process struct Bar" } + +int g = g; +Foo foo = foo; + +int func() +{ + Bar *bar1, bar2; + Foo local_foo; + int x = x; + static int y = y; + float *f; + Bar bar_array[5]; + char n; + int overflow; + + *f = *f; + bar1->b_ = bar1->b_; + bar2.c_ = bar2.c_; + local_foo = local_foo; + foo = foo; + foo.setA(5); + bar_array[3].c_ = bar_array[3].c_; + bar_array[x+g].b_ = bar_array[x+g].b_; + y = x; + x = y; +} // { dg-warning "Before genericizing function" } + +// { dg-warning "Analyze function" "" { target *-*-* } 50 } +// { dg-warning "End of compilation unit" "" { target *-*-* } 50 } diff --git a/gcc/testsuite/g++.dg/plugin/dumb_plugin.c b/gcc/testsuite/g++.dg/plugin/dumb_plugin.c new file mode 100644 index 00000000000..0c62f89e109 --- /dev/null +++ b/gcc/testsuite/g++.dg/plugin/dumb_plugin.c @@ -0,0 +1,136 @@ +/* A trivial (dumb) plugin example that shows how to use the GCC plugin + mechanism. */ + +#include <stdlib.h> +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tree.h" +#include "tree-pass.h" +#include "intl.h" +#include "gcc-plugin.h" + + +/* Callback function to invoke after GCC finishes parsing a struct. */ + +void +handle_struct (void *event_data, void *data) +{ + tree type = (tree) event_data; + warning (0, G_("Process struct %s"), + IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (type)))); +} + +/* Callback function to invoke before the program is genericized. */ + +void +handle_pre_generic (void *event_data, void *data) +{ + tree fndecl = (tree) event_data; + warning (0, G_("Before genericizing function %s"), + IDENTIFIER_POINTER (DECL_NAME (fndecl))); +} + +/* Callback function to invoke after GCC finishes the compilation unit. */ + +void +handle_end_of_compilation_unit (void *event_data, void *data) +{ + warning (0, G_("End of compilation unit")); +} + + +static unsigned int +execute_dumb_plugin_example (void) +{ + warning (0, G_("Analyze function %s"), + IDENTIFIER_POINTER (DECL_NAME (current_function_decl))); + return 0; +} + +static bool +gate_dumb_plugin_example (void) +{ + return true; +} + +static struct gimple_opt_pass pass_dumb_plugin_example = +{ + { + GIMPLE_PASS, + "dumb_plugin_example", /* name */ + gate_dumb_plugin_example, /* gate */ + execute_dumb_plugin_example, /* execute */ + NULL, /* sub */ + NULL, /* next */ + 0, /* static_pass_number */ + 0, /* tv_id */ + PROP_cfg, /* properties_required */ + 0, /* properties_provided */ + 0, /* properties_destroyed */ + 0, /* todo_flags_start */ + TODO_dump_func /* todo_flags_finish */ + } +}; + +/* Initialization function that GCC calls. This plugin takes an argument + that specifies the name of the reference pass and an instance number, + both of which determine where the plugin pass should be inserted. */ + +int +plugin_init (const char *plugin_name, + struct plugin_gcc_version *version __attribute__((unused)), + int argc, struct plugin_argument *argv) +{ + struct plugin_pass pass_info; + char *ref_pass_name = NULL; + int ref_instance_number = 0; + int i; + + /* Process the plugin arguments. This plugin takes the following arguments: + ref-pass-name=<PASS_NAME> and ref-pass-instance-num=<NUM>. */ + for (i = 0; i < argc; ++i) + { + if (!strcmp (argv[i].key, "ref-pass-name")) + { + if (argv[i].value) + ref_pass_name = argv[i].value; + else + warning (0, G_("option '-fplugin-arg-%s-ref-pass-name'" + " requires a pass name"), plugin_name); + } + else if (!strcmp (argv[i].key, "ref-pass-instance-num")) + { + if (argv[i].value) + ref_instance_number = strtol (argv[i].value, NULL, 0); + else + warning (0, G_("option '-fplugin-arg-%s-ref-pass-instance-num'" + " requires an integer value"), plugin_name); + } + else + warning (0, G_("plugin %qs: unrecognized argument %qs ignored"), + plugin_name, argv[i].key); + } + + if (!ref_pass_name) + { + error (G_("plugin %qs requires a reference pass name"), plugin_name); + return 1; + } + + pass_info.pass = &pass_dumb_plugin_example.pass; + pass_info.reference_pass_name = ref_pass_name; + pass_info.ref_pass_instance_number = ref_instance_number; + pass_info.pos_op = PASS_POS_INSERT_AFTER; + + register_callback (plugin_name, PLUGIN_PASS_MANAGER_SETUP, NULL, &pass_info); + + register_callback (plugin_name, PLUGIN_FINISH_TYPE, handle_struct, NULL); + + register_callback (plugin_name, PLUGIN_CXX_CP_PRE_GENERICIZE, + handle_pre_generic, NULL); + + register_callback (plugin_name, PLUGIN_FINISH_UNIT, + handle_end_of_compilation_unit, NULL); + return 0; +} diff --git a/gcc/testsuite/g++.dg/plugin/plugin.exp b/gcc/testsuite/g++.dg/plugin/plugin.exp new file mode 100644 index 00000000000..e1f6d89ae28 --- /dev/null +++ b/gcc/testsuite/g++.dg/plugin/plugin.exp @@ -0,0 +1,66 @@ +# Copyright (C) 2009 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/>. + +# Test the functionality of the GCC plugin support + +load_lib target-supports.exp +load_lib g++-dg.exp + +global TESTING_IN_BUILD_TREE +global ENABLE_PLUGIN + +# The plugin testcases currently only work when the build tree is available. +# Also check whether the host supports plugins. +if { ![info exists TESTING_IN_BUILD_TREE] || ![info exists ENABLE_PLUGIN] } { + return +} + +# If a testcase doesn't have special options, use these. +global DEFAULT_CXXFLAGS +if ![info exists DEFAULT_CXXFLAGS] then { + set DEFAULT_CXXFLAGS " -ansi -pedantic-errors -Wno-long-long" +} + +# The procedures in plugin-support.exp need these parameters. +set default_flags $DEFAULT_CXXFLAGS + +if $tracelevel then { + strace $tracelevel +} + +# Load support procs. +load_lib plugin-support.exp + +# Specify the plugin source file and the associated test files in a list. +# plugin_test_list={ {plugin1 test1 test2 ...} {plugin2 test1 ...} ... } +set plugin_test_list [list \ + { selfassign.c self-assign-test-1.C self-assign-test-2.C self-assign-test-3.C } \ + { dumb_plugin.c dumb-plugin-test-1.C } ] + +foreach plugin_test $plugin_test_list { + # Replace each source file with its full-path name + for {set i 0} {$i < [llength $plugin_test]} {incr i} { + set basename [lindex $plugin_test $i] + set plugin_test [lreplace $plugin_test $i $i $srcdir/$subdir/$basename] + } + set plugin_src [lindex $plugin_test 0] + # If we're only testing specific files and this isn't one of them, skip it. + if ![runtest_file_p $runtests $plugin_src] then { + continue + } + set plugin_input_tests [lreplace $plugin_test 0 0] + plugin-test-execute $plugin_src $plugin_input_tests +} diff --git a/gcc/testsuite/g++.dg/plugin/self-assign-test-1.C b/gcc/testsuite/g++.dg/plugin/self-assign-test-1.C new file mode 100644 index 00000000000..607381fb403 --- /dev/null +++ b/gcc/testsuite/g++.dg/plugin/self-assign-test-1.C @@ -0,0 +1,50 @@ +// Test the self-assignemnt detection plugin. +// { dg-do compile } +// { dg-options "-O" } + +class Foo { + private: + int a_; + + public: + Foo() : a_(a_) {} // { dg-warning "assigned to itself" } + + void setA(int a) { + a_ = a_; // { dg-warning "assigned to itself" } + } + + void operator=(Foo& rhs) { + this->a_ = rhs.a_; + } +}; + +struct Bar { + int b_; + int c_; +}; + +int g = g; // { dg-warning "assigned to itself" } +Foo foo = foo; // { dg-warning "assigned to itself" } + +int func() +{ + Bar *bar1, bar2; + Foo local_foo; + int x = x; // { dg-warning "assigned to itself" } + static int y = y; // { dg-warning "assigned to itself" } + float *f; + Bar bar_array[5]; + char n; + int overflow; + + *f = *f; // { dg-warning "assigned to itself" } + bar1->b_ = bar1->b_; // { dg-warning "assigned to itself" } + bar2.c_ = bar2.c_; // { dg-warning "assigned to itself" } + local_foo = local_foo; // { dg-warning "assigned to itself" } + foo = foo; // { dg-warning "assigned to itself" } + foo.setA(5); + bar_array[3].c_ = bar_array[3].c_; // { dg-warning "assigned to itself" } + bar_array[x+g].b_ = bar_array[x+g].b_; // { dg-warning "self-assignment detected" } + y = x; + x = y; +} diff --git a/gcc/testsuite/g++.dg/plugin/self-assign-test-2.C b/gcc/testsuite/g++.dg/plugin/self-assign-test-2.C new file mode 100644 index 00000000000..35e1fb8f893 --- /dev/null +++ b/gcc/testsuite/g++.dg/plugin/self-assign-test-2.C @@ -0,0 +1,50 @@ +// Test the self-assignemnt detection plugin without checking of operator-eq. +// { dg-do compile } +// { dg-options "-O -fplugin-arg-selfassign-no-check-operator-eq" } + +class Foo { + private: + int a_; + + public: + Foo() : a_(a_) {} // { dg-warning "assigned to itself" } + + void setA(int a) { + a_ = a_; // { dg-warning "assigned to itself" } + } + + void operator=(Foo& rhs) { + this->a_ = rhs.a_; + } +}; + +struct Bar { + int b_; + int c_; +}; + +int g = g; // { dg-warning "assigned to itself" } +Foo foo = foo; // { dg-warning "assigned to itself" } + +int func() +{ + Bar *bar1, bar2; + Foo local_foo; + int x = x; // { dg-warning "assigned to itself" } + static int y = y; // { dg-warning "assigned to itself" } + float *f; + Bar bar_array[5]; + char n; + int overflow; + + *f = *f; // { dg-warning "assigned to itself" } + bar1->b_ = bar1->b_; // { dg-warning "assigned to itself" } + bar2.c_ = bar2.c_; // { dg-warning "assigned to itself" } + local_foo = local_foo; // { dg-bogus "assigned to itself" } + foo = foo; // { dg-bogus "assigned to itself" } + foo.setA(5); + bar_array[3].c_ = bar_array[3].c_; // { dg-warning "assigned to itself" } + bar_array[x+g].b_ = bar_array[x+g].b_; // { dg-warning "self-assignment detected" } + y = x; + x = y; +} diff --git a/gcc/testsuite/g++.dg/plugin/self-assign-test-3.C b/gcc/testsuite/g++.dg/plugin/self-assign-test-3.C new file mode 100644 index 00000000000..e5b354baff2 --- /dev/null +++ b/gcc/testsuite/g++.dg/plugin/self-assign-test-3.C @@ -0,0 +1,50 @@ +// Test the self-assignemnt detection plugin with the 'disable' argument. +// { dg-do compile } +// { dg-options "-O -fplugin-arg-selfassign-disable" } + +class Foo { + private: + int a_; + + public: + Foo() : a_(a_) {} // { dg-bogus "assigned to itself" } + + void setA(int a) { + a_ = a_; // { dg-bogus "assigned to itself" } + } + + void operator=(Foo& rhs) { + this->a_ = rhs.a_; + } +}; + +struct Bar { + int b_; + int c_; +}; + +int g = g; // { dg-bogus "assigned to itself" } +Foo foo = foo; // { dg-bogus "assigned to itself" } + +int func() +{ + Bar *bar1, bar2; + Foo local_foo; + int x = x; // { dg-bogus "assigned to itself" } + static int y = y; // { dg-bogus "assigned to itself" } + float *f; + Bar bar_array[5]; + char n; + int overflow; + + *f = *f; // { dg-bogus "assigned to itself" } + bar1->b_ = bar1->b_; // { dg-bogus "assigned to itself" } + bar2.c_ = bar2.c_; // { dg-bogus "assigned to itself" } + local_foo = local_foo; // { dg-bogus "assigned to itself" } + foo = foo; // { dg-bogus "assigned to itself" } + foo.setA(5); + bar_array[3].c_ = bar_array[3].c_; // { dg-bogus "assigned to itself" } + bar_array[x+g].b_ = bar_array[x+g].b_; // { dg-bogus "self-assignment detected" } + y = x; + x = y; +} diff --git a/gcc/testsuite/g++.dg/plugin/selfassign.c b/gcc/testsuite/g++.dg/plugin/selfassign.c new file mode 100644 index 00000000000..6fbce83c01d --- /dev/null +++ b/gcc/testsuite/g++.dg/plugin/selfassign.c @@ -0,0 +1,365 @@ +/* This plugin contains an analysis pass that detects and warns about + self-assignment statements. */ +/* { dg-options "-O" } */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tm.h" +#include "toplev.h" +#include "basic-block.h" +#include "gimple.h" +#include "tree.h" +#include "tree-pass.h" +#include "intl.h" +#include "gcc-plugin.h" + + +/* Indicate whether to check overloaded operator '=', which is performed by + default. To disable it, use -fplugin-arg-NAME-no-check-operator-eq. */ +bool check_operator_eq = true; + +/* Given a rhs EXPR of a gimple assign statement, if it is + - SSA_NAME : returns its var decl, or, if it is a temp variable, + returns the rhs of its SSA def statement. + - VAR_DECL, PARM_DECL, FIELD_DECL, or a reference expression : + returns EXPR itself. + - any other expression : returns NULL_TREE. */ + +static tree +get_real_ref_rhs (tree expr) +{ + switch (TREE_CODE (expr)) + { + case SSA_NAME: + { + /* Given a self-assign statement, say foo.x = foo.x, + the IR (after SSA) looks like: + + D.1797_14 = foo.x; + foo.x ={v} D.1797_14; + + So if the rhs EXPR is an SSA_NAME of a temp variable, + e.g. D.1797_14, we need to grab the rhs of its SSA def + statement (i.e. foo.x). */ + tree vdecl = SSA_NAME_VAR (expr); + if (DECL_ARTIFICIAL (vdecl) + && !gimple_nop_p (SSA_NAME_DEF_STMT (expr))) + { + gimple def_stmt = SSA_NAME_DEF_STMT (expr); + /* We are only interested in an assignment with a single + rhs operand because if it is not, the original assignment + will not possibly be a self-assignment. */ + if (is_gimple_assign (def_stmt) + && (get_gimple_rhs_class (gimple_assign_rhs_code (def_stmt)) + == GIMPLE_SINGLE_RHS)) + return get_real_ref_rhs (gimple_assign_rhs1 (def_stmt)); + else + return NULL_TREE; + } + else + return vdecl; + } + case VAR_DECL: + case PARM_DECL: + case FIELD_DECL: + case COMPONENT_REF: + case INDIRECT_REF: + case ARRAY_REF: + return expr; + default: + return NULL_TREE; + } +} + +/* Given an expression tree, EXPR, that may contains SSA names, returns an + equivalent tree with the SSA names converted to var/parm/field decls + so that it can be used with '%E' format modifier when emitting warning + messages. + + This function currently only supports VAR/PARM/FIELD_DECL, reference + expressions (COMPONENT_REF, INDIRECT_REF, ARRAY_REF), integer constant, + and SSA_NAME. If EXPR contains any other tree nodes (e.g. an arithmetic + expression appears in array index), NULL_TREE is returned. */ + +static tree +get_non_ssa_expr (tree expr) +{ + switch (TREE_CODE (expr)) + { + case VAR_DECL: + case PARM_DECL: + case FIELD_DECL: + { + if (DECL_NAME (expr)) + return expr; + else + return NULL_TREE; + } + case COMPONENT_REF: + { + tree base, orig_base = TREE_OPERAND (expr, 0); + tree component, orig_component = TREE_OPERAND (expr, 1); + base = get_non_ssa_expr (orig_base); + if (!base) + return NULL_TREE; + component = get_non_ssa_expr (orig_component); + if (!component) + return NULL_TREE; + /* If either BASE or COMPONENT is converted, build a new + component reference tree. */ + if (base != orig_base || component != orig_component) + return build3 (COMPONENT_REF, TREE_TYPE (component), + base, component, NULL_TREE); + else + return expr; + } + case INDIRECT_REF: + { + tree orig_base = TREE_OPERAND (expr, 0); + tree base = get_non_ssa_expr (orig_base); + if (!base) + return NULL_TREE; + /* If BASE is converted, build a new indirect reference tree. */ + if (base != orig_base) + return build1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (base)), base); + else + return expr; + } + case ARRAY_REF: + { + tree array, orig_array = TREE_OPERAND (expr, 0); + tree index, orig_index = TREE_OPERAND (expr, 1); + array = get_non_ssa_expr (orig_array); + if (!array) + return NULL_TREE; + index = get_non_ssa_expr (orig_index); + if (!index) + return NULL_TREE; + /* If either ARRAY or INDEX is converted, build a new array + reference tree. */ + if (array != orig_array || index != orig_index) + return build4 (ARRAY_REF, TREE_TYPE (expr), array, index, + TREE_OPERAND (expr, 2), TREE_OPERAND (expr, 3)); + else + return expr; + } + case SSA_NAME: + { + tree vdecl = SSA_NAME_VAR (expr); + if (DECL_ARTIFICIAL (vdecl) + && !gimple_nop_p (SSA_NAME_DEF_STMT (expr))) + { + gimple def_stmt = SSA_NAME_DEF_STMT (expr); + if (is_gimple_assign (def_stmt) + && (get_gimple_rhs_class (gimple_assign_rhs_code (def_stmt)) + == GIMPLE_SINGLE_RHS)) + vdecl = gimple_assign_rhs1 (def_stmt); + } + return get_non_ssa_expr (vdecl); + } + case INTEGER_CST: + return expr; + default: + /* Return NULL_TREE for any other kind of tree nodes. */ + return NULL_TREE; + } +} + +/* Given the LHS and (real) RHS of a gimple assign statement, STMT, check if + they are the same. If so, print a warning message about self-assignment. */ + +static void +compare_and_warn (gimple stmt, tree lhs, tree rhs) +{ + if (operand_equal_p (lhs, rhs, OEP_PURE_SAME)) + { + location_t location; + location = (gimple_has_location (stmt) + ? gimple_location (stmt) + : (DECL_P (lhs) + ? DECL_SOURCE_LOCATION (lhs) + : input_location)); + /* If LHS contains any tree node not currently supported by + get_non_ssa_expr, simply emit a generic warning without + specifying LHS in the message. */ + lhs = get_non_ssa_expr (lhs); + if (lhs) + warning (0, G_("%H%qE is assigned to itself"), &location, lhs); + else + warning (0, G_("%Hself-assignment detected"), &location); + } +} + +/* Check and warn if STMT is a self-assign statement. */ + +static void +warn_self_assign (gimple stmt) +{ + tree rhs, lhs; + + /* Check assigment statement. */ + if (is_gimple_assign (stmt) + && (get_gimple_rhs_class (gimple_assign_rhs_code (stmt)) + == GIMPLE_SINGLE_RHS)) + { + rhs = get_real_ref_rhs (gimple_assign_rhs1 (stmt)); + if (!rhs) + return; + + lhs = gimple_assign_lhs (stmt); + if (TREE_CODE (lhs) == SSA_NAME) + { + lhs = SSA_NAME_VAR (lhs); + if (DECL_ARTIFICIAL (lhs)) + return; + } + + compare_and_warn (stmt, lhs, rhs); + } + /* Check overloaded operator '=' (if enabled). */ + else if (check_operator_eq && is_gimple_call (stmt)) + { + tree fdecl = gimple_call_fndecl (stmt); + if (fdecl && (DECL_NAME (fdecl) == maybe_get_identifier ("operator="))) + { + /* If 'operator=' takes reference operands, the arguments will be + ADDR_EXPR trees. In this case, just remove the address-taken + operator before we compare the lhs and rhs. */ + lhs = gimple_call_arg (stmt, 0); + if (TREE_CODE (lhs) == ADDR_EXPR) + lhs = TREE_OPERAND (lhs, 0); + rhs = gimple_call_arg (stmt, 1); + if (TREE_CODE (rhs) == ADDR_EXPR) + rhs = TREE_OPERAND (rhs, 0); + + compare_and_warn (stmt, lhs, rhs); + } + } +} + +/* Entry point for the self-assignment detection pass. */ + +static unsigned int +execute_warn_self_assign (void) +{ + gimple_stmt_iterator gsi; + basic_block bb; + + FOR_EACH_BB (bb) + { + for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) + warn_self_assign (gsi_stmt (gsi)); + } + + return 0; +} + +/* Pass gate function. Currently always returns true. */ + +static bool +gate_warn_self_assign (void) +{ + return true; +} + +static struct gimple_opt_pass pass_warn_self_assign = +{ + { + GIMPLE_PASS, + "warn_self_assign", /* name */ + gate_warn_self_assign, /* gate */ + execute_warn_self_assign, /* execute */ + NULL, /* sub */ + NULL, /* next */ + 0, /* static_pass_number */ + 0, /* tv_id */ + PROP_ssa, /* properties_required */ + 0, /* properties_provided */ + 0, /* properties_destroyed */ + 0, /* todo_flags_start */ + TODO_dump_func /* todo_flags_finish */ + } +}; + +/* The initialization routine exposed to and called by GCC. The spec of this + function is defined in gcc/gcc-plugin.h. + + PLUGIN_NAME - name of the plugin (useful for error reporting) + ARGC - the size of the ARGV array + ARGV - an array of key-value argument pair + + Returns 0 if initialization finishes successfully. + + Note that this function needs to be named exactly "plugin_init". */ + +int +plugin_init (const char *plugin_name, struct plugin_gcc_version *version, + int argc, struct plugin_argument *argv) +{ + struct plugin_pass pass_info; + bool enabled = true; + int i; + + if (!plugin_default_version_check (version, version)) + return 1; + + /* Self-assign detection should happen after SSA is constructed. */ + pass_info.pass = &pass_warn_self_assign.pass; + pass_info.reference_pass_name = "ssa"; + pass_info.ref_pass_instance_number = 1; + pass_info.pos_op = PASS_POS_INSERT_AFTER; + + /* Process the plugin arguments. This plugin takes the following arguments: + check-operator-eq, no-check-operator-eq, enable, and disable. + By default, the analysis is enabled with 'operator=' checked. */ + for (i = 0; i < argc; ++i) + { + if (!strcmp (argv[i].key, "check-operator-eq")) + { + if (argv[i].value) + warning (0, G_("option '-fplugin-arg-%s-check-operator-eq=%s'" + " ignored (superfluous '=%s')"), + plugin_name, argv[i].value, argv[i].value); + else + check_operator_eq = true; + } + else if (!strcmp (argv[i].key, "no-check-operator-eq")) + { + if (argv[i].value) + warning (0, G_("option '-fplugin-arg-%s-no-check-operator-eq=%s'" + " ignored (superfluous '=%s')"), + plugin_name, argv[i].value, argv[i].value); + else + check_operator_eq = false; + } + else if (!strcmp (argv[i].key, "enable")) + { + if (argv[i].value) + warning (0, G_("option '-fplugin-arg-%s-enable=%s' ignored" + " (superfluous '=%s')"), + plugin_name, argv[i].value, argv[i].value); + else + enabled = true; + } + else if (!strcmp (argv[i].key, "disable")) + { + if (argv[i].value) + warning (0, G_("option '-fplugin-arg-%s-disable=%s' ignored" + " (superfluous '=%s')"), + plugin_name, argv[i].value, argv[i].value); + else + enabled = false; + } + else + warning (0, G_("plugin %qs: unrecognized argument %qs ignored"), + plugin_name, argv[i].key); + } + + /* Register this new pass with GCC if the analysis is enabled. */ + if (enabled) + register_callback (plugin_name, PLUGIN_PASS_MANAGER_SETUP, NULL, + &pass_info); + + return 0; +} diff --git a/gcc/testsuite/g++.dg/template/call7.C b/gcc/testsuite/g++.dg/template/call7.C new file mode 100644 index 00000000000..00a912b3682 --- /dev/null +++ b/gcc/testsuite/g++.dg/template/call7.C @@ -0,0 +1,19 @@ +// Contributed by Dodji Seketeli <dodji@redhat.com> +// Origin: PR c++/17395 +// { dg-do "compile" } + +template<int> struct X { }; + +void fu(int a, X<sizeof(a)>) { } + +template<class T> +void bhar(T a, X<sizeof(a)>) { } + +int +main() +{ + int x; + X<sizeof(int)> y; + fu(x, y); + bhar(x, y); +} diff --git a/gcc/testsuite/gcc.c-torture/compile/const-high-part.c b/gcc/testsuite/gcc.c-torture/compile/const-high-part.c new file mode 100644 index 00000000000..95e2059704e --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/compile/const-high-part.c @@ -0,0 +1,19 @@ +/* { dg-require-effective-target int32plus } */ +/* { dg-require-effective-target size32plus } */ + +char *buf; +int buflen; + +inline int +sub (int length) +{ + if (length <= buflen) + buf[length] = '\0'; + return 0; +} + +int +sub2 (void) +{ + return sub (0x7fffffff); +} diff --git a/gcc/testsuite/gcc.c-torture/execute/pr40057.c b/gcc/testsuite/gcc.c-torture/execute/pr40057.c new file mode 100644 index 00000000000..9d5c4e31e87 --- /dev/null +++ b/gcc/testsuite/gcc.c-torture/execute/pr40057.c @@ -0,0 +1,37 @@ +/* PR middle-end/40057 */ + +extern void abort (void); + +__attribute__((noinline)) int +foo (unsigned long long x) +{ + unsigned long long y = (x >> 31ULL) & 1ULL; + if (y == 0ULL) + return 0; + return -1; +} + +__attribute__((noinline)) int +bar (long long x) +{ + long long y = (x >> 31LL) & 1LL; + if (y == 0LL) + return 0; + return -1; +} + +int +main (void) +{ + if (sizeof (long long) != 8) + return 0; + if (foo (0x1682a9aaaULL)) + abort (); + if (!foo (0x1882a9aaaULL)) + abort (); + if (bar (0x1682a9aaaLL)) + abort (); + if (!bar (0x1882a9aaaLL)) + abort (); + return 0; +} diff --git a/gcc/testsuite/gcc.dg/Wunsuffixed-float-constants-1.c b/gcc/testsuite/gcc.dg/Wunsuffixed-float-constants-1.c new file mode 100644 index 00000000000..b4a38d5cb10 --- /dev/null +++ b/gcc/testsuite/gcc.dg/Wunsuffixed-float-constants-1.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu99 -Wunsuffixed-float-constants" } */ + +#define VAL 0.5; + +double a = 1.1d; + +/* With FLOAT_CONST_DECIMAL64 switched to ON these would have type + _Decimal64. */ + +double b = VAL; /* { dg-warning "unsuffixed float constant" } */ +double c = 1.2; /* { dg-warning "unsuffixed float constant" } */ + +/* With FLOAT_CONST_DECIMAL64 switched to ON these are still binary. */ + +double d = 0x5.0p1; /* No warning for hex constant. */ +double e = 3.1i; /* No warning for imaginary constant. */ diff --git a/gcc/testsuite/gcc.dg/cpp/pragma-float-const-decimal64-1.c b/gcc/testsuite/gcc.dg/cpp/pragma-float-const-decimal64-1.c new file mode 100644 index 00000000000..633383899dd --- /dev/null +++ b/gcc/testsuite/gcc.dg/cpp/pragma-float-const-decimal64-1.c @@ -0,0 +1,5 @@ +/* { dg-do compile { target { ! dfp } } } */ +/* { dg-options "-std=gnu99 -Wunknown-pragmas" } */ + +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "not supported on this target" } */ +double d = 1.0; diff --git a/gcc/testsuite/gcc.dg/dfp/float-constant-double.c b/gcc/testsuite/gcc.dg/dfp/float-constant-double.c new file mode 100644 index 00000000000..3f8de656bf6 --- /dev/null +++ b/gcc/testsuite/gcc.dg/dfp/float-constant-double.c @@ -0,0 +1,21 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu99" } */ + +/* Constant float values of type double in <float.h> are suffixed with L + and cast to double so they can be used within code that uses pragma + FLOAT_CONST_DECIMAL64. If they were not suffixed then use of the macro + would have them interpreted as _Decimal64, leading to errors when used + in expressions with other operands of type double. */ + +#include <float.h> + +extern double a, b, c, d; + +void +foo () +{ + _Pragma ("STDC FLOAT_CONST_DECIMAL64 ON") + a = 0.1d * DBL_MAX; + b = DBL_EPSILON * 10.0d; + c = DBL_MIN * 200.0d; +} diff --git a/gcc/testsuite/gcc.dg/dfp/pr39986.c b/gcc/testsuite/gcc.dg/dfp/pr39986.c new file mode 100644 index 00000000000..53bda3c824a --- /dev/null +++ b/gcc/testsuite/gcc.dg/dfp/pr39986.c @@ -0,0 +1,31 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu99" } */ + +/* Check that the compiler generates the correct decimal float constants. */ + +_Decimal32 a = 100.223df; +_Decimal32 b = -2.3df; +_Decimal64 c = 3.4e-4dd; +_Decimal64 d = -4.500dd; +_Decimal128 e = 5678901234567.89e+200dl; +_Decimal128 f = -678901.234e-6dl; + +/* The first value is DPD, the second is BID. The order differs depending + on whether the target is big-endian or little-endian. */ + +/* { dg-final { scan-assembler ".long\t(572653859|822183807)\n" } } */ + +/* { dg-final { scan-assembler ".long\t(-1572863965|-1308622825)\n" } } */ + +/* { dg-final { scan-assembler ".long\t(52|34)\n" } } */ +/* { dg-final { scan-assembler ".long\t(572784640|824180736)\n" } } */ + +/* { dg-final { scan-assembler ".long\t(4736|4500)\n" } } */ +/* { dg-final { scan-assembler ".long\t(-1574174720|-1319108608)\n" } } */ + +/* { dg-final { scan-assembler ".long\t(-1975952433|957645077)\n" } } */ +/* { dg-final { scan-assembler ".long\t(190215|132222)\n" } } */ +/* { dg-final { scan-assembler ".long\t(574193664|835452928)\n" } } */ + +/* { dg-final { scan-assembler ".long\t(931280180|678901234)\n" } } */ +/* { dg-final { scan-assembler ".long\t(-1576681472|-1339162624)\n" } } */ diff --git a/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-1.c b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-1.c new file mode 100644 index 00000000000..79fabf34484 --- /dev/null +++ b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-1.c @@ -0,0 +1,85 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu99 -Wall" } */ + +/* N1312 7.1.1: The FLOAT_CONST_DECIMAL64 pragma. + C99 6.4.4.2a (New). + + Verify that the pragma has the expected result by using unsuffixed + float constants as operands in expressions that would mix binary and + decimal operands if the pragma had no effect, or the wrong effect. */ + +#pragma STDC FLOAT_CONST_DECIMAL64 ON +double a = 1.0 * 2.0dd; + +double +f1 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 OFF + double b = 2.0 * 3.0d; + + { + double c = 3.0 * 4.0d; + b = b + c; + } + + { +#pragma STDC FLOAT_CONST_DECIMAL64 ON + double d = 4.0 * 5.0dd; + + b = b + d; + } + + { + /* Default is OFF. */ +#pragma STDC FLOAT_CONST_DECIMAL64 DEFAULT + double e = 5.0 * 6.0d; + b = b + e; + } + + return b; +} + +double +f2 (void) +{ + /* Use value from outer scope, which is ON. */ + double b = 2.0 * 3.0dd; + + { +#pragma STDC FLOAT_CONST_DECIMAL64 OFF + double c = 3.0 * 4.0d; + + { +#pragma STDC FLOAT_CONST_DECIMAL64 ON + double d = 4.0 * 5.0dd; + + { +#pragma STDC FLOAT_CONST_DECIMAL64 DEFAULT + double e = 5.0 * 6.0d; + + { +#pragma STDC FLOAT_CONST_DECIMAL64 ON + double f = 6.0 * 7.0dd; + + b = a + b + c + d + e + f; + } + } + } + } + return b; +} + +/* Use previous value from this scope, which is ON. */ +double f = 6.0 * 7.0dd; + +double +f3 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 OFF + double b = 2.0 * 3.0d; + + return b + f; +} + +/* Return to the state from this scope, which is ON. */ +double g = 7.0 + 8.0dd; diff --git a/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-2.c b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-2.c new file mode 100644 index 00000000000..212748c6c78 --- /dev/null +++ b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-2.c @@ -0,0 +1,86 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu99 -Wall" } */ + +/* N1312 7.1.1: The FLOAT_CONST_DECIMAL64 pragma. + C99 6.4.4.2a (New). + + Verify that the pragma has the expected result by using unsuffixed + float constants as operands in expressions that would mix binary and + decimal operands if the pragma had no effect, or the wrong effect. + Use _Pragma rather than #pragma. */ + +_Pragma ("STDC FLOAT_CONST_DECIMAL64 ON") +double a = 1.0 * 2.0dd; + +double +f1 (void) +{ +_Pragma ("STDC FLOAT_CONST_DECIMAL64 OFF") + double b = 2.0 * 3.0d; + + { + double c = 3.0 * 4.0d; + b = b + c; + } + + { +_Pragma ("STDC FLOAT_CONST_DECIMAL64 ON") + double d = 4.0 * 5.0dd; + + b = b + d; + } + + { + /* Default is OFF. */ +_Pragma ("STDC FLOAT_CONST_DECIMAL64 DEFAULT") + double e = 5.0 * 6.0d; + b = b + e; + } + + return b; +} + +double +f2 (void) +{ + /* Use value from outer scope, which is ON. */ + double b = 2.0 * 3.0dd; + + { +_Pragma ("STDC FLOAT_CONST_DECIMAL64 OFF") + double c = 3.0 * 4.0d; + + { +_Pragma ("STDC FLOAT_CONST_DECIMAL64 ON") + double d = 4.0 * 5.0dd; + + { +_Pragma ("STDC FLOAT_CONST_DECIMAL64 DEFAULT") + double e = 5.0 * 6.0d; + + { +_Pragma ("STDC FLOAT_CONST_DECIMAL64 ON") + double f = 6.0 * 7.0dd; + + b = a + b + c + d + e + f; + } + } + } + } + return b; +} + +/* Use previous value from this scope, which is ON. */ +double f = 6.0 * 7.0dd; + +double +f3 (void) +{ +_Pragma ("STDC FLOAT_CONST_DECIMAL64 OFF") + double b = 2.0 * 3.0d; + + return b + f; +} + +/* Return to the state from this scope, which is ON. */ +double g = 7.0 + 8.0dd; diff --git a/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-3.c b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-3.c new file mode 100644 index 00000000000..b9286aac11a --- /dev/null +++ b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-3.c @@ -0,0 +1,83 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu99 -Wall" } */ + +/* N1312 7.1.1: The FLOAT_CONST_DECIMAL64 pragma. + C99 6.4.4.2a (New). */ + +/* Check that defining macros whose names are the same as the tokens used + in the pragma doesn't affect use of the pragma. */ + +#define ON YES +#define OFF NO +#define DEFAULT NOPE +#define STDC OFFICIAL +#define FLOAT_CONST_DECIMAL64 NEW_PRAGMA + +double a; + +void +f1a (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 ON + a = 1.0dd + 2.0; +} + +void +f1b (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 OFF + a = 2.0d + 3.0; +} + +void +f1c (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 DEFAULT + a = 3.0d + 4.0; +} + +/* Check that a macro can be used for the entire pragma. */ + +#define PRAGMA(x) _Pragma (#x) +#define DEFAULT_FLOAT_IS_DECIMAL PRAGMA(STDC FLOAT_CONST_DECIMAL64 ON) +#define DEFAULT_FLOAT_IS_BINARY PRAGMA(STDC FLOAT_CONST_DECIMAL64 OFF) + +void +f2a (void) +{ + DEFAULT_FLOAT_IS_DECIMAL + a = 5.0 * 6.0dd; +} + +void +f2b (void) +{ + DEFAULT_FLOAT_IS_BINARY + a = 6.0 * 7.0d; +} + +/* _Pragma can be used with macros, including the use of a macro for the + switch. */ + +#undef ON +#undef OFF +#undef DEFAULT +#undef STDC +#undef FLOAT_CONST_DECIMAL64 + +#define SWITCH ON +#define FLOAT_CONST_DECIMAL64(x) PRAGMA(STDC FLOAT_CONST_DECIMAL64 x) + +void +f3a (void) +{ + FLOAT_CONST_DECIMAL64(SWITCH) + a = 1.0 * 7.0dd; +} + +void +f3b (void) +{ + FLOAT_CONST_DECIMAL64(OFF) + a = 1.0 + 2.0d; +} diff --git a/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-4.c b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-4.c new file mode 100644 index 00000000000..86cec1dbd45 --- /dev/null +++ b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-4.c @@ -0,0 +1,46 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu99" } */ + +/* N1312 7.1.1: The FLOAT_CONST_DECIMAL64 pragma. + C99 6.4.4.2a (New). + + Check that malformed versions of pragma STDC FLOAT_CONST_DECIMAL64 + are detected. */ + +double a; + +void f1 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 /* { dg-warning "malformed" } */ + a = 1.0; +} + +void f2 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 DFP /* { dg-warning "malformed" } */ + a = 2.0; +} + +void f3 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 ON DFP /* { dg-warning "junk at end" } */ + a = 3.0; +} + +void f4 (void) +{ + _Pragma ( "STDC FLOAT_CONST_DECIMAL64" ) /* { dg-warning "malformed" } */ + a = 1.0; +} + +void f5 (void) +{ + _Pragma ( "STDC FLOAT_CONST_DECIMAL64 DFP" ) /* { dg-warning "malformed" } */ + a = 2.0; +} + +void f6 (void) +{ + _Pragma ( "STDC FLOAT_CONST_DECIMAL64 ON DFP" ) /* { dg-warning "junk at end" } */ + a = 3.0; +} diff --git a/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-5.c b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-5.c new file mode 100644 index 00000000000..75e9525dda0 --- /dev/null +++ b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-5.c @@ -0,0 +1,46 @@ +/* { dg-do compile } */ +/* { dg-options "-std=c99 -pedantic" } */ + +/* N1312 7.1.1: The FLOAT_CONST_DECIMAL64 pragma. + C99 6.4.4.2a (New). + + Check that there is a pedantic warning for the use of pragma + STD FLOAT_CONST_DECIMAL64. */ + +double a; + +void f1 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "ISO C" } */ + a = 1.0; +} + +void f2 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 OFF /* { dg-warning "ISO C" } */ + a = 2.0; +} + +void f3 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 DEFAULT /* { dg-warning "ISO C" } */ + a = 3.0; +} + +void f4 (void) +{ + _Pragma ("STDC FLOAT_CONST_DECIMAL64 ON") /* { dg-warning "ISO C" } */ + a = 1.0; +} + +void f5 (void) +{ + _Pragma ("STDC FLOAT_CONST_DECIMAL64 OFF") /* { dg-warning "ISO C" } */ + a = 2.0; +} + +void f6 (void) +{ + _Pragma ("STDC FLOAT_CONST_DECIMAL64 DEFAULT") /* { dg-warning "ISO C" } */ + a = 3.0; +} diff --git a/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-6.c b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-6.c new file mode 100644 index 00000000000..03c1715bee6 --- /dev/null +++ b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-6.c @@ -0,0 +1,46 @@ +/* { dg-do compile } */ +/* { dg-options "-std=c99 -pedantic-errors" } */ + +/* N1312 7.1.1: The FLOAT_CONST_DECIMAL64 pragma. + C99 6.4.4.2a (New). + + Check that there is a pedantic error for the use of pragma + STD FLOAT_CONST_DECIMAL64. */ + +double a; + +void f1 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-error "ISO C" } */ + a = 1.0; +} + +void f2 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 OFF /* { dg-error "ISO C" } */ + a = 2.0; +} + +void f3 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 DEFAULT /* { dg-error "ISO C" } */ + a = 3.0; +} + +void f4 (void) +{ + _Pragma ("STDC FLOAT_CONST_DECIMAL64 ON") /* { dg-error "ISO C" } */ + a = 1.0; +} + +void f5 (void) +{ + _Pragma ("STDC FLOAT_CONST_DECIMAL64 OFF") /* { dg-error "ISO C" } */ + a = 2.0; +} + +void f6 (void) +{ + _Pragma ("STDC FLOAT_CONST_DECIMAL64 DEFAULT") /* { dg-error "ISO C" } */ + a = 3.0; +} diff --git a/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-7.c b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-7.c new file mode 100644 index 00000000000..7533ee7f0de --- /dev/null +++ b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-7.c @@ -0,0 +1,39 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu99 -Wall" } */ + +/* N1312 7.1.1: The FLOAT_CONST_DECIMAL64 pragma. + C99 6.4.4.2a (New). + + Check that when pragma FLOAT_CONST_DECIMAL64 is in effect so that + unsuffixed constants are _Decimal64, invalid types are still reported + as invalid. */ + +double +f1 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 OFF + double a = 0x1.0p1; + double b = 1.0i; + + return a + b; +} + +double +f2 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 OFF + double a = 0x1.0p1dd; /* { dg-error "with hex" } */ + double b = 1.0idd; /* { dg-error "invalid suffix" } */ + + return a + b; +} + +double +f3 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 ON + double a = 0x1.0p1; /* Hex constant is not affected by pragma. */ + double b = 1.0i; /* Imaginary constant is not affected by pragma. */ + + return a + b; +} diff --git a/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-8.c b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-8.c new file mode 100644 index 00000000000..5dbbda5b8f2 --- /dev/null +++ b/gcc/testsuite/gcc.dg/dfp/pragma-float-const-decimal64-8.c @@ -0,0 +1,174 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu99 -Wall" } */ + +/* N1312 7.1.1: The FLOAT_CONST_DECIMAL64 pragma. + C99 6.4.4.2a (New). + + Pragma STDC FLOAT_CONST_DECIMAL64 "shall occur either outside external + declarations or preceding all explicit declarations and statements + inside a compound statement." */ + +#pragma STDC FLOAT_CONST_DECIMAL64 OFF + +#define MAX 200 + +#pragma STDC FLOAT_CONST_DECIMAL64 ON + +double a; + +#pragma STDC FLOAT_CONST_DECIMAL64 OFF + +struct S1 { +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "invalid location" } */ + int i; + int j; +}; + +struct S2 { + int i; +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "invalid location" } */ + int j; +}; + +struct S3 { + int i; + int j; +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "invalid location" } */ +}; + +enum E1 { +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-error "#pragma" } */ + one, + two +}; + +enum E2 { + red, +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-error "#pragma" } */ + blue +}; + +enum E3 { + cat, + dog +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-error "#pragma" } */ +}; + +double +#pragma STDC FLOAT_CONST_DECIMAL64 OFF /* { dg-error "#pragma" } */ +b; + +double +f1 (void) +{ +#pragma STDC FLOAT_CONST_DECIMAL64 ON + return a; +} + +double +f2 (void) +{ + double b; +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "invalid location" } */ + b = 0.5; + return a + b; +} + +#pragma STDC FLOAT_CONST_DECIMAL64 OFF + +double +f3 (void) +{ + typedef double b32; +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "invalid location" } */ + b32 b = 0.5; + return b; +} + +double +f4 (int i) +{ +top: +#pragma STDC FLOAT_CONST_DECIMAL64 OFF /* { dg-warning "invalid location" } */ + if (i == 0) + return a; + a *= 2.; + i = 0; + goto top; +} + +double +f5 (int i) +{ + a = a * i; +#pragma STDC FLOAT_CONST_DECIMAL64 OFF /* { dg-warning "invalid location" } */ + return a * 2.; +} + +double +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-error "#pragma" } */ +f6 (void) +{ + return a; +} + +double +f7 +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-error "#pragma" } */ +(void) /* { dg-error "before" } */ +{ + return a; +} + +double +f8 (void) +{ + { +#pragma STDC FLOAT_CONST_DECIMAL64 OFF + } +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "invalid location" } */ + return a; +} + +extern void foo9 (void *); + +double +f9 (void) +{ + __label__ here; +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "invalid location" } */ + foo9 (&&here); +here: + return a; +} + +double +f10 (void) +{ + void foo10 (void) + { + a = 1.0; + } +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "invalid location" } */ + return a; +} + +double +f11 (void) +{ + __extension__ + struct A { + struct { char a; }; + char b; + }; +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "invalid location" } */ + return a; +} + +double +f12 (void) +{ + __extension__ ({ a = 0.5; }); +#pragma STDC FLOAT_CONST_DECIMAL64 ON /* { dg-warning "invalid location" } */ + return a; +} diff --git a/gcc/testsuite/gcc.dg/plugin/plugin.exp b/gcc/testsuite/gcc.dg/plugin/plugin.exp new file mode 100644 index 00000000000..93c0c5cb848 --- /dev/null +++ b/gcc/testsuite/gcc.dg/plugin/plugin.exp @@ -0,0 +1,65 @@ +# Copyright (C) 2009 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/>. + +# Test the functionality of the GCC plugin support + +load_lib target-supports.exp +load_lib gcc-dg.exp + +global TESTING_IN_BUILD_TREE +global ENABLE_PLUGIN + +# The plugin testcases currently only work when the build tree is available. +# Also check whether the host supports plugins. +if { ![info exists TESTING_IN_BUILD_TREE] || ![info exists ENABLE_PLUGIN] } { + return +} + +# 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" +} + +# The procedures in plugin-support.exp need these parameters. +set default_flags $DEFAULT_CFLAGS + +if $tracelevel then { + strace $tracelevel +} + +# Load support procs. +load_lib plugin-support.exp + +# Specify the plugin source file and the associated test files in a list. +# plugin_test_list={ {plugin1 test1 test2 ...} {plugin2 test1 ...} ... } +set plugin_test_list [list \ + { selfassign.c self-assign-test-1.c self-assign-test-2.c } ] + +foreach plugin_test $plugin_test_list { + # Replace each source file with its full-path name + for {set i 0} {$i < [llength $plugin_test]} {incr i} { + set basename [lindex $plugin_test $i] + set plugin_test [lreplace $plugin_test $i $i $srcdir/$subdir/$basename] + } + set plugin_src [lindex $plugin_test 0] + # If we're only testing specific files and this isn't one of them, skip it. + if ![runtest_file_p $runtests $plugin_src] then { + continue + } + set plugin_input_tests [lreplace $plugin_test 0 0] + plugin-test-execute $plugin_src $plugin_input_tests +} diff --git a/gcc/testsuite/gcc.dg/plugin/self-assign-test-1.c b/gcc/testsuite/gcc.dg/plugin/self-assign-test-1.c new file mode 100644 index 00000000000..f6dc5240f1e --- /dev/null +++ b/gcc/testsuite/gcc.dg/plugin/self-assign-test-1.c @@ -0,0 +1,23 @@ +/* Test the self-assignemnt detection plugin. */ +/* { dg-do compile } */ +/* { dg-options "-O" } */ + +struct Bar { + int b_; + int c_; +}; + +int g; + +int main() +{ + struct Bar *bar; + int x = x; /* { dg-warning "assigned to itself" } */ + static int y; + struct Bar b_array[5]; + + b_array[x+g].b_ = b_array[x+g].b_; /* { dg-warning "self-assignment detected" } */ + g = g; /* { dg-warning "assigned to itself" } */ + y = y; /* { dg-warning "assigned to itself" } */ + bar->b_ = bar->b_; /* { dg-warning "assigned to itself" } */ +} diff --git a/gcc/testsuite/gcc.dg/plugin/self-assign-test-2.c b/gcc/testsuite/gcc.dg/plugin/self-assign-test-2.c new file mode 100644 index 00000000000..2ede371a69a --- /dev/null +++ b/gcc/testsuite/gcc.dg/plugin/self-assign-test-2.c @@ -0,0 +1,23 @@ +/* Test the self-assignemnt detection plugin with the 'disable' argument. */ +/* { dg-do compile } */ +/* { dg-options "-O -fplugin-arg-selfassign-disable" } */ + +struct Bar { + int b_; + int c_; +}; + +int g; + +int main() +{ + struct Bar *bar; + int x = x; /* { dg-bogus "assigned to itself" } */ + static int y; + struct Bar b_array[5]; + + b_array[x+g].b_ = b_array[x+g].b_; /* { dg-bogus "self-assignment detected" } */ + g = g; /* { dg-bogus "assigned to itself" } */ + y = y; /* { dg-bogus "assigned to itself" } */ + bar->b_ = bar->b_; /* { dg-bogus "assigned to itself" } */ +} diff --git a/gcc/testsuite/gcc.dg/plugin/selfassign.c b/gcc/testsuite/gcc.dg/plugin/selfassign.c new file mode 100644 index 00000000000..6fbce83c01d --- /dev/null +++ b/gcc/testsuite/gcc.dg/plugin/selfassign.c @@ -0,0 +1,365 @@ +/* This plugin contains an analysis pass that detects and warns about + self-assignment statements. */ +/* { dg-options "-O" } */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tm.h" +#include "toplev.h" +#include "basic-block.h" +#include "gimple.h" +#include "tree.h" +#include "tree-pass.h" +#include "intl.h" +#include "gcc-plugin.h" + + +/* Indicate whether to check overloaded operator '=', which is performed by + default. To disable it, use -fplugin-arg-NAME-no-check-operator-eq. */ +bool check_operator_eq = true; + +/* Given a rhs EXPR of a gimple assign statement, if it is + - SSA_NAME : returns its var decl, or, if it is a temp variable, + returns the rhs of its SSA def statement. + - VAR_DECL, PARM_DECL, FIELD_DECL, or a reference expression : + returns EXPR itself. + - any other expression : returns NULL_TREE. */ + +static tree +get_real_ref_rhs (tree expr) +{ + switch (TREE_CODE (expr)) + { + case SSA_NAME: + { + /* Given a self-assign statement, say foo.x = foo.x, + the IR (after SSA) looks like: + + D.1797_14 = foo.x; + foo.x ={v} D.1797_14; + + So if the rhs EXPR is an SSA_NAME of a temp variable, + e.g. D.1797_14, we need to grab the rhs of its SSA def + statement (i.e. foo.x). */ + tree vdecl = SSA_NAME_VAR (expr); + if (DECL_ARTIFICIAL (vdecl) + && !gimple_nop_p (SSA_NAME_DEF_STMT (expr))) + { + gimple def_stmt = SSA_NAME_DEF_STMT (expr); + /* We are only interested in an assignment with a single + rhs operand because if it is not, the original assignment + will not possibly be a self-assignment. */ + if (is_gimple_assign (def_stmt) + && (get_gimple_rhs_class (gimple_assign_rhs_code (def_stmt)) + == GIMPLE_SINGLE_RHS)) + return get_real_ref_rhs (gimple_assign_rhs1 (def_stmt)); + else + return NULL_TREE; + } + else + return vdecl; + } + case VAR_DECL: + case PARM_DECL: + case FIELD_DECL: + case COMPONENT_REF: + case INDIRECT_REF: + case ARRAY_REF: + return expr; + default: + return NULL_TREE; + } +} + +/* Given an expression tree, EXPR, that may contains SSA names, returns an + equivalent tree with the SSA names converted to var/parm/field decls + so that it can be used with '%E' format modifier when emitting warning + messages. + + This function currently only supports VAR/PARM/FIELD_DECL, reference + expressions (COMPONENT_REF, INDIRECT_REF, ARRAY_REF), integer constant, + and SSA_NAME. If EXPR contains any other tree nodes (e.g. an arithmetic + expression appears in array index), NULL_TREE is returned. */ + +static tree +get_non_ssa_expr (tree expr) +{ + switch (TREE_CODE (expr)) + { + case VAR_DECL: + case PARM_DECL: + case FIELD_DECL: + { + if (DECL_NAME (expr)) + return expr; + else + return NULL_TREE; + } + case COMPONENT_REF: + { + tree base, orig_base = TREE_OPERAND (expr, 0); + tree component, orig_component = TREE_OPERAND (expr, 1); + base = get_non_ssa_expr (orig_base); + if (!base) + return NULL_TREE; + component = get_non_ssa_expr (orig_component); + if (!component) + return NULL_TREE; + /* If either BASE or COMPONENT is converted, build a new + component reference tree. */ + if (base != orig_base || component != orig_component) + return build3 (COMPONENT_REF, TREE_TYPE (component), + base, component, NULL_TREE); + else + return expr; + } + case INDIRECT_REF: + { + tree orig_base = TREE_OPERAND (expr, 0); + tree base = get_non_ssa_expr (orig_base); + if (!base) + return NULL_TREE; + /* If BASE is converted, build a new indirect reference tree. */ + if (base != orig_base) + return build1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (base)), base); + else + return expr; + } + case ARRAY_REF: + { + tree array, orig_array = TREE_OPERAND (expr, 0); + tree index, orig_index = TREE_OPERAND (expr, 1); + array = get_non_ssa_expr (orig_array); + if (!array) + return NULL_TREE; + index = get_non_ssa_expr (orig_index); + if (!index) + return NULL_TREE; + /* If either ARRAY or INDEX is converted, build a new array + reference tree. */ + if (array != orig_array || index != orig_index) + return build4 (ARRAY_REF, TREE_TYPE (expr), array, index, + TREE_OPERAND (expr, 2), TREE_OPERAND (expr, 3)); + else + return expr; + } + case SSA_NAME: + { + tree vdecl = SSA_NAME_VAR (expr); + if (DECL_ARTIFICIAL (vdecl) + && !gimple_nop_p (SSA_NAME_DEF_STMT (expr))) + { + gimple def_stmt = SSA_NAME_DEF_STMT (expr); + if (is_gimple_assign (def_stmt) + && (get_gimple_rhs_class (gimple_assign_rhs_code (def_stmt)) + == GIMPLE_SINGLE_RHS)) + vdecl = gimple_assign_rhs1 (def_stmt); + } + return get_non_ssa_expr (vdecl); + } + case INTEGER_CST: + return expr; + default: + /* Return NULL_TREE for any other kind of tree nodes. */ + return NULL_TREE; + } +} + +/* Given the LHS and (real) RHS of a gimple assign statement, STMT, check if + they are the same. If so, print a warning message about self-assignment. */ + +static void +compare_and_warn (gimple stmt, tree lhs, tree rhs) +{ + if (operand_equal_p (lhs, rhs, OEP_PURE_SAME)) + { + location_t location; + location = (gimple_has_location (stmt) + ? gimple_location (stmt) + : (DECL_P (lhs) + ? DECL_SOURCE_LOCATION (lhs) + : input_location)); + /* If LHS contains any tree node not currently supported by + get_non_ssa_expr, simply emit a generic warning without + specifying LHS in the message. */ + lhs = get_non_ssa_expr (lhs); + if (lhs) + warning (0, G_("%H%qE is assigned to itself"), &location, lhs); + else + warning (0, G_("%Hself-assignment detected"), &location); + } +} + +/* Check and warn if STMT is a self-assign statement. */ + +static void +warn_self_assign (gimple stmt) +{ + tree rhs, lhs; + + /* Check assigment statement. */ + if (is_gimple_assign (stmt) + && (get_gimple_rhs_class (gimple_assign_rhs_code (stmt)) + == GIMPLE_SINGLE_RHS)) + { + rhs = get_real_ref_rhs (gimple_assign_rhs1 (stmt)); + if (!rhs) + return; + + lhs = gimple_assign_lhs (stmt); + if (TREE_CODE (lhs) == SSA_NAME) + { + lhs = SSA_NAME_VAR (lhs); + if (DECL_ARTIFICIAL (lhs)) + return; + } + + compare_and_warn (stmt, lhs, rhs); + } + /* Check overloaded operator '=' (if enabled). */ + else if (check_operator_eq && is_gimple_call (stmt)) + { + tree fdecl = gimple_call_fndecl (stmt); + if (fdecl && (DECL_NAME (fdecl) == maybe_get_identifier ("operator="))) + { + /* If 'operator=' takes reference operands, the arguments will be + ADDR_EXPR trees. In this case, just remove the address-taken + operator before we compare the lhs and rhs. */ + lhs = gimple_call_arg (stmt, 0); + if (TREE_CODE (lhs) == ADDR_EXPR) + lhs = TREE_OPERAND (lhs, 0); + rhs = gimple_call_arg (stmt, 1); + if (TREE_CODE (rhs) == ADDR_EXPR) + rhs = TREE_OPERAND (rhs, 0); + + compare_and_warn (stmt, lhs, rhs); + } + } +} + +/* Entry point for the self-assignment detection pass. */ + +static unsigned int +execute_warn_self_assign (void) +{ + gimple_stmt_iterator gsi; + basic_block bb; + + FOR_EACH_BB (bb) + { + for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) + warn_self_assign (gsi_stmt (gsi)); + } + + return 0; +} + +/* Pass gate function. Currently always returns true. */ + +static bool +gate_warn_self_assign (void) +{ + return true; +} + +static struct gimple_opt_pass pass_warn_self_assign = +{ + { + GIMPLE_PASS, + "warn_self_assign", /* name */ + gate_warn_self_assign, /* gate */ + execute_warn_self_assign, /* execute */ + NULL, /* sub */ + NULL, /* next */ + 0, /* static_pass_number */ + 0, /* tv_id */ + PROP_ssa, /* properties_required */ + 0, /* properties_provided */ + 0, /* properties_destroyed */ + 0, /* todo_flags_start */ + TODO_dump_func /* todo_flags_finish */ + } +}; + +/* The initialization routine exposed to and called by GCC. The spec of this + function is defined in gcc/gcc-plugin.h. + + PLUGIN_NAME - name of the plugin (useful for error reporting) + ARGC - the size of the ARGV array + ARGV - an array of key-value argument pair + + Returns 0 if initialization finishes successfully. + + Note that this function needs to be named exactly "plugin_init". */ + +int +plugin_init (const char *plugin_name, struct plugin_gcc_version *version, + int argc, struct plugin_argument *argv) +{ + struct plugin_pass pass_info; + bool enabled = true; + int i; + + if (!plugin_default_version_check (version, version)) + return 1; + + /* Self-assign detection should happen after SSA is constructed. */ + pass_info.pass = &pass_warn_self_assign.pass; + pass_info.reference_pass_name = "ssa"; + pass_info.ref_pass_instance_number = 1; + pass_info.pos_op = PASS_POS_INSERT_AFTER; + + /* Process the plugin arguments. This plugin takes the following arguments: + check-operator-eq, no-check-operator-eq, enable, and disable. + By default, the analysis is enabled with 'operator=' checked. */ + for (i = 0; i < argc; ++i) + { + if (!strcmp (argv[i].key, "check-operator-eq")) + { + if (argv[i].value) + warning (0, G_("option '-fplugin-arg-%s-check-operator-eq=%s'" + " ignored (superfluous '=%s')"), + plugin_name, argv[i].value, argv[i].value); + else + check_operator_eq = true; + } + else if (!strcmp (argv[i].key, "no-check-operator-eq")) + { + if (argv[i].value) + warning (0, G_("option '-fplugin-arg-%s-no-check-operator-eq=%s'" + " ignored (superfluous '=%s')"), + plugin_name, argv[i].value, argv[i].value); + else + check_operator_eq = false; + } + else if (!strcmp (argv[i].key, "enable")) + { + if (argv[i].value) + warning (0, G_("option '-fplugin-arg-%s-enable=%s' ignored" + " (superfluous '=%s')"), + plugin_name, argv[i].value, argv[i].value); + else + enabled = true; + } + else if (!strcmp (argv[i].key, "disable")) + { + if (argv[i].value) + warning (0, G_("option '-fplugin-arg-%s-disable=%s' ignored" + " (superfluous '=%s')"), + plugin_name, argv[i].value, argv[i].value); + else + enabled = false; + } + else + warning (0, G_("plugin %qs: unrecognized argument %qs ignored"), + plugin_name, argv[i].key); + } + + /* Register this new pass with GCC if the analysis is enabled. */ + if (enabled) + register_callback (plugin_name, PLUGIN_PASS_MANAGER_SETUP, NULL, + &pass_info); + + return 0; +} diff --git a/gcc/testsuite/gfortran.dg/intrinsic.f90 b/gcc/testsuite/gfortran.dg/intrinsic.f90 index 8bb41fdfdc4..e3ac35ef52a 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic.f90 @@ -1,5 +1,8 @@ ! { dg-do compile } ! { dg-options "-c -Wall" } +! +! PR fortran/20373 +! cf. also PR fortran/40041 subroutine valid intrinsic :: abs ! ok, intrinsic function diff --git a/gcc/testsuite/gfortran.dg/intrinsic_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_2.f90 new file mode 100644 index 00000000000..b4919a13cde --- /dev/null +++ b/gcc/testsuite/gfortran.dg/intrinsic_2.f90 @@ -0,0 +1,40 @@ +! { dg-do compile } +! { dg-options "-c -Wall" } +! +! PR fortran/40041 +! cf. also PR fortran/20373 + +subroutine valid_one + REAL :: a + INTEGER :: n + INTRINSIC ABS, MAX + a(n) = MAX(ABS(2),ABS(3),n) +end subroutine + +subroutine valid_two + IMPLICIT NONE + REAL :: a + INTEGER :: n + INTRINSIC ABS, MAX + a(n) = MAX(ABS(2),ABS(3),n) +end subroutine + +subroutine warnings_one + REAL :: a + INTEGER :: n + REAL :: ABS ! { dg-warning "Type specified for intrinsic function" } + REAL :: MAX ! { dg-warning "Type specified for intrinsic function" } + INTRINSIC ABS, MAX + a(n) = MAX(ABS(2),ABS(3),n) +end subroutine + +subroutine warnings_two + IMPLICIT NONE + REAL :: a + INTEGER :: n + INTRINSIC ABS ! { dg-warning "Type specified for intrinsic function" } + INTRINSIC MAX ! { dg-warning "Type specified for intrinsic function" } + REAL :: ABS + REAL :: MAX + a(n) = MAX(ABS(2),ABS(3),n) +end subroutine diff --git a/gcc/testsuite/gfortran.dg/proc_decl_1.f90 b/gcc/testsuite/gfortran.dg/proc_decl_1.f90 index 1df8b277c3f..25c018301f3 100644 --- a/gcc/testsuite/gfortran.dg/proc_decl_1.f90 +++ b/gcc/testsuite/gfortran.dg/proc_decl_1.f90 @@ -47,10 +47,6 @@ program prog procedure(dcos) :: my1 procedure(amax0) :: my2 ! { dg-error "not allowed in PROCEDURE statement" } - type t - procedure(),pointer:: p ! { dg-error "not yet implemented" } - end type - real f, x f(x) = sin(x**2) external oo diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_1.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_1.f90 new file mode 100644 index 00000000000..cbb69f1d50e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_1.f90 @@ -0,0 +1,65 @@ +! { dg-do run } +! +! PR39630: Fortran 2003: Procedure pointer components. +! +! Basic test for PPCs with SUBROUTINE interface and NOPASS. +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + + type t + integer :: i + procedure(sub), pointer, nopass :: ppc + procedure(), pointer, nopass :: proc + end type + + type, extends(t) :: t2 + procedure(), pointer, nopass :: proc2 + end type t2 + + type(t) :: x + type(t2) :: x2 + + procedure(sub),pointer :: pp + integer :: sum = 0 + + x%i = 1 + x%ppc => sub + pp => x%ppc + + call sub(1) + if (sum/=1) call abort + call pp(2) + if (sum/=3) call abort + call x%ppc(3) + if (sum/=6) call abort + + ! calling object as argument + x%proc => sub2 + call x%proc(x) + if (x%i/=7) call abort + + ! type extension + x%proc => sub + call x%proc(4) + if (sum/=10) call abort + x2%proc => sub + call x2%proc(5) + if (sum/=15) call abort + x2%proc2 => sub + call x2%proc2(6) + if (sum/=21) call abort + +contains + + subroutine sub(y) + integer, intent(in) :: y + sum = sum + y + end subroutine + + subroutine sub2(arg) + type(t),intent(inout) :: arg + arg%i = arg%i + sum + end subroutine + +end + diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_2.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_2.f90 new file mode 100644 index 00000000000..886e8bf70fe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_2.f90 @@ -0,0 +1,64 @@ +! { dg-do run } +! +! PR39630: Fortran 2003: Procedure pointer components. +! +! Basic test for PPCs with FUNCTION interface and NOPASS. +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + + type t
+ procedure(fcn), pointer, nopass :: ppc
+ procedure(abstr), pointer, nopass :: ppc1 + procedure(), nopass, pointer:: iptr3
+ integer :: i
+ end type
+
+ abstract interface
+ integer function abstr(x)
+ integer, intent(in) :: x
+ end function
+ end interface
+
+ type(t) :: obj
+ procedure(fcn), pointer :: f
+ integer :: base + + intrinsic :: iabs
+
+! Check with interface from contained function
+ obj%ppc => fcn
+ base=obj%ppc(2) + if (base/=4) call abort
+ call foo (obj%ppc,3)
+
+! Check with abstract interface
+ obj%ppc1 => obj%ppc
+ base=obj%ppc1(4) + if (base/=8) call abort
+ call foo (obj%ppc1,5)
+
+! Check compatibility components with non-components
+ f => obj%ppc
+ base=f(6) + if (base/=12) call abort
+ call foo (f,7) + +! Check with implicit interface + obj%iptr3 => iabs + base=obj%iptr3(-9) + if (base/=9) call abort
+
+contains
+
+ integer function fcn(x)
+ integer, intent(in) :: x
+ fcn = 2 * x
+ end function
+ + subroutine foo (arg, i) + procedure (fcn), pointer :: arg + integer :: i + if (arg(i)/=2*i) call abort + end subroutine +
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90 new file mode 100644 index 00000000000..34c27f3c451 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90 @@ -0,0 +1,46 @@ +! { dg-do compile } +! +! PR39630: Fortran 2003: Procedure pointer components. +! +! Probing some error messages. +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + +implicit none + +interface + subroutine sub + end subroutine +end interface + +external :: aaargh + +type :: t + procedure(sub), pointer :: ptr1 ! { dg-error "not yet implemented" } + procedure(real), pointer, nopass :: ptr2 + procedure(sub), pointer, nopass :: ptr3 + procedure(), pointer, nopass ptr4 ! { dg-error "Expected '::'" } + procedure(), pointer, nopass, pointer :: ptr5 ! { dg-error "Duplicate" } + procedure, pointer, nopass :: ptr6 ! { dg-error "Syntax error" } + procedure(), pointer, nopass :: ptr7 => ptr2 ! { dg-error "requires a NULL" } + procedure(), nopass :: ptr8 ! { dg-error "POINTER attribute is required" } + procedure(pp), pointer, nopass :: ptr9 ! { dg-error "declared in a later PROCEDURE statement" } + procedure(aaargh), pointer, nopass :: ptr10 ! { dg-error "must be explicit" } + real :: y +end type t + +procedure(sub), pointer :: pp + +type(t) :: x + +x%ptr2 => x ! { dg-error "Invalid procedure pointer assignment" } + +x => x%ptr2 ! { dg-error "Pointer assignment to non-POINTER" } + +call x%ptr2() ! { dg-error "attribute conflicts with" } +print *,x%ptr3() ! { dg-error "attribute conflicts with" } + +call x%y ! { dg-error "Expected type-bound procedure or procedure pointer component" } + +end + diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_4.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_4.f90 new file mode 100644 index 00000000000..b904a2f86aa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_4.f90 @@ -0,0 +1,120 @@ +! { dg-do compile } +! +! PR39630: Fortran 2003: Procedure pointer components. +! +! Original code by Juergen Reuter <juergen.reuter@physik.uni-freiburg.de> +! +! Adapted by Janus Weil <janus@gcc.gnu.org> + + +! Test for infinte recursion in trans-types.c when a PPC interface +! refers to the original type. + +module expressions + + type :: eval_node_t + logical, pointer :: lval => null () + type(eval_node_t), pointer :: arg1 => null () + procedure(unary_log), nopass, pointer :: op1_log => null () + end type eval_node_t + + abstract interface + logical function unary_log (arg) + import eval_node_t + type(eval_node_t), intent(in) :: arg + end function unary_log + end interface + +contains + + subroutine eval_node_set_op1_log (en, op) + type(eval_node_t), intent(inout) :: en + procedure(unary_log) :: op + en%op1_log => op + end subroutine eval_node_set_op1_log + + subroutine eval_node_evaluate (en) + type(eval_node_t), intent(inout) :: en + en%lval = en%op1_log (en%arg1) + end subroutine + +end module + + +! Test for C_F_PROCPOINTER and pointers to derived types + +module process_libraries + + implicit none + + type :: process_library_t + procedure(), nopass, pointer :: write_list + end type process_library_t + +contains + + subroutine process_library_load (prc_lib) + use iso_c_binding + type(process_library_t) :: prc_lib + type(c_funptr) :: c_fptr + call c_f_procpointer (c_fptr, prc_lib%write_list) + end subroutine process_library_load + + subroutine process_libraries_test () + type(process_library_t), pointer :: prc_lib + call prc_lib%write_list () + end subroutine process_libraries_test + +end module process_libraries + + +! Test for argument resolution + +module hard_interactions + + implicit none + + type :: hard_interaction_t + procedure(), nopass, pointer :: new_event + end type hard_interaction_t + + interface afv + module procedure afv_1 + end interface + +contains + + function afv_1 () result (a) + real, dimension(0:3) :: a + end function + + subroutine hard_interaction_evaluate (hi) + type(hard_interaction_t) :: hi + call hi%new_event (afv ()) + end subroutine + +end module hard_interactions + + +! Test for derived types with PPC working properly as function result. + + implicit none + + type :: var_entry_t + procedure(), nopass, pointer :: obs1_int + end type var_entry_t + + type(var_entry_t), pointer :: var + + var => var_list_get_var_ptr () + +contains + + function var_list_get_var_ptr () + type(var_entry_t), pointer :: var_list_get_var_ptr + end function var_list_get_var_ptr + +end + +! { dg-final { cleanup-modules "expressions process_libraries hard_interactions" } } + diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_5.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_5.f90 new file mode 100644 index 00000000000..216cb4e9b3a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_5.f90 @@ -0,0 +1,47 @@ +! { dg-do run } +! +! PR39630: Fortran 2003: Procedure pointer components. +! +! Nested types / double component references. +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + +abstract interface + subroutine as + end subroutine + integer function af() + end function +end interface + +type :: t1 + procedure(as), pointer, nopass :: s + procedure(af), pointer, nopass :: f +end type + +type :: t2 + type(t1) :: c +end type + +type(t2) :: x +integer :: j = 0 + +x%c%s => is +call x%c%s +if (j/=5) call abort + +x%c%f => if +j=x%c%f() +if (j/=42) call abort + +contains + +subroutine is + j = 5 +end subroutine + +integer function if() + if = 42 +end function + +end + diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_6.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_6.f90 new file mode 100644 index 00000000000..f0dcf4ccf01 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_6.f90 @@ -0,0 +1,64 @@ +! { dg-do run } +! +! PR39630: Fortran 2003: Procedure pointer components. +! +! test case taken from: +! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/4a827e8ced6efb0f/884b9eca6d7e6742?#884b9eca6d7e6742 +! http://fortranwiki.org/fortran/show/proc_component_example + +module proc_component_example + + type t + real :: a + procedure(print_int), pointer, & + nopass :: proc + end type t + + abstract interface + subroutine print_int (arg, lun) + import + type(t), intent(in) :: arg + integer, intent(in) :: lun + end subroutine print_int + end interface + + integer :: calls = 0 + +contains + + subroutine print_me (arg, lun) + type(t), intent(in) :: arg + integer, intent(in) :: lun + write (lun,*) arg%a + calls = calls + 1 + end subroutine print_me + + subroutine print_my_square (arg, lun) + type(t), intent(in) :: arg + integer, intent(in) :: lun + write (lun,*) arg%a**2 + calls = calls + 1 + end subroutine print_my_square + +end module proc_component_example + +program main + + use proc_component_example + use iso_fortran_env, only : output_unit + + type(t) :: x + + x%a = 2.71828 + + x%proc => print_me + call x%proc(x, output_unit) + x%proc => print_my_square + call x%proc(x, output_unit) + + if (calls/=2) call abort + +end program main + +! { dg-final { cleanup-modules "proc_component_example" } } + diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/pr40021.f b/gcc/testsuite/gfortran.fortran-torture/execute/pr40021.f new file mode 100644 index 00000000000..ddd269f2a46 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/pr40021.f @@ -0,0 +1,40 @@ +C Derived from lapack + PROGRAM test + DOUBLE PRECISION DA + INTEGER I, N + DOUBLE PRECISION DX(9),DY(9) + + EXTERNAL DAXPY + N=5 + DA=1.0 + DATA DX/-2, -1, -3, -4, 1, 2, 10, 15, 14/ + DATA DY/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ + CALL DAXPY (N,DA,DX,DY) + DO 10 I = 1, N + if (DX(I).ne.DY(I)) call abort +10 CONTINUE + STOP + END + + SUBROUTINE DAXPY(N,DA,DX,DY) + DOUBLE PRECISION DA + INTEGER N + DOUBLE PRECISION DX(*),DY(*) + INTEGER I,IX,IY,M,MP1 + INTRINSIC MOD + IF (N.LE.0) RETURN + 20 M = MOD(N,4) + IF (M.EQ.0) GO TO 40 + DO 30 I = 1,M + DY(I) = DY(I) + DA*DX(I) + 30 CONTINUE + IF (N.LT.4) RETURN + 40 MP1 = M + 1 + DO 50 I = MP1,N,4 + DY(I) = DY(I) + DA*DX(I) + DY(I+1) = DY(I+1) + DA*DX(I+1) + DY(I+2) = DY(I+2) + DA*DX(I+2) + DY(I+3) = DY(I+3) + DA*DX(I+3) + 50 CONTINUE + RETURN + END diff --git a/gcc/testsuite/lib/plugin-support.exp b/gcc/testsuite/lib/plugin-support.exp new file mode 100644 index 00000000000..79ccc93ba75 --- /dev/null +++ b/gcc/testsuite/lib/plugin-support.exp @@ -0,0 +1,109 @@ +# Copyright (C) 2009 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/>. +# + +# This file contains the support procedures for testing the plugin mechanism. + +load_lib dg.exp +load_lib gcc.exp + +# +# plugin-get-options -- process test directives +# +# SRC is the full pathname of the plugin source file. +# +proc plugin-get-options { src } { + # dg-options sets a variable called dg-extra-tool-flags. + set dg-extra-tool-flags "" + + # dg-require-* sets dg-do-what. + upvar dg-do-what dg-do-what + + set tmp [dg-get-options $src] + foreach op $tmp { + set cmd [lindex $op 0] + if { ![string compare "dg-options" $cmd] } { + set status [catch "$op" errmsg] + if { $status != 0 } { + perror "src: $errmsg for \"$op\"\n" + unresolved "$src: $errmsg for \"$op\"" + return + } + } else { + # Ignore unrecognized dg- commands, but warn about them. + warning "plugin.exp does not support $cmd" + } + } + + # Return flags to use for compiling the plugin source file + return ${dg-extra-tool-flags} +} + +# +# plugin-test-execute -- build the plugin first and then compile the +# test files with the plugin. +# +# PLUGIN_SRC is the full pathname of the plugin source file. +# PLUGIN_TESTS is a list of input test source files. +# +proc plugin-test-execute { plugin_src plugin_tests } { + global srcdir objdir + global verbose + global GMPINC + global HOSTCC + global HOSTCFLAGS + + set basename [file tail $plugin_src] + set base [file rootname $basename] + set plugin_lib $base.so + + verbose "Test the plugin $basename" 1 + + # Build the plugin itself + set extra_flags [plugin-get-options $plugin_src] + + # Note that the plugin test support currently only works when the GCC + # build tree is available. (We make sure that is the case in plugin.exp.) + # Once we have figured out how/where to package/install GCC header files + # for general plugin support, we should modify the following include paths + # accordingly. + set gcc_srcdir "$srcdir/../.." + set gcc_objdir "$objdir/../../.." + set includes "-I. -I${srcdir} -I${gcc_srcdir}/gcc -I${gcc_objdir}/gcc \ + -I${gcc_srcdir}/include -I${gcc_srcdir}/libcpp/include \ + $GMPINC" + + set optstr "$includes $extra_flags -DIN_GCC -fPIC -shared" + + # Temporarily switch to the environment for the host compiler. + restore_ld_library_path_env_vars + set status [remote_exec build "$HOSTCC $HOSTCFLAGS $plugin_src $optstr -o $plugin_lib"] + set status [lindex $status 0] + set_ld_library_path_env_vars + + if { $status != 0 } then { + unresolved "$basename compilation, $optstr" + return + } + + # Compile the input source files with the plugin + global default_flags + set plugin_enabling_flags "-fplugin=./$plugin_lib" + dg-runtest $plugin_tests $plugin_enabling_flags $default_flags + + # Clean up + remote_file build delete $plugin_lib +} diff --git a/gcc/timevar.def b/gcc/timevar.def index d3510a23af0..e6853756e66 100644 --- a/gcc/timevar.def +++ b/gcc/timevar.def @@ -182,6 +182,7 @@ DEFTIMEVAR (TV_THREAD_PROLOGUE_AND_EPILOGUE, "thread pro- & epilogue") DEFTIMEVAR (TV_IFCVT2 , "if-conversion 2") DEFTIMEVAR (TV_PEEPHOLE2 , "peephole 2") DEFTIMEVAR (TV_RENAME_REGISTERS , "rename registers") +DEFTIMEVAR (TV_CPROP_REGISTERS , "hard reg cprop") DEFTIMEVAR (TV_SCHED2 , "scheduling 2") DEFTIMEVAR (TV_MACH_DEP , "machine dep reorg") DEFTIMEVAR (TV_DBR_SCHED , "delay branch sched") diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 8b2fb21704f..383527990dd 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,9 @@ +2009-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/22423 + * io/transfer.c (read_block_direct): Avoid warning. + * runtime/string.c (compare0): Avoid warning. + 2009-04-30 Janne Blomqvist <jb@gcc.gnu.org> PR libfortran/39667 @@ -32,25 +38,25 @@ 2009-04-15 Danny Smith <dannysmith@clear.net.nz> - * io/write.c (itoa) : Rename back to gfc_itoa. - (write_i): Adjust call to write_decimal. - (write_integer): Use gfc_itoa. + * io/write.c (itoa) : Rename back to gfc_itoa. + (write_i): Adjust call to write_decimal. + (write_integer): Use gfc_itoa. 2009-04-10 Janne Blomqvist <jb@gcc.gnu.org> - * io/io.h (move_pos_offset): Remove prototype. - * io/transfer.c (formatted_transfer_scalar_read): Use sseek - instead of move_pos_offset. - * io/unix.c (move_pos_offset): Remove. + * io/io.h (move_pos_offset): Remove prototype. + * io/transfer.c (formatted_transfer_scalar_read): Use sseek + instead of move_pos_offset. + * io/unix.c (move_pos_offset): Remove. 2009-04-10 Janne Blomqvist <jb@gcc.gnu.org> PR libfortran/39665 libfortran/39702 libfortran/39709 * io/io.h (st_parameter_dt): Revert aligned attribute from u.p.value. - * io/list_read.c (read_complex): Read directly into user pointer. - (read_real): Likewise. - (list_formatted_read_scalar): Update read_complex and read_real calls. - (nml_read_obj): Read directly into user pointer. + * io/list_read.c (read_complex): Read directly into user pointer. + (read_real): Likewise. + (list_formatted_read_scalar): Update read_complex and read_real calls. + (nml_read_obj): Read directly into user pointer. 2009-04-09 Janne Blomqvist <jb@gcc.gnu.org> @@ -686,43 +692,43 @@ 2009-04-08 Janne Blomqvist <jb@gcc.gnu.org> - * io/open.c (already_open): Test for POSIX close return value. - * io/unit.c (close_unit_1): Likewise. - * io/unix.c (raw_close): Return 0 for success for preconnected units. + * io/open.c (already_open): Test for POSIX close return value. + * io/unit.c (close_unit_1): Likewise. + * io/unix.c (raw_close): Return 0 for success for preconnected units. 2009-04-08 Janne Blomqvist <jb@gcc.gnu.org> - * runtime/string.c (compare0): Use gfc_charlen_type. - * runtime/error.c (gfc_itoa): Move to io/write.c - (xtoa): Rename to gfc_xtoa. - * runtime/backtrace.c (show_backtrace): Call gfc_xtoa. - * intrinsics/cshift0.c (cshift0): Use index_type for shift arg. - * intrinsics/date_and_time.c (date_and_time): Use index_type. - (itime_i4): Likewise. - (itime_i8): Likewise. - (idate_i4): Likewise. - (idate_i8): Likewise. - (gmtime_i4): Likewise. - (gmtime_i8): Likewise. - (ltime_i4): Likewise. - (ltime_i8): Likewise. - * libgfortran.h (gfc_itoa): Remove prototype. - (xtoa): Rename prototype to gfc_xtoa. - * io/list_read.c (nml_read_obj): Use size_t for string length. - * io/transfer.c (read_block_direct): Change nbytes arg from - pointer to value. - (unformatted_read): Minor cleanup, call read_block_directly properly. - (skip_record): Use ssize_t. - (next_record_w_unf): Avoid stell() call by calling sseek with SEEK_CUR. - (iolength_transfer): Make sure to multiply before cast. - * io/intrinsics.c (fgetc): Remove unnecessary variable. - * io/format.c (format_hash): Use gfc_charlen_type. - * io/write.c (itoa): Move from runtime/error.c:gfc_itoa, rename, - make static. - (write_i): Call with pointer to itoa. - (write_z): Call with pointer to gfc_xtoa. - (write_integer): Pointer to itoa. - (nml_write_obj): Type cleanup, don't call strlen in loop. + * runtime/string.c (compare0): Use gfc_charlen_type. + * runtime/error.c (gfc_itoa): Move to io/write.c + (xtoa): Rename to gfc_xtoa. + * runtime/backtrace.c (show_backtrace): Call gfc_xtoa. + * intrinsics/cshift0.c (cshift0): Use index_type for shift arg. + * intrinsics/date_and_time.c (date_and_time): Use index_type. + (itime_i4): Likewise. + (itime_i8): Likewise. + (idate_i4): Likewise. + (idate_i8): Likewise. + (gmtime_i4): Likewise. + (gmtime_i8): Likewise. + (ltime_i4): Likewise. + (ltime_i8): Likewise. + * libgfortran.h (gfc_itoa): Remove prototype. + (xtoa): Rename prototype to gfc_xtoa. + * io/list_read.c (nml_read_obj): Use size_t for string length. + * io/transfer.c (read_block_direct): Change nbytes arg from + pointer to value. + (unformatted_read): Minor cleanup, call read_block_directly properly. + (skip_record): Use ssize_t. + (next_record_w_unf): Avoid stell() call by calling sseek with SEEK_CUR. + (iolength_transfer): Make sure to multiply before cast. + * io/intrinsics.c (fgetc): Remove unnecessary variable. + * io/format.c (format_hash): Use gfc_charlen_type. + * io/write.c (itoa): Move from runtime/error.c:gfc_itoa, rename, + make static. + (write_i): Call with pointer to itoa. + (write_z): Call with pointer to gfc_xtoa. + (write_integer): Pointer to itoa. + (nml_write_obj): Type cleanup, don't call strlen in loop. 2009-04-06 H.J. Lu <hongjiu.lu@intel.com> diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 27ae8994918..ea1ef7a44bf 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -465,7 +465,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t nbytes) /* Check whether we exceed the total record length. */ if (dtp->u.p.current_unit->flags.has_recl - && (nbytes > dtp->u.p.current_unit->bytes_left)) + && ((gfc_offset) nbytes > dtp->u.p.current_unit->bytes_left)) { to_read_record = dtp->u.p.current_unit->bytes_left; short_record = 1; diff --git a/libgfortran/runtime/string.c b/libgfortran/runtime/string.c index 5a81bd6d950..a102c3bd49a 100644 --- a/libgfortran/runtime/string.c +++ b/libgfortran/runtime/string.c @@ -36,7 +36,10 @@ compare0 (const char *s1, gfc_charlen_type s1_len, const char *s2) /* Strip trailing blanks from the Fortran string. */ len = fstrlen (s1, s1_len); - if (len != strlen(s2)) return 0; /* don't match */ + + if ((size_t) len != strlen(s2)) + return 0; /* don't match */ + return strncasecmp (s1, s2, len) == 0; } diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index 5b6e4e2a71f..45e0f2b6b39 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,29 @@ +2009-05-07 Paolo Carlini <paolo.carlini@oracle.com> + + * include/ext/throw_allocator.h: Remove redundante include. + +2009-05-07 Paolo Carlini <paolo.carlini@oracle.com> + + * include/ext/throw_allocator.h (throw_allocator_base): Avoid + out of line member functions definitions. + (throw_allocator_base::_S_g, _S_map, _S_throw_prob, _S_label): + Remove, use static locals instead. + (throw_allocator_base::do_check_allocated, print_to_string): Declare. + * src/throw_allocator.cc: New. + * src/Makefile.am: Add. + * config/abi/pre/gnu.ver: Add exports. + * src/Makefile.in: Regenerate. + +2009-05-07 Paolo Carlini <paolo.carlini@oracle.com> + + * configure.ac: Bump libtool_VERSION to 6:12:0. + * configure: Regenerate. + +2009-05-07 Matthias Klose <doko@ubuntu.com> + + PR libstdc++/40038 + * src/math_stubs_long_double.cc: Add ceill. + 2009-05-06 Johannes Singler <singler@ira.uka.de> PR libstdc++/39546 diff --git a/libstdc++-v3/config/abi/pre/gnu.ver b/libstdc++-v3/config/abi/pre/gnu.ver index 240e7bcf09b..f40fd97ef38 100644 --- a/libstdc++-v3/config/abi/pre/gnu.ver +++ b/libstdc++-v3/config/abi/pre/gnu.ver @@ -964,6 +964,10 @@ GLIBCXX_3.4.12 { _ZSt27__set_once_functor_lock_ptrPSt11unique_lockISt5mutexE; _ZSt16__get_once_mutexv; + # throw_allocator + _ZN9__gnu_cxx20throw_allocator_base18do_check_allocated*; + _ZN9__gnu_cxx20throw_allocator_base15print_to_string*; + } GLIBCXX_3.4.11; # Symbols in the support library (libsupc++) have their own tag. diff --git a/libstdc++-v3/configure b/libstdc++-v3/configure index 31678ebf212..a80bbaecb43 100755 --- a/libstdc++-v3/configure +++ b/libstdc++-v3/configure @@ -1567,7 +1567,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu ### am handles this now? ORIGINAL_LD_FOR_MULTILIBS=$LD # For libtool versioning info, format is CURRENT:REVISION:AGE -libtool_VERSION=6:11:0 +libtool_VERSION=6:12:0 # Find the rest of the source tree framework. diff --git a/libstdc++-v3/configure.ac b/libstdc++-v3/configure.ac index a07d9ff98f4..334e918e349 100644 --- a/libstdc++-v3/configure.ac +++ b/libstdc++-v3/configure.ac @@ -12,7 +12,7 @@ AC_CONFIG_HEADER(config.h) ### am handles this now? ORIGINAL_LD_FOR_MULTILIBS=$LD # For libtool versioning info, format is CURRENT:REVISION:AGE -libtool_VERSION=6:11:0 +libtool_VERSION=6:12:0 AC_SUBST(libtool_VERSION) # Find the rest of the source tree framework. diff --git a/libstdc++-v3/include/ext/throw_allocator.h b/libstdc++-v3/include/ext/throw_allocator.h index 13030546943..21e235c1200 100644 --- a/libstdc++-v3/include/ext/throw_allocator.h +++ b/libstdc++-v3/include/ext/throw_allocator.h @@ -47,7 +47,6 @@ #include <cmath> #include <ctime> #include <map> -#include <set> #include <string> #include <ostream> #include <stdexcept> @@ -64,13 +63,24 @@ _GLIBCXX_BEGIN_NAMESPACE(__gnu_cxx) std::tr1::mt19937 _M_generator; public: - twister_rand_gen(unsigned int s = static_cast<unsigned int>(std::time(0))); - + twister_rand_gen(unsigned int seed = + static_cast<unsigned int>(std::time(0))) + : _M_generator(seed) { } + void - init(unsigned int); - + init(unsigned int seed) + { _M_generator.seed(seed); } + double - get_prob(); + get_prob() + { + const double min = _M_generator.min(); + const double res = static_cast<const double>(_M_generator() - min); + const double range = static_cast<const double>(_M_generator.max() - min); + const double ret = res / range; + _GLIBCXX_DEBUG_ASSERT(ret >= 0 && ret <= 1); + return ret; + } }; /** @@ -96,30 +106,40 @@ _GLIBCXX_BEGIN_NAMESPACE(__gnu_cxx) { public: void - init(unsigned long seed); + init(unsigned long seed) + { rand_gen().init(seed); } static void - set_throw_prob(double throw_prob); + set_throw_prob(double t_p) + { throw_prob() = t_p; } static double - get_throw_prob(); + get_throw_prob() + { return throw_prob(); } static void - set_label(size_t l); + set_label(size_t l) + { label() = l; } + + static size_t + get_label() + { return label(); } static bool - empty(); + empty() + { return map().empty(); } struct group_throw_prob_adjustor { - group_throw_prob_adjustor(size_t size) : _M_throw_prob_orig(_S_throw_prob) + group_throw_prob_adjustor(size_t size) + : _M_throw_prob_orig(get_throw_prob()) { - _S_throw_prob = - 1 - std::pow(double(1 - _S_throw_prob), double(0.5 / (size + 1))); + set_throw_prob(1 - std::pow(double(1 - get_throw_prob()), + double(0.5 / (size + 1)))); } ~group_throw_prob_adjustor() - { _S_throw_prob = _M_throw_prob_orig; } + { set_throw_prob(_M_throw_prob_orig); } private: const double _M_throw_prob_orig; @@ -127,11 +147,12 @@ _GLIBCXX_BEGIN_NAMESPACE(__gnu_cxx) struct zero_throw_prob_adjustor { - zero_throw_prob_adjustor() : _M_throw_prob_orig(_S_throw_prob) - { _S_throw_prob = 0; } + zero_throw_prob_adjustor() + : _M_throw_prob_orig(get_throw_prob()) + { set_throw_prob(0); } ~zero_throw_prob_adjustor() - { _S_throw_prob = _M_throw_prob_orig; } + { set_throw_prob(_M_throw_prob_orig); } private: const double _M_throw_prob_orig; @@ -139,22 +160,43 @@ _GLIBCXX_BEGIN_NAMESPACE(__gnu_cxx) protected: static void - insert(void*, size_t); + insert(void* p, size_t size) + { + const_iterator found_it = map().find(p); + if (found_it != map().end()) + { + std::string error("throw_allocator_base::insert double insert!\n"); + print_to_string(error, make_entry(p, size)); + print_to_string(error, *found_it); + std::__throw_logic_error(error.c_str()); + } + map().insert(make_entry(p, size)); + } static void - erase(void*, size_t); + erase(void* p, size_t size) + { + check_allocated(p, size); + map().erase(p); + } static void - throw_conditionally(); + throw_conditionally() + { + if (rand_gen().get_prob() < get_throw_prob()) + __throw_forced_exception_error(); + } // See if a particular address and size has been allocated by this // allocator. static void - check_allocated(void*, size_t); + check_allocated(void* p, size_t size) + { do_check_allocated(map().find(p), map().end(), p, size); } // See if a given label has been allocated by this allocator. static void - check_allocated(size_t); + check_allocated(size_t label) + { do_check_allocated(map().begin(), map().end(), label); } private: typedef std::pair<size_t, size_t> alloc_data_type; @@ -167,20 +209,59 @@ _GLIBCXX_BEGIN_NAMESPACE(__gnu_cxx) operator<<(std::ostream&, const throw_allocator_base&); static entry_type - make_entry(void*, size_t); + make_entry(void* p, size_t size) + { return std::make_pair(p, alloc_data_type(get_label(), size)); } + + static void + do_check_allocated(const_iterator, const_iterator, void*, size_t); static void - print_to_string(std::string&); + do_check_allocated(const_iterator, const_iterator, size_t); static void print_to_string(std::string&, const_reference); - static twister_rand_gen _S_g; - static map_type _S_map; - static double _S_throw_prob; - static size_t _S_label; + static map_type& + map() + { + static map_type mp; + return mp; + } + + static twister_rand_gen& + rand_gen() + { + static twister_rand_gen rg; + return rg; + } + + static double& + throw_prob() + { + static double tp; + return tp; + } + + static size_t& + label() + { + static size_t ll; + return ll; + } }; + inline std::ostream& + operator<<(std::ostream& os, const throw_allocator_base&) + { + std::string error; + typedef throw_allocator_base alloc_type; + alloc_type::const_iterator beg = alloc_type::map().begin(); + alloc_type::const_iterator end = alloc_type::map().end(); + for (; beg != end; ++beg) + alloc_type::print_to_string(error, *beg); + return os << error; + } + /** * @brief Allocator class with logging and exception control. * @ingroup allocators @@ -273,176 +354,6 @@ _GLIBCXX_BEGIN_NAMESPACE(__gnu_cxx) operator!=(const throw_allocator<T>&, const throw_allocator<T>&) { return false; } - std::ostream& - operator<<(std::ostream& os, const throw_allocator_base& alloc) - { - std::string error; - throw_allocator_base::print_to_string(error); - os << error; - return os; - } - - // XXX Should be in .cc. - twister_rand_gen:: - twister_rand_gen(unsigned int seed) : _M_generator(seed) { } - - void - twister_rand_gen:: - init(unsigned int seed) - { _M_generator.seed(seed); } - - double - twister_rand_gen:: - get_prob() - { - const double min = _M_generator.min(); - const double res = static_cast<const double>(_M_generator() - min); - const double range = static_cast<const double>(_M_generator.max() - min); - const double ret = res / range; - _GLIBCXX_DEBUG_ASSERT(ret >= 0 && ret <= 1); - return ret; - } - - twister_rand_gen throw_allocator_base::_S_g; - - throw_allocator_base::map_type - throw_allocator_base::_S_map; - - double throw_allocator_base::_S_throw_prob; - - size_t throw_allocator_base::_S_label = 0; - - throw_allocator_base::entry_type - throw_allocator_base::make_entry(void* p, size_t size) - { return std::make_pair(p, alloc_data_type(_S_label, size)); } - - void - throw_allocator_base::init(unsigned long seed) - { _S_g.init(seed); } - - void - throw_allocator_base::set_throw_prob(double throw_prob) - { _S_throw_prob = throw_prob; } - - double - throw_allocator_base::get_throw_prob() - { return _S_throw_prob; } - - void - throw_allocator_base::set_label(size_t l) - { _S_label = l; } - - void - throw_allocator_base::insert(void* p, size_t size) - { - const_iterator found_it = _S_map.find(p); - if (found_it != _S_map.end()) - { - std::string error("throw_allocator_base::insert"); - error += "double insert!"; - error += '\n'; - print_to_string(error, make_entry(p, size)); - print_to_string(error, *found_it); - std::__throw_logic_error(error.c_str()); - } - _S_map.insert(make_entry(p, size)); - } - - bool - throw_allocator_base::empty() - { return _S_map.empty(); } - - void - throw_allocator_base::erase(void* p, size_t size) - { - check_allocated(p, size); - _S_map.erase(p); - } - - void - throw_allocator_base::check_allocated(void* p, size_t size) - { - const_iterator found_it = _S_map.find(p); - if (found_it == _S_map.end()) - { - std::string error("throw_allocator_base::check_allocated by value "); - error += "null erase!"; - error += '\n'; - print_to_string(error, make_entry(p, size)); - std::__throw_logic_error(error.c_str()); - } - - if (found_it->second.second != size) - { - std::string error("throw_allocator_base::check_allocated by value "); - error += "wrong-size erase!"; - error += '\n'; - print_to_string(error, make_entry(p, size)); - print_to_string(error, *found_it); - std::__throw_logic_error(error.c_str()); - } - } - - void - throw_allocator_base::check_allocated(size_t label) - { - std::string found; - const_iterator it = _S_map.begin(); - while (it != _S_map.end()) - { - if (it->second.first == label) - { - print_to_string(found, *it); - } - ++it; - } - - if (!found.empty()) - { - std::string error("throw_allocator_base::check_allocated by label "); - error += '\n'; - error += found; - std::__throw_logic_error(error.c_str()); - } - } - - void - throw_allocator_base::throw_conditionally() - { - if (_S_g.get_prob() < _S_throw_prob) - __throw_forced_exception_error(); - } - - void - throw_allocator_base::print_to_string(std::string& s) - { - const_iterator begin = throw_allocator_base::_S_map.begin(); - const_iterator end = throw_allocator_base::_S_map.end(); - for (; begin != end; ++begin) - print_to_string(s, *begin); - } - - void - throw_allocator_base::print_to_string(std::string& s, const_reference ref) - { - char buf[40]; - const char tab('\t'); - s += "address: "; - __builtin_sprintf(buf, "%p", ref.first); - s += buf; - s += tab; - s += "label: "; - unsigned long l = static_cast<unsigned long>(ref.second.first); - __builtin_sprintf(buf, "%lu", l); - s += buf; - s += tab; - s += "size: "; - l = static_cast<unsigned long>(ref.second.second); - __builtin_sprintf(buf, "%lu", l); - s += buf; - s += '\n'; - } - _GLIBCXX_END_NAMESPACE #endif diff --git a/libstdc++-v3/src/Makefile.am b/libstdc++-v3/src/Makefile.am index d218ceaa9ca..288243aab26 100644 --- a/libstdc++-v3/src/Makefile.am +++ b/libstdc++-v3/src/Makefile.am @@ -182,6 +182,7 @@ sources = \ streambuf-inst.cc \ streambuf.cc \ string-inst.cc \ + throw_allocator.cc \ valarray-inst.cc \ wlocale-inst.cc \ wstring-inst.cc \ diff --git a/libstdc++-v3/src/Makefile.in b/libstdc++-v3/src/Makefile.in index 9ee5275198b..24187af1dae 100644 --- a/libstdc++-v3/src/Makefile.in +++ b/libstdc++-v3/src/Makefile.in @@ -85,12 +85,13 @@ am__libstdc___la_SOURCES_DIST = atomic.cc bitmap_allocator.cc \ fstream-inst.cc ext-inst.cc ios-inst.cc iostream-inst.cc \ istream-inst.cc istream.cc locale-inst.cc misc-inst.cc \ ostream-inst.cc sstream-inst.cc streambuf-inst.cc streambuf.cc \ - string-inst.cc valarray-inst.cc wlocale-inst.cc \ - wstring-inst.cc mutex.cc condition_variable.cc chrono.cc \ - thread.cc atomicity.cc codecvt_members.cc collate_members.cc \ - ctype_members.cc messages_members.cc monetary_members.cc \ - numeric_members.cc time_members.cc basic_file.cc c++locale.cc \ - compatibility-ldbl.cc parallel_list.cc parallel_settings.cc + string-inst.cc throw_allocator.cc valarray-inst.cc \ + wlocale-inst.cc wstring-inst.cc mutex.cc condition_variable.cc \ + chrono.cc thread.cc atomicity.cc codecvt_members.cc \ + collate_members.cc ctype_members.cc messages_members.cc \ + monetary_members.cc numeric_members.cc time_members.cc \ + basic_file.cc c++locale.cc compatibility-ldbl.cc \ + parallel_list.cc parallel_settings.cc am__objects_1 = atomicity.lo codecvt_members.lo collate_members.lo \ ctype_members.lo messages_members.lo monetary_members.lo \ numeric_members.lo time_members.lo @@ -111,9 +112,9 @@ am__objects_5 = atomic.lo bitmap_allocator.lo pool_allocator.lo \ fstream-inst.lo ext-inst.lo ios-inst.lo iostream-inst.lo \ istream-inst.lo istream.lo locale-inst.lo misc-inst.lo \ ostream-inst.lo sstream-inst.lo streambuf-inst.lo streambuf.lo \ - string-inst.lo valarray-inst.lo wlocale-inst.lo \ - wstring-inst.lo mutex.lo condition_variable.lo chrono.lo \ - thread.lo $(am__objects_1) $(am__objects_4) + string-inst.lo throw_allocator.lo valarray-inst.lo \ + wlocale-inst.lo wstring-inst.lo mutex.lo condition_variable.lo \ + chrono.lo thread.lo $(am__objects_1) $(am__objects_4) am_libstdc___la_OBJECTS = $(am__objects_5) libstdc___la_OBJECTS = $(am_libstdc___la_OBJECTS) DEFAULT_INCLUDES = -I. -I$(srcdir) -I$(top_builddir) @@ -434,6 +435,7 @@ sources = \ streambuf-inst.cc \ streambuf.cc \ string-inst.cc \ + throw_allocator.cc \ valarray-inst.cc \ wlocale-inst.cc \ wstring-inst.cc \ diff --git a/libstdc++-v3/src/math_stubs_long_double.cc b/libstdc++-v3/src/math_stubs_long_double.cc index 1b59034eb71..9f760cfb32f 100644 --- a/libstdc++-v3/src/math_stubs_long_double.cc +++ b/libstdc++-v3/src/math_stubs_long_double.cc @@ -70,6 +70,14 @@ extern "C" } #endif +#ifndef _GLIBCXX_HAVE_CEILL + long double + ceill(long double x) + { + return ceil((double) x); + } +#endif + #ifndef _GLIBCXX_HAVE_COSL long double cosl(long double x) diff --git a/libstdc++-v3/src/throw_allocator.cc b/libstdc++-v3/src/throw_allocator.cc new file mode 100644 index 00000000000..a8247ad9782 --- /dev/null +++ b/libstdc++-v3/src/throw_allocator.cc @@ -0,0 +1,95 @@ +// Throw Allocator. Out of line function definitions. -*- C++ -*- + +// Copyright (C) 2009 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 +// terms of the GNU General Public License as published by the +// Free Software Foundation; either version 3, or (at your option) +// any later version. + +// This library 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. + +// Under Section 7 of GPL version 3, you are granted additional +// permissions described in the GCC Runtime Library Exception, version +// 3.1, as published by the Free Software Foundation. + +// You should have received a copy of the GNU General Public License and +// a copy of the GCC Runtime Library Exception along with this program; +// see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +// <http://www.gnu.org/licenses/>. + +#include <ext/throw_allocator.h> + +_GLIBCXX_BEGIN_NAMESPACE(__gnu_cxx) + + void + throw_allocator_base::do_check_allocated(const_iterator found, + const_iterator end, + void* p, size_t size) + { + if (found == end) + { + std::string error("throw_allocator_base::check_allocated by value " + "null erase!\n"); + print_to_string(error, make_entry(p, size)); + std::__throw_logic_error(error.c_str()); + } + + if (found->second.second != size) + { + std::string error("throw_allocator_base::check_allocated by value " + "wrong-size erase!\n"); + print_to_string(error, make_entry(p, size)); + print_to_string(error, *found); + std::__throw_logic_error(error.c_str()); + } + } + + void + throw_allocator_base::do_check_allocated(const_iterator beg, + const_iterator end, + size_t label) + { + std::string found; + while (beg != end) + { + if (beg->second.first == label) + print_to_string(found, *beg); + ++beg; + } + + if (!found.empty()) + { + std::string error("throw_allocator_base::check_allocated by label \n"); + error += found; + std::__throw_logic_error(error.c_str()); + } + } + + void + throw_allocator_base::print_to_string(std::string& s, + const_reference ref) + { + char buf[40]; + const char tab('\t'); + s += "address: "; + __builtin_sprintf(buf, "%p", ref.first); + s += buf; + s += tab; + s += "label: "; + unsigned long l = static_cast<unsigned long>(ref.second.first); + __builtin_sprintf(buf, "%lu", l); + s += buf; + s += tab; + s += "size: "; + l = static_cast<unsigned long>(ref.second.second); + __builtin_sprintf(buf, "%lu", l); + s += buf; + s += '\n'; + } + +_GLIBCXX_END_NAMESPACE |