diff options
Diffstat (limited to 'contrib/gcc/f')
31 files changed, 1260 insertions, 1588 deletions
diff --git a/contrib/gcc/f/ChangeLog b/contrib/gcc/f/ChangeLog index 567bc7b..57838b0 100644 --- a/contrib/gcc/f/ChangeLog +++ b/contrib/gcc/f/ChangeLog @@ -1,48 +1,278 @@ -2003-02-05 Release Manager +2003-07-09 Toon Moene <toon@moene.indiv.nluug.nl> - * GCC 3.2.2 Released. + PR Fortran/11301 + * com.c (ffecom_sym_transform_): finish_decl should have + the same last argument as start_decl. -2003-01-28 Christian Cornelssen <ccorn@cs.tu-berlin.de> +Tue Jul 8 15:18:14 2003 Andreas Schwab <schwab@suse.de> + + * Make-lang.in (f/g77.dvi): Replace PWD with PWD_COMMAND. + +2003-07-05 Toon Moene <toon@moene.indiv.nluug.nl> + + PR Fortran/11301 + * com.c (ffecom_sym_transform_): Only install + FFEINFO_whereGLOBAL symbols in the global binding + level if not -fno-globals. + +2003-06-13 Richard Henderson <rth@redhat.com> + + PR debug/9864 + * com.c (ffecom_sym_transform_): Install FFEINFO_whereGLOBAL + symbols in the global binding level. + +2003-05-18 Toon Moene <toon@moene.indiv.nluug.nl> + + PR fortran/10726 + * intdoc.in: Fix documentation of IDATE. + * intdoc.texi: Regenerate. + * news.texi: Update due to the above. + +2003-05-16 Wolfgang Bangerth <bangerth@dealii.org> + + * g77.texi: Remove most of the preface of the bugs section. + +2003-05-15 Wolfgang Bangerth <bangerth@dealii.org> + + * g77.texi: Remove most of the bug reporting instructions and + merge them into bugs.html. + +2003-05-13 Release Manager + + * GCC 3.3 Released. + +2003-05-13 Release Manager + + * GCC 3.3 Released. + +2003-05-13 Release Manager + + * GCC 3.3 Released. + +2003-04-11 Bud Davis <bdavis9659@comcast.net> + + PR Fortran/9263 + * gcc/f/data.c (ffedata_advance_): Check initial, final and + increment values for INTEGER typeness. + * gcc/f/news.texi: Document these fixes. + +2003-03-26 Roger Sayle <roger@eyesopen.com> + + PR fortran/9793 + * target.h (ffetarget_divide_integer1): Perform division by -1 + using negation to prevent possible overflow trap on the host. + +2003-03-25 Marcelo Abreu <mmabreu@inf.ufrgs.br> + + PR fortran/10204 + * ffe.texi: Reference the GCC web site in the URL. + +2003-03-24 Toon Moene <toon@moene.indiv.nluug.nl> + + PR fortran/10197 + * news.texi: Document PR fortran/10197 fixed. + +Sun Mar 23 23:43:45 2003 Mark Mitchell <mark@codesourcery.com> + + PR c++/7086 + * com.c (ffecom_sym_transform_): Adjust calls to + put_var_into_stack. + (ffe_mark_addressable): Likewise. + +2003-03-22 Bud Davis <bdavis9659@comcast.net> + + * com.c (ffecom_constantunion_with_type): New function. + * com.h (ffecom_constantunion_with_type): Declare. + * stc.c (ffestc_R810): Check for kind type. + * ste.c (ffeste_R810): Use ffecom_constantunion_with_type + to discern SELECT CASE variables. + +2003-03-15 Andreas Jaeger <aj@suse.de> + + * g77spec.c (DEFAULT_SWITCH_TAKES_ARG): Remove. + (DEFAULT_WORD_SWITCH_TAKES_ARG): Remove. + +2003-02-21 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Document fixing PR fortran/9038. + +2003-02-04 Joseph S. Myers <jsm@polyomino.org.uk> + + * g77.texi, invoke.texi: Update to GFDL 1.2. + +2003-01-30 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Document fixing PR fortran/7681 + and PR optimization/9258. + +2003-01-26 Toon Moene <toon@moene.indiv.nluug.nl> + + * lang-specs.h: Revert change to solve 9038. + * news.texi: Document this. + +2003-01-26 Christian Cornelssen <ccorn@cs.tu-berlin.de> * Make-lang.in (f77.install-common, f77.install-info) (f77.install-man, f77.uninstall): Prepend $(DESTDIR) to destination paths in all (un)installation commands. -2002-11-22 Toon Moene <toon@moene.indiv.nluug.nl> +2003-01-05 Steven Bosscher <s.bosscher@student.tudelft.nl> + + PR Fortran/9038 + * lang-specs.h: Prevent -f<option> from being passed + to cc1. + * news.texi: Document this fix. + +2003-01-03 Bud Davis <bdavis11@directvinternet.com> + + * stc.c (ffestc_R810): Allow any kind integer in + case statements. + * ste.c (ffeste_R810): Give error message when + case selector exceeds its valid values. + +2003-01-01 Andreas Jaeger <aj@suse.de> + + * f/Make-lang.in ($(srcdir)/f/BUGS): Add include path for + gcc-common.texi. + ($(srcdir)/f/NEWS): Likewise. + +2002-12-28 Joseph S. Myers <jsm@polyomino.org.uk> + + * g77.texi: Use @copying. + +2002-12-23 Joseph S. Myers <jsm@polyomino.org.uk> + + * root.texi: Include gcc-common.texi. + * bugs.texi, news.texi: Don't include root.texi as part of full + manual. + * g77.texi: Update for use of gcc-common.texi. + * Make-lang.in ($(srcdir)/f/g77.info, f/g77.dvi): Depend on + $(srcdir)/doc/include/gcc-common.texi. + +2002-12-19 Kazu Hirata <kazu@cs.umass.edu> + + * intdoc.in: Fix typos. + +2002-12-18 Kazu Hirata <kazu@cs.umass.edu> + + * g77.texi: Fix typos. + * intdoc.texi: Likewise. + * news.texi: Follow spelling conventions. + +Mon Dec 16 13:55:24 2002 Mark Mitchell <mark@codesourcery.com> + + * root.texi (DEVELOPMENT): @clear it. + +2002-11-20 Toon Moene <toon@moene.indiv.nluug.nl> * invoke.texi: Explain the purpose of -fmove-all-movables, -freduce-all-givs and -frerun-loop-opts better. -2002-11-19 Release Manager +2002-11-19 Toon Moene <toon@moene.indiv.nluug.nl> - * GCC 3.2.1 Released. + PR fortran/8587 + * news.texi: Show PR fortran/8587 fixed. -2002-11-19 Release Manager +2002-11-19 Jason Thorpe <thorpej@wasabisystems.com> - * GCC 3.2.1 Released. + * g77spec.c (lang_specific_spec_functions): New. -2002-11-18 Release Manager +2002-11-02 Toon Moene <toon@moene.indiv.nluug.nl> - * GCC 3.2.1 Released. + * g77.texi: Correct documentation on generating C++ prototypes + of Fortran routines with f2c. + * news.texi: Document fixes in GCC-3.3, 3.2 and 3.1. -2002-10-28 Andris Pavenis <pavenis@latnet.lv> - Toon Moene <toon@moene.indiv.nluug.nl> +2002-10-30 Roger Sayle <roger@eyesopen.com> - PR fortran/8308 - * lang-specs.h: Correct ratfor specs. - * news.texi: Document this fix. + * com.c (ffecom_subscript_check_): Cast the failure branch + of the bounds check COND_EXPR to void, to indicate noreturn. + (ffe_truthvalue_conversion): Only apply truth value conversion + to the non-void branches of a COND_EXPR. -2002-09-14 Hans-Peter Nilsson <hp@bitrange.com> +2002-10-26 Andris Pavenis <pavenis@latnet.lv> - * target.c (ffetarget_memcpy_): Don't test nonexistent - HOST_BYTES_BIG_ENDIAN, HOST_BITS_BIG_ENDIAN. Check - HOST_WORDS_BIG_ENDIAN against both WORDS_BIG_ENDIAN and - BYTES_BIG_ENDIAN. + * lang-specs.h: Fix ratfor specs. + +2002-10-15 Richard Henderson <rth@redhat.com> + + * target.h (ffetarget_print_real1, ffetarget_print_real2): Use + real_to_decimal directly, and with the new arguments. + +2002-09-23 Zack Weinberg <zack@codesourcery.com> + + * Make-lang.in (g77spec.o): Don't depend on f/version.h. + (f/parse.o): Depend on version.h not f/version.h. + (g77version.o, f/version.o): Delete all references. + + * com.c (ffecom_init_0): Fix transposed array indices in bsearch test. + * g77spec.c: Don't include f/version.h or refer to ffe_version_string. + * parse.c: Use version_string, not ffe_version_string. + * version.c, version.h: Delete files. + +2002-09-23 Kazu Hirata <kazu@cs.umass.edu> + + * ChangeLog: Follow spelling conventions. + * ChangeLog.0: Likewise. + * com.c: Likewise. + * ffe.texi: Likewise. + * g77.texi: Likewise. + * intdoc.in: Likewise. + * invoke.texi: Likewise. + * news.texi: Likewise. + * intdoc.texi: Regenerate. + +2002-09-16 Geoffrey Keating <geoffk@apple.com> + + * com.c (union lang_tree_node): Add chain_next option. + +2002-09-16 Richard Henderson <rth@redhat.com> + + * target.c (ffetarget_real1): Don't pass FFETARGET_ATOF_ + directly to ffetarget_make_real1. + (ffetarget_real2): Similarly. + * target.h (ffetarget_cvt_r1_to_rv_, ffetarget_cvt_rv_to_r2_, + ffetarget_cvt_r2_to_rv_): Use new real.h interface and simplify. + +2002-09-15 Kazu Hirata <kazu@cs.umass.edu> + + * intdoc.texi: Regenerate. + +2002-09-15 Kazu Hirata <kazu@cs.umass.edu> + + * ChangeLog: Follow spelling conventions. + * intdoc.in: Likewise. + +2002-09-09 Gerald Pfeifer <pfeifer@dbai.tuwien.ac.at> + + Fix PR web/7596: + * ffe.texi (Front End): Fix broken links. + * bugs.texi (Known Bugs): Refer to gcc.gnu.org instead of + www.gnu.org for onlinedocs. + * news.texi (News): Ditto. 2002-09-07 Jan Hubicka <jh@suse.cz> * com.c (ffe_type_for_mode): Handle long double. +2002-09-04 Richard Henderson <rth@redhat.com> + + * target.h (ffetarget_print_real1, ffetarget_print_real2): Update + call to REAL_VALUE_TO_DECIMAL. + +2002-08-31 Toon Moene <toon@moene.indiv.nluug.nl> + + * com.c: Don't set flag_finite_math_only by default. + * invoke.texi: Reverse the documentation of option + -ffinite-math-only to reflect the new default. + +2002-08-30 Hans-Peter Nilsson <hp@bitrange.com> + + * target.c (ffetarget_memcpy_): Don't test nonexistent + HOST_BYTES_BIG_ENDIAN, HOST_BITS_BIG_ENDIAN. Check + HOST_WORDS_BIG_ENDIAN against both WORDS_BIG_ENDIAN and + BYTES_BIG_ENDIAN. + 2002-08-30 Alan Modra <amodra@bigpond.net.au> * target.h (FFETARGET_32bit_longs): Don't define for powerpc64 or @@ -53,45 +283,186 @@ * bugs.texi, news.texi: Update URLs for online news and bugs lists. -2002-08-14 Release Manager +2002-08-22 Hans-Peter Nilsson <hp@bitrange.com> + + * where.h (struct _ffewhere_file_): Mark GTY. + (ffewhere_file_kill): Remove prototype. + * where.c: Include ggc.h. + (struct _ffewhere_ll_, struct _ffewhere_root_ll_): Mark GTY. + (ffewhere_root_ll_): Ditto. Change type from struct + _ffewhere_root_ll_ to struct _ffewhere_root_ll_*. All uses + changed. + (ffewhere_file_kill): Remove. + (ffewhere_file_new): Use GC to allocate ffewhereFile objects. + (ffewhere_file_set): Use GC to allocate ffewhereLL_ objects. + (ffewhere_init_1): Use GC to allocate ffewhere_root_ll_ sentinel. + Include gt-f-where.h. + * lex.c (ffelex_current_wf_, ffelex_include_wherefile_): Mark GTY. + Include gt-f-lex.h. + * std.c (ffestd_S3P4): Don't call ffewhere_file_kill. + * config-lang.in (gtfiles): Add f/where.h f/where.c and f/lex.c. + * Make-lang.in (gt-f-lex.h gt-f-where.h): Add to dependents of + s-gtype. + (f/lex.o): Depend on gt-f-lex.h. + (f/where.o): Depend on gt-f-where.h. + +Tue Aug 20 16:49:40 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * where.c (ffewhere_track): Remove impossible if-then clause. + +Thu Aug 8 10:06:14 2002 Nathan Sidwell <nathan@codesourcery.com> + + * f/Make-lang.in (f.mostlyclean): Remove coverage files. + +2002-08-06 Gerald Pfeifer <pfeifer@dbai.tuwien.ac.at> + + * g77.texi (Top): Rename Index to Keyword Index. - * GCC 3.2 Released. +2002-08-05 Toon Moene <toon@moene.indiv.nluug.nl> -2002-08-04 Toon Moene <toon@moene.indiv.nluug.nl> + * invoke.texi: Improve description of + -fno-finite-math-only flag. - * news.texi: Mention nothing changed for 3.2. +Sun Aug 4 16:45:49 2002 Joseph S. Myers <jsm@polyomino.org.uk> -Sun Aug 4 16:48:53 2002 Joseph S. Myers <jsm@polyomino.org.uk> + * root.texi (version-gcc): Increase to 3.3. - * root.texi (version-gcc): Increase to 3.2. +2002-07-30 Toon Moene <toon@moene.indiv.nluug.nl> -2002-07-25 Release Manager + * com.c (ffe_init_options): Set + flag_finite_math_only. + * invoke.texi: Document -fno-finite-math-only. - * GCC 3.1.1 Released. +Mon Jul 29 22:05:35 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> -2002-06-30 Toon Moene <toon@moene.indiv.nluug.nl> + * com.c (read_name_map): Use concat in lieu of xmalloc/strcpy. + +2002-07-25 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Document better handling of (no-)alias + information of dummy arguments and induction variables + on loop unrolling. + +2002-07-01 Roger Sayle <roger@eyesopen.com> + + * f/com.c (builtin_function): Accept additional parameter. + (ffe_com_init_0): Pass an additional NULL_TREE argument to + builtin_function. + +2002-06-28 Toon Moene <toon@moene.indiv.nluug.nl> * news.texi: Mention 2 Gbyte limit on 32-bit targets for arrays explicitly in news on g77-3.1. -2002-05-14 Release Manager +Thu Jun 20 21:56:34 2002 Neil Booth <neil@daikokuya.co.uk> + + * lang-specs.h: Use cc1 for traditional preprocessing. + +2002-06-20 Andreas Jaeger <aj@suse.de> + + * com.c (ffecom_prepare_expr_,ffecom_expr_power_integer_): + Remove #ifdefed HAHA sections. + +2002-06-20 Nathanael Nerode <neroden@twcny.rr.com> + + * com.c: Remove #ifdef HOHO sections. + +2002-06-17 Jason Thorpe <thorpej@wasabisystems.com> - * GCC 3.1 Released. + * bit.c: Don't include glimits.h. + * target.c: Likewise. + * where.h: Likewise. -2002-05-14 Release Manager +2002-06-12 Gabriel Dos Reis <gdr@codesourcery.com> - * GCC 3.1 Released. + * bad.c (ffebad_start_): Adjust calls to diagnostic_count_error. + +2002-06-04 Gabriel Dos Reis <gdr@codesourcery.com> + + * bad.c (ffebad_start_): Adjust call to count_error. + * Make-lang.in (f/bad.o): Depend on diagnostic.h + * bad.c: #include diagnostic.h + +2002-06-03 Geoffrey Keating <geoffk@redhat.com> + + * Make-lang.in (f/com.o): Depend on debug.h. + * com.c: Include debug.h. + (LANG_HOOKS_MARK_TREE): Delete. + (struct lang_identifier): Use gengtype. + (union lang_tree_node): New. + (struct lang_decl): New dummy definition. + (struct lang_type): New dummy definition. + (ffe_mark_tree): Delete. + + * com.c (struct language_function): New dummy structure. + + * Make-lang.in: Add rules to generate gt-f-ste.h gtype-f.h; allow + for filename changes. + (com.o): Allow for filename changes; add gtype-f.h as dependency. + (ste.o): Add gt-f-ste.h as dependency. + * config-lang.in (gtfiles): Add com.h, ste.c. + * com.c: Replace uses of ggc_add_* with GTY markers. Include + gtype-f.h. + (mark_binding_level): Delete. + * com.h: Replace uses of ggc_add_* with GTY markers. + * ste.c: Replace uses of ggc_add_* with GTY markers. Include + gt-f-ste.h. + + * Make-lang.in (f/gt-com.h): Build using gengtype. + (com.o): Depend on f/gt-com.h. + * com.c: Rename struct binding_level to f_binding_level. + (struct f_binding_level): Use gengtype. + (struct tree_ggc_tracker): Use gengtype. + (mark_tracker_head): Use gt_ggc_m_tree_ggc_tracker. + (make_binding_level): Use GGC. + (mark_binding_level): Use gt_ggc_m_f_binding_level. + (ffecom_init_decl_processing): Change free_binding_level + to a deletable root. + * config-lang.in (gtfiles): Define. + * where.c: Strings need no longer be allocated in GCable memory; + remove my change of 30 Dec 1999. + +2002-05-31 Matthew Woodcraft <mattheww@chiark.greenend.org.uk> + + * lang-specs.h: Use cpp_debug_options. + +2002-05-28 Zack Weinberg <zack@codesourcery.com> + + * bld.c, com.c, expr.c, target.c: Include real.h. + * Make-lang.in: Update dependency lists. + +2002-05-16 Rainer Orth <ro@TechFak.Uni-Bielefeld.DE> + + * Make-lang.in: Allow for PWDCMD to override hardcoded pwd. + +2002-05-09 Hassan Aurag <aurag@cae.com> + + * expr.c (ffeexpr_reduced_ugly2log_): Allow logicals-as-integers + under -fugly-logint as arguments of .and., .or., .xor. + +2002-05-07 Jan Hubicka <jh@suse.cz> + + * target.h (FFETARGET_32bit_longs): Undefine for x86-64. 2002-04-29 Joseph S. Myers <jsm28@cam.ac.uk> * invoke.texi: Use @gol at ends of lines inside @gccoptlist. * g77.texi: Update last update date. +Thu Apr 25 07:44:44 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.h (ffe_parse_file): Update. + * lex.c (ffe_parse_file): Update. + 2002-04-20 Toon Moene <toon@moene.indiv.nluug.nl> * root.texi: Remove variable version-g77. * g77.texi: Remove the single use of that variable. +Thu Apr 18 19:10:44 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (incomplete_type_error): Remove. + Tue Apr 16 14:55:47 2002 Mark Mitchell <mark@codesourcery.com> * com.c (ffecom_expr_power_integer): Add has_scope argument to @@ -101,21 +472,63 @@ Mon Apr 15 10:59:14 2002 Mark Mitchell <mark@codesourcery.com> * g77.texi: Remove Chill reference. -2002-04-14 Hans-Peter Nilsson <hp@bitrange.com> +2002-04-13 Toon Moene <toon@moene.indiv.nluug.nl> + + * news.texi: Deprecate frontend version number; + update list of fixed bugs. + +2002-04-08 Hans-Peter Nilsson <hp@bitrange.com> * Make-lang.in (f/target.o): Depend on diagnostic.h. * target.c: Include diagnostic.h. (ffetarget_memcpy_): Call sorry if host and target endians are not matching. -2002-04-13 Toon Moene <toon@moene.indiv.nluug.nl> +Thu Apr 4 23:29:48 2002 Neil Booth <neil@daikokuya.demon.co.uk> - * news.texi: Deprecate frontend version number; - update list of fixed bugs. + * com.c (LANG_HOOKS_TRUTHVALUE_CONVERSION): Redefine. + (truthvalue_conversion): Rename. Update. Make static. + (ffecom_truth_value): Update. -2002-04-01 Phil Edwards <pme@gcc.gnu.org> +Mon Apr 1 21:39:36 2002 Neil Booth <neil@daikokuya.demon.co.uk> - * version.c: Fix misplaced leading blanks on first line. + * com.c (LANG_HOOKS_MARK_ADDRESSABLE): Redefine. + (mark_addressable): Rename. + (ffecom_arrayref_, ffecom_1): Update. + +Mon Apr 1 09:59:53 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (LANG_HOOKS_SIGNED_TYPE, LANG_HOOKS_UNSIGNED_TYPE, + LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE): New. + (unsigned_type, signed_type, signed_or_unsigned_type): Rename. + +Sun Mar 31 23:50:22 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (lang_print_error_function): Rename. + (LANG_HOOKS_PRINT_ERROR_FUNCTION): Redefine. + (ffe_init): Don't set hook. + +Fri Mar 29 21:59:15 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (LANG_HOOKS_TYPE_FOR_MODE, LANG_HOOKS_TYPE_FOR_SIZE): + Redefine. + (type_for_mode, type_for_size): Rename. + (signed_or_unsigned_type, signed_type, truthvalue_conversion, + unsigned_type): Use new hooks. + +Tue Mar 26 10:30:05 2002 Andrew Cagney <ac131313@redhat.com> + + * invoke.texi (Warning Options): Mention -Wswitch-enum. + Fix PR c/5044. + +Tue Mar 26 07:30:51 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (LANG_HOOKS_MARK_TREE): Redefine. + (lang_mark_tree): Rename ffe_mark_tree, make static. + +Mon Mar 25 19:27:11 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (maybe_build_cleanup): Remove. 2002-03-23 Toon Moene <toon@moene.indiv.nluug.nl> @@ -124,9 +537,60 @@ Mon Apr 15 10:59:14 2002 Mark Mitchell <mark@codesourcery.com> addressing get caught. * news.texi: Document the fixing of this problem. -Mon Mar 18 18:43:22 CET 2002 Jan Hubicka <jh@suse.cz> +Sat Mar 23 11:18:17 2002 Andrew Cagney <ac131313@redhat.com> - * target.h (FFETARGET_32bit_longs): Undefine for x86-64. + * invoke.texi (Warning Options): Mention -Wswitch-default. + +Thu Mar 21 18:55:41 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * cp-tree.h (pushdecl, pushlevel, poplevel, set_block, + insert_block, getdecls, global_bindings_p): New. + +Wed Mar 20 08:03:42 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (lang_printable_name): Rename. + (LANG_HOOKS_DECL_PRINTABLE_NAME): Redefine. + (ffe_init): Don't use old hook. + +Sun Mar 17 18:50:15 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.h (ffe_parse_file): Prototype. + +Sun Mar 17 20:57:30 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (LANG_HOOKS_PARSE_FILE): Redefine. + * com.h (ffe_parse_file): New. + * parse.c (NAME_OF_STDIN): Remove. + (yyparse): Rename ffe_parse_file. + +Tue Mar 12 20:23:18 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * com.c (tree_code_type, tree_code_length, tree_code_name): + Define. + +Sun Mar 10 12:37:42 2002 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> + + * target.c (ffetarget_print_hex): Const-ify. + +2002-03-06 Phil Edwards <pme@gcc.gnu.org> + + * version.c: Fix misplaced leading blanks on first line. + +2002-03-03 Zack Weinberg <zack@codesourcery.com> + + * com.c, target.h: Remove all #ifndef REAL_ARITHMETIC + blocks, make all #ifdef REAL_ARITHMETIC blocks unconditional. + Delete some further #ifdef blocks predicated on REAL_ARITHMETIC. + +Thu Feb 28 07:53:46 2002 Neil Booth <neil@daikokuya.demon.co.uk> + + * com.c (copy_lang_decl): Delete. + +2002-02-27 Zack Weinberg <zack@codesourcery.com> + + * com.c, lex.c, top.c: Delete traditional-mode-related code + copied from the C front end but not used, or used only to + permit the compiler to link. 2002-02-13 Toon Moene <toon@moene.indiv.nluug.nl> @@ -1528,7 +1992,7 @@ Fri Sep 24 10:48:10 1999 Bernd Schmidt <bernds@cygnus.co.uk> Tue Sep 21 09:08:30 1999 Toon Moene <toon@moene.indiv.nluug.nl> - * g77spec.c (lang_specific_driver): Initialise return value. + * g77spec.c (lang_specific_driver): Initialize return value. Thu Sep 16 18:07:11 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu> @@ -2808,7 +3272,7 @@ Sat Jul 11 19:24:32 1998 Craig Burley <burley@gnu.org> Sat Jul 11 18:24:37 1998 Craig Burley <burley@gnu.org> * com.c (ffecom_expr_) [FFEBLD_opCONTER]: Die if padding - for constant is non-zero. + for constant is nonzero. * com.c (__eprintf): Delete this function, it is obsolete. @@ -2864,7 +3328,7 @@ Wed Jul 1 11:19:13 1998 Craig Burley <burley@gnu.org> and even more elegantly than those. * target.c (ffetarget_align): Make sure alignments - are non-zero, just in case. + are nonzero, just in case. See ChangeLog.0 for earlier changes. diff --git a/contrib/gcc/f/ChangeLog.0 b/contrib/gcc/f/ChangeLog.0 index b74222e..3d6675e 100644 --- a/contrib/gcc/f/ChangeLog.0 +++ b/contrib/gcc/f/ChangeLog.0 @@ -38,7 +38,7 @@ Mon Jun 29 09:47:33 1998 Craig Burley <burley@gnu.org> of equiv area, extend lowering to maintain needed alignment. * target.c (ffetarget_align): Handle negative offset correctly. - * global.c (ffeglobal_pad_common): Warn about non-zero + * global.c (ffeglobal_pad_common): Warn about nonzero padding only the first time its seen. If new padding larger than old, update old. (ffeglobal_save_common): Use correct type for size throughout. @@ -2419,7 +2419,7 @@ Sat Nov 2 13:50:31 1996 Craig Burley <burley@gnu.ai.mit.edu> function call to the type in the fall-through case). * ste.c (ffeste_R909_finish): Don't special-case list-directed - I/O, now that libf2c can return non-zero status codes. + I/O, now that libf2c can return nonzero status codes. (ffeste_R910_finish): Ditto. (ffeste_io_call_): Simplify logic. (ffeste_io_impdo_): diff --git a/contrib/gcc/f/Make-lang.in b/contrib/gcc/f/Make-lang.in index 0bb5f20..1286f07 100644 --- a/contrib/gcc/f/Make-lang.in +++ b/contrib/gcc/f/Make-lang.in @@ -1,5 +1,5 @@ # Top level makefile fragment for GNU Fortran. -*-makefile-*- -# Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002 Free Software Foundation, Inc. +# Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. #This file is part of GNU Fortran. @@ -65,21 +65,17 @@ F77 f77: f771$(exeext) f77.extraclean f77.maintainer-clean f77.rebuilt \ f77.stage1 f77.stage2 f77.stage3 f77.stage4 -g77spec.o: $(srcdir)/f/g77spec.c $(srcdir)/f/version.h $(SYSTEM_H) $(GCC_H) \ +g77spec.o: $(srcdir)/f/g77spec.c $(SYSTEM_H) $(GCC_H) \ $(CONFIG_H) (SHLIB_LINK='$(SHLIB_LINK)' \ SHLIB_MULTILIB='$(SHLIB_MULTILIB)'; \ $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(DRIVER_DEFINES) \ $(INCLUDES) $(srcdir)/f/g77spec.c) -g77version.o: $(srcdir)/f/version.c - $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) -o g77version.o \ - $(srcdir)/f/version.c - # Create the compiler driver for g77. -g77$(exeext): gcc.o g77spec.o g77version.o version.o prefix.o intl.o \ +g77$(exeext): gcc.o g77spec.o version.o prefix.o intl.o \ $(LIBDEPS) $(EXTRA_GCC_OBJS) - $(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ gcc.o g77spec.o g77version.o \ + $(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ gcc.o g77spec.o \ version.o prefix.o intl.o $(EXTRA_GCC_OBJS) $(LIBS) # Create a version of the g77 driver which calls the cross-compiler. @@ -93,7 +89,7 @@ F77_OBJS = f/bad.o f/bit.o f/bld.o f/com.o f/data.o f/equiv.o f/expr.o \ f/global.o f/implic.o f/info.o f/intrin.o f/lab.o f/lex.o f/malloc.o \ f/name.o f/parse.o f/src.o f/st.o f/sta.o f/stb.o f/stc.o \ f/std.o f/ste.o f/storag.o f/stp.o f/str.o f/sts.o f/stt.o f/stu.o \ - f/stv.o f/stw.o f/symbol.o f/target.o f/top.o f/type.o f/version.o f/where.o + f/stv.o f/stw.o f/symbol.o f/target.o f/top.o f/type.o f/where.o # Use loose warnings for this front end. f-warn = @@ -137,6 +133,8 @@ f/fini.o: $(HOST_CC) $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \ -c $(srcdir)/f/fini.c $(OUTPUT_OPTION) +gt-f-lex.h gt-f-where.h gt-f-com.h gt-f-ste.h gtype-f.h : s-gtype; @true + # # Build hooks: @@ -155,7 +153,8 @@ $(srcdir)/f/g77.info: $(srcdir)/f/g77.texi $(srcdir)/f/bugs.texi \ $(srcdir)/f/news.texi $(srcdir)/f/intdoc.texi \ $(srcdir)/f/root.texi $(srcdir)/doc/include/fdl.texi \ $(srcdir)/doc/include/gpl.texi \ - $(srcdir)/doc/include/funding.texi + $(srcdir)/doc/include/funding.texi \ + $(srcdir)/doc/include/gcc-common.texi if [ x$(BUILD_INFO) = xinfo ]; then \ rm -f $(srcdir)/f/g77.info-*; \ cd $(srcdir)/f && $(MAKEINFO) -I../doc/include -o g77.info g77.texi; \ @@ -166,8 +165,9 @@ f/g77.dvi: $(srcdir)/f/g77.texi $(srcdir)/f/bugs.texi \ $(srcdir)/f/news.texi $(srcdir)/f/intdoc.texi \ $(srcdir)/f/root.texi $(srcdir)/doc/include/fdl.texi \ $(srcdir)/doc/include/gpl.texi \ - $(srcdir)/doc/include/funding.texi - s=`cd $(srcdir); pwd`; export s; \ + $(srcdir)/doc/include/funding.texi \ + $(srcdir)/doc/include/gcc-common.texi + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ cd f && $(TEXI2DVI) -I $$s/doc/include $$s/f/g77.texi $(srcdir)/f/g77.1: $(srcdir)/f/invoke.texi @@ -226,11 +226,11 @@ f/ansify$(build_exeext): f/ansify.c hconfig.h $(SYSTEM_H) $(srcdir)/f/BUGS: f/bugs0.texi f/bugs.texi f/root.texi cd $(srcdir)/f; $(MAKEINFO) -D BUGSONLY --no-header --no-split \ - --no-validate -o BUGS bugs0.texi + --no-validate -I../doc/include -o BUGS bugs0.texi $(srcdir)/f/NEWS: f/news0.texi f/news.texi f/root.texi cd $(srcdir)/f; $(MAKEINFO) -D NEWSONLY --no-header --no-split \ - --no-validate -o NEWS news0.texi + --no-validate -I../doc/include -o NEWS news0.texi f77.rebuilt: f/g77.info $(srcdir)/f/BUGS \ $(srcdir)/f/NEWS @@ -313,12 +313,13 @@ f77.uninstall: installdirs f77.mostlyclean: -rm -f f/*$(objext) + -rm -f f/*$(coverageexts) -rm -f f/fini$(build_exeext) f/stamp-str f/str-*.h f/str-*.j -rm -f f/intdoc$(build_exeext) f/ansify$(build_exeext) f/intdoc.h0 -rm -f g77.aux g77.cps g77.ky g77.toc g77.vr g77.fn g77.kys \ g77.pg g77.tp g77.vrs g77.cp g77.fns g77.log g77.pgs g77.tps f77.clean: - -rm -f g77spec.o g77version.o + -rm -f g77spec.o f77.distclean: -rm -f f/Makefile f77.extraclean: @@ -329,7 +330,7 @@ f77.maintainer-clean: # The main makefile has already created stage?/f. G77STAGESTUFF = f/*$(objext) f/fini$(build_exeext) f/stamp-str \ - f/str-*.h f/str-*.j g77spec.o g77version.o + f/str-*.h f/str-*.j g77spec.o f77.stage1: stage1-start -mv -f $(G77STAGESTUFF) stage1/f @@ -350,21 +351,22 @@ f/bad.o: f/bad.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bad.h f/bad.def f/where.h \ glimits.h f/top.h f/malloc.h flags.h f/com.h f/com-rt.def $(TREE_H) f/bld.h \ f/bld-op.def f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def \ f/target.h f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \ - f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h toplev.h intl.h + f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h toplev.h intl.h \ + diagnostic.h f/bit.o: f/bit.c f/proj.h $(CONFIG_H) $(SYSTEM_H) glimits.h f/bit.h \ f/malloc.h f/bld.o: f/bld.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bld.h f/bld-op.def f/bit.h \ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h f/top.h f/lex.h \ f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \ - f/name.h f/intrin.h f/intrin.def + f/name.h f/intrin.h f/intrin.def real.h f/com.o: f/com.c f/proj.h $(CONFIG_H) $(SYSTEM_H) flags.h $(RTL_H) $(TREE_H) \ output.h convert.h f/com.h f/com-rt.def f/bld.h f/bld-op.def f/bit.h \ f/malloc.h f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \ f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h \ f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \ f/name.h f/expr.h f/implic.h f/src.h f/st.h $(GGC_H) toplev.h diagnostic.h \ - langhooks.h langhooks-def.h intl.h + $(LANGHOOKS_DEF) langhooks.h intl.h real.h debug.h gt-f-com.h gtype-f.h f/data.o: f/data.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/data.h f/bld.h f/bld-op.def \ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \ @@ -380,7 +382,7 @@ f/expr.o: f/expr.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/expr.h f/bld.h f/bld-op.de f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \ f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h \ f/global.h f/name.h f/intrin.h f/intrin.def f/implic.h f/src.h f/st.h \ - f/stamp-str + f/stamp-str real.h f/fini.o: f/fini.c f/proj.h hconfig.h $(SYSTEM_H) f/malloc.h f/global.o: f/global.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/global.h f/info.h \ f/info-b.def f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def \ @@ -410,7 +412,7 @@ f/lex.o: f/lex.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h f/where.h \ f/bld-op.def f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def \ f/target.h f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \ f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h f/src.h flags.h \ - debug.h input.h toplev.h output.h $(GGC_H) + debug.h input.h toplev.h output.h $(GGC_H) gt-f-lex.h f/malloc.o: f/malloc.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/malloc.h f/name.o: f/name.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bad.h f/bad.def f/where.h \ glimits.h f/top.h f/malloc.h f/name.h f/global.h f/info.h f/info-b.def \ @@ -421,7 +423,7 @@ f/parse.o: f/parse.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h \ f/where.h glimits.h f/com.h f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def \ f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \ f/bad.def f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \ - f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h f/version.h flags.h + f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h version.h flags.h f/src.o: f/src.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/src.h f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/malloc.h f/st.o: f/st.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/st.h f/bad.h f/bad.def \ @@ -460,7 +462,8 @@ f/ste.o: f/ste.c f/proj.h $(CONFIG_H) $(SYSTEM_H) $(RTL_H) toplev.h f/ste.h \ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \ f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \ f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h \ - f/stt.h f/stamp-str f/sts.h f/stv.h f/stw.h f/expr.h f/sta.h $(GGC_H) + f/stt.h f/stamp-str f/sts.h f/stv.h f/stw.h f/expr.h f/sta.h $(GGC_H) \ + gt-f-ste.h f/storag.o: f/storag.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/storag.h f/bld.h \ f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) \ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \ @@ -512,7 +515,7 @@ f/symbol.o: f/symbol.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/symbol.h \ f/lex.h f/type.h f/lab.h f/storag.h f/intrin.h f/intrin.def f/equiv.h \ f/global.h f/name.h f/src.h f/st.h f/target.o: f/target.c f/proj.h $(CONFIG_H) $(SYSTEM_H) glimits.h f/target.h \ - $(TREE_H) f/bad.h f/bad.def f/where.h f/top.h f/malloc.h f/info.h \ + $(TREE_H) f/bad.h f/bad.def f/where.h f/top.h f/malloc.h f/info.h real.h \ f/info-b.def f/info-k.def f/info-w.def f/type.h f/lex.h diagnostic.h f/top.o: f/top.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h f/where.h \ glimits.h f/bad.h f/bad.def f/bit.h f/bld.h f/bld-op.def f/com.h \ @@ -522,6 +525,5 @@ f/top.o: f/top.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h f/where.h \ f/intrin.def f/data.h f/expr.h f/implic.h f/src.h f/st.h flags.h \ toplev.h f/type.o: f/type.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/type.h f/malloc.h -f/version.o: f/version.c f/version.h f/where.o: f/where.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/where.h glimits.h f/top.h \ - f/malloc.h f/lex.h $(GGC_H) + f/malloc.h f/lex.h $(GGC_H) gt-f-where.h diff --git a/contrib/gcc/f/bad.c b/contrib/gcc/f/bad.c index 4de713c..21fa487 100644 --- a/contrib/gcc/f/bad.c +++ b/contrib/gcc/f/bad.c @@ -43,6 +43,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "toplev.h" #include "where.h" #include "intl.h" +#include "diagnostic.h" /* Externals defined here. */ @@ -202,7 +203,7 @@ ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev, if ((ffebad_severity_ != FFEBAD_severityPEDANTIC) || !flag_pedantic_errors) { - if (count_error (1) == 0) + if (!diagnostic_count_diagnostic (global_dc, DK_WARNING)) { /* User wants no warnings. */ ffebad_is_temp_inhibited_ = TRUE; return FALSE; @@ -214,7 +215,7 @@ ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev, case FFEBAD_severityWEIRD: case FFEBAD_severitySEVERE: case FFEBAD_severityDISASTER: - count_error (0); + diagnostic_count_diagnostic (global_dc, DK_ERROR); break; default: @@ -420,7 +421,7 @@ ffebad_finish () { if (bi != 0) fputc ('\n', stderr); - report_error_function (fn); + diagnostic_report_current_function (global_dc); fprintf (stderr, /* the trailing space on the <file>:<line>: line fools emacs19 compilation mode into finding the diff --git a/contrib/gcc/f/bit.c b/contrib/gcc/f/bit.c index 70d7833..00f064b 100644 --- a/contrib/gcc/f/bit.c +++ b/contrib/gcc/f/bit.c @@ -31,7 +31,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA /* Include files. */ #include "proj.h" -#include "glimits.h" #include "bit.h" #include "malloc.h" diff --git a/contrib/gcc/f/bld.c b/contrib/gcc/f/bld.c index 9161419..3460c24 100644 --- a/contrib/gcc/f/bld.c +++ b/contrib/gcc/f/bld.c @@ -43,6 +43,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "malloc.h" #include "target.h" #include "where.h" +#include "real.h" /* Externals defined here. */ diff --git a/contrib/gcc/f/bugs.texi b/contrib/gcc/f/bugs.texi index bdd8765..176072c 100644 --- a/contrib/gcc/f/bugs.texi +++ b/contrib/gcc/f/bugs.texi @@ -1,4 +1,4 @@ -@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. @@ -11,9 +11,8 @@ @set last-update-bugs 2002-02-01 -@include root.texi - @ifset DOC-BUGS +@include root.texi @c The immediately following lines apply to the BUGS file @c which is derived from this file. @emph{Note:} This file is automatically generated from the files @@ -79,7 +78,7 @@ An online, ``live'' version of this document (derived directly from the mainline, development version of @code{g77} within @code{gcc}) is available via -@uref{http://www.gnu.org/software/gcc/onlinedocs/g77/Trouble.html}. +@uref{http://gcc.gnu.org/onlinedocs/g77/Trouble.html}. Follow the ``Known Bugs'' link. The following information was last updated on @value{last-update-bugs}: diff --git a/contrib/gcc/f/com.c b/contrib/gcc/f/com.c index 13de981..fca0f94 100644 --- a/contrib/gcc/f/com.c +++ b/contrib/gcc/f/com.c @@ -82,6 +82,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "proj.h" #include "flags.h" +#include "real.h" #include "rtl.h" #include "toplev.h" #include "tree.h" @@ -92,6 +93,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "intl.h" #include "langhooks.h" #include "langhooks-def.h" +#include "debug.h" /* VMS-specific definitions */ #ifdef VMS @@ -154,7 +156,7 @@ tree string_type_node; inventions should be renamed to be canonical. Note that only the ones currently required to be global are so. */ -static tree ffecom_tree_fun_type_void; +static GTY(()) tree ffecom_tree_fun_type_void; tree ffecom_integer_type_node; /* Abbrev for _tree_type[blah][blah]. */ tree ffecom_integer_zero_node; /* Like *_*_* with g77's integer type. */ @@ -165,13 +167,14 @@ tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype]; just use build_function_type and build_pointer_type on the appropriate _tree_type array element. */ -static tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype]; -static tree ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype]; -static tree ffecom_tree_subr_type; -static tree ffecom_tree_ptr_to_subr_type; -static tree ffecom_tree_blockdata_type; +static GTY(()) tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype]; +static GTY(()) tree + ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype]; +static GTY(()) tree ffecom_tree_subr_type; +static GTY(()) tree ffecom_tree_ptr_to_subr_type; +static GTY(()) tree ffecom_tree_blockdata_type; -static tree ffecom_tree_xargc_; +static GTY(()) tree ffecom_tree_xargc_; ffecomSymbol ffecom_symbol_null_ = @@ -187,10 +190,10 @@ ffeinfoKindtype ffecom_label_kind_ = FFEINFO_basictypeNONE; int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype]; tree ffecom_f2c_integer_type_node; -tree ffecom_f2c_ptr_to_integer_type_node; +static GTY(()) tree ffecom_f2c_ptr_to_integer_type_node; tree ffecom_f2c_address_type_node; tree ffecom_f2c_real_type_node; -tree ffecom_f2c_ptr_to_real_type_node; +static GTY(()) tree ffecom_f2c_ptr_to_real_type_node; tree ffecom_f2c_doublereal_type_node; tree ffecom_f2c_complex_type_node; tree ffecom_f2c_doublecomplex_type_node; @@ -261,6 +264,13 @@ struct _ffecom_concat_list_ /* Static functions (internal). */ +static tree ffe_type_for_mode PARAMS ((enum machine_mode, int)); +static tree ffe_type_for_size PARAMS ((unsigned int, int)); +static tree ffe_unsigned_type PARAMS ((tree)); +static tree ffe_signed_type PARAMS ((tree)); +static tree ffe_signed_or_unsigned_type PARAMS ((int, tree)); +static bool ffe_mark_addressable PARAMS ((tree)); +static tree ffe_truthvalue_conversion PARAMS ((tree)); static void ffecom_init_decl_processing PARAMS ((void)); static tree ffecom_arglist_expr_ (const char *argstring, ffebld args); static tree ffecom_widest_expr_type_ (ffebld list); @@ -364,9 +374,10 @@ static void delete_block (tree block); static int duplicate_decls (tree newdecl, tree olddecl); static void finish_decl (tree decl, tree init, bool is_top_level); static void finish_function (int nested); -static const char *lang_printable_name (tree decl, int v); +static const char *ffe_printable_name (tree decl, int v); +static void ffe_print_error_function (diagnostic_context *, const char *); static tree lookup_name_current_level (tree name); -static struct binding_level *make_binding_level (void); +static struct f_binding_level *make_binding_level (void); static void pop_f_function_context (void); static void push_f_function_context (void); static void push_parm_decl (tree parm); @@ -388,15 +399,15 @@ static ffesymbol ffecom_primary_entry_ = NULL; static ffesymbol ffecom_nested_entry_ = NULL; static ffeinfoKind ffecom_primary_entry_kind_; static bool ffecom_primary_entry_is_proc_; -static tree ffecom_outer_function_decl_; -static tree ffecom_previous_function_decl_; -static tree ffecom_which_entrypoint_decl_; -static tree ffecom_float_zero_ = NULL_TREE; -static tree ffecom_float_half_ = NULL_TREE; -static tree ffecom_double_zero_ = NULL_TREE; -static tree ffecom_double_half_ = NULL_TREE; -static tree ffecom_func_result_;/* For functions. */ -static tree ffecom_func_length_;/* For CHARACTER fns. */ +static GTY(()) tree ffecom_outer_function_decl_; +static GTY(()) tree ffecom_previous_function_decl_; +static GTY(()) tree ffecom_which_entrypoint_decl_; +static GTY(()) tree ffecom_float_zero_; +static GTY(()) tree ffecom_float_half_; +static GTY(()) tree ffecom_double_zero_; +static GTY(()) tree ffecom_double_half_; +static GTY(()) tree ffecom_func_result_;/* For functions. */ +static GTY(()) tree ffecom_func_length_;/* For CHARACTER fns. */ static ffebld ffecom_list_blockdata_; static ffebld ffecom_list_common_; static ffebld ffecom_master_arglist_; @@ -406,9 +417,9 @@ static ffetargetCharacterSize ffecom_master_size_; static int ffecom_num_fns_ = 0; static int ffecom_num_entrypoints_ = 0; static bool ffecom_is_altreturning_ = FALSE; -static tree ffecom_multi_type_node_; -static tree ffecom_multi_retval_; -static tree +static GTY(()) tree ffecom_multi_type_node_; +static GTY(()) tree ffecom_multi_retval_; +static GTY(()) tree ffecom_multi_fields_[FFEINFO_basictype][FFEINFO_kindtype]; static bool ffecom_member_namelisted_; /* _member_phase1_ namelisted? */ static bool ffecom_doing_entry_ = FALSE; @@ -418,13 +429,7 @@ static int ffecom_typesize_integer1_; /* Holds pointer-to-function expressions. */ -static tree ffecom_gfrt_[FFECOM_gfrt] -= -{ -#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) NULL_TREE, -#include "com-rt.def" -#undef DEFGFRT -}; +static GTY(()) tree ffecom_gfrt_[FFECOM_gfrt]; /* Holds the external names of the functions. */ @@ -521,7 +526,7 @@ static const char *const ffecom_gfrt_argstring_[FFECOM_gfrt] /* Note that the information in the `names' component of the global contour is duplicated in the IDENTIFIER_GLOBAL_VALUEs of all identifiers. */ -struct binding_level +struct f_binding_level GTY(()) { /* A chain of _DECL nodes for all variables, constants, functions, and typedef types. These are in the reverse of the order supplied. @@ -538,7 +543,7 @@ struct binding_level tree this_block; /* The binding level which this one is contained in (inherits from). */ - struct binding_level *level_chain; + struct f_binding_level *level_chain; /* 0: no ffecom_prepare_* functions called at this level yet; 1: ffecom_prepare* functions called, except not ffecom_prepare_end; @@ -546,36 +551,38 @@ struct binding_level int prep_state; }; -#define NULL_BINDING_LEVEL (struct binding_level *) NULL +#define NULL_BINDING_LEVEL (struct f_binding_level *) NULL /* The binding level currently in effect. */ -static struct binding_level *current_binding_level; +static GTY(()) struct f_binding_level *current_binding_level; /* A chain of binding_level structures awaiting reuse. */ -static struct binding_level *free_binding_level; +static GTY((deletable (""))) struct f_binding_level *free_binding_level; /* The outermost binding level, for names of file scope. This is created when the compiler is started and exists through the entire run. */ -static struct binding_level *global_binding_level; +static struct f_binding_level *global_binding_level; /* Binding level structures are initialized by copying this one. */ -static const struct binding_level clear_binding_level +static const struct f_binding_level clear_binding_level = {NULL, NULL, NULL, NULL_BINDING_LEVEL, 0}; /* Language-dependent contents of an identifier. */ -struct lang_identifier - { - struct tree_identifier ignore; - tree global_value, local_value, label_value; - bool invented; - }; +struct lang_identifier GTY(()) +{ + struct tree_identifier common; + tree global_value; + tree local_value; + tree label_value; + bool invented; +}; /* Macros for access to language-specific slots in an identifier. */ /* Each of these slots contains a DECL node or null. */ @@ -596,6 +603,25 @@ struct lang_identifier #define IDENTIFIER_INVENTED(NODE) \ (((struct lang_identifier *)(NODE))->invented) +/* The resulting tree type. */ +union lang_tree_node + GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), + chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)"))) +{ + union tree_node GTY ((tag ("0"), + desc ("tree_node_structure (&%h)"))) + generic; + struct lang_identifier GTY ((tag ("1"))) identifier; +}; + +/* Fortran doesn't use either of these. */ +struct lang_decl GTY(()) +{ +}; +struct lang_type GTY(()) +{ +}; + /* In identifiers, C uses the following fields in a special way: TREE_PUBLIC to record that there was a previous local extern decl. TREE_USED to record that such a decl was used. @@ -605,11 +631,11 @@ struct lang_identifier that have names. Here so we can clear out their names' definitions at the end of the function. */ -static tree named_labels; +static GTY(()) tree named_labels; /* A list of LABEL_DECLs from outer contexts that are currently shadowed. */ -static tree shadowed_labels; +static GTY(()) tree shadowed_labels; /* Return the subscript expression, modified to do range-checking. @@ -780,6 +806,7 @@ ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims, die = ffecom_call_gfrt (FFECOM_gfrtRANGE, args, NULL_TREE); TREE_SIDE_EFFECTS (die) = 1; + die = convert (void_type_node, die); element = ffecom_3 (COND_EXPR, TREE_TYPE (element), @@ -795,7 +822,7 @@ ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims, `item' is NULL_TREE, or the transformed pointer to the array. `expr' is the original opARRAYREF expression, which is transformed if `item' is NULL_TREE. - `want_ptr' is non-zero if a pointer to the element, instead of + `want_ptr' is nonzero if a pointer to the element, instead of the element itself, is to be returned. */ static tree @@ -854,7 +881,7 @@ ffecom_arrayref_ (tree item, ffebld expr, int want_ptr) return item; if (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING - && ! mark_addressable (item)) + && ! ffe_mark_addressable (item)) return error_mark_node; } @@ -1787,15 +1814,8 @@ ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, callee_commons, scalar_args)) { -#ifdef HOHO - tempvar = ffecom_make_tempvar (ffecom_tree_type - [FFEINFO_basictypeCOMPLEX][kt], - FFETARGET_charactersizeNONE, - -1); -#else tempvar = hook; assert (tempvar); -#endif } else { @@ -2143,13 +2163,8 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) if (!ffesymbol_hook (s).addr) item = ffecom_1_fn (item); } - -#ifdef HOHO - tempvar = ffecom_push_tempvar (char_type_node, size, -1, TRUE); -#else tempvar = ffebld_nonter_hook (expr); assert (tempvar); -#endif tempvar = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (tempvar)), tempvar); @@ -2201,13 +2216,8 @@ ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null) tree args; tree newlen; -#ifdef HOHO - tempvar = ffecom_make_tempvar (char_type_node, - ffebld_size (expr), -1); -#else tempvar = ffebld_nonter_hook (expr); assert (tempvar); -#endif tempvar = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (tempvar)), tempvar); @@ -4021,12 +4031,8 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, case FFEINTRIN_impCHAR: case FFEINTRIN_impACHAR: -#ifdef HOHO - tempvar = ffecom_make_tempvar (char_type_node, 1, -1); -#else tempvar = ffebld_nonter_hook (expr); assert (tempvar); -#endif { tree tmv = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (tempvar))); @@ -5599,7 +5605,6 @@ ffecom_expr_power_integer_ (ffebld expr) ffecom_start_compstmt (); -#ifndef HAHA rtmp = ffecom_make_tempvar ("power_r", rtype, FFETARGET_charactersizeNONE, -1); ltmp = ffecom_make_tempvar ("power_l", ltype, @@ -5612,25 +5617,6 @@ ffecom_expr_power_integer_ (ffebld expr) FFETARGET_charactersizeNONE, -1); else divide = NULL_TREE; -#else /* HAHA */ - { - tree hook; - - hook = ffebld_nonter_hook (expr); - assert (hook); - assert (TREE_CODE (hook) == TREE_VEC); - assert (TREE_VEC_LENGTH (hook) == 4); - rtmp = TREE_VEC_ELT (hook, 0); - ltmp = TREE_VEC_ELT (hook, 1); - result = TREE_VEC_ELT (hook, 2); - divide = TREE_VEC_ELT (hook, 3); - if (TREE_CODE (ltype) == COMPLEX_TYPE - || TREE_CODE (ltype) == RECORD_TYPE) - assert (divide); - else - assert (! divide); - } -#endif /* HAHA */ expand_expr_stmt (ffecom_modify (void_type_node, rtmp, @@ -6267,27 +6253,12 @@ ffecom_gfrt_tree_ (ffecomGfrt ix) /* A somewhat evil way to prevent the garbage collector from collecting 'tree' structures. */ #define NUM_TRACKED_CHUNK 63 -static struct tree_ggc_tracker +struct tree_ggc_tracker GTY(()) { struct tree_ggc_tracker *next; tree trees[NUM_TRACKED_CHUNK]; -} *tracker_head = NULL; - -static void -mark_tracker_head (void *arg) -{ - struct tree_ggc_tracker *head; - int i; - - for (head = * (struct tree_ggc_tracker **) arg; - head != NULL; - head = head->next) - { - ggc_mark (head); - for (i = 0; i < NUM_TRACKED_CHUNK; i++) - ggc_mark_tree (head->trees[i]); - } -} +}; +static GTY(()) struct tree_ggc_tracker *tracker_head; void ffecom_save_tree_forever (tree t) @@ -6725,15 +6696,6 @@ ffecom_let_char_ (tree dest_tree, tree dest_length, tree citem; tree clength; -#ifdef HOHO - length_array - = lengths - = ffecom_push_tempvar (ffecom_f2c_ftnlen_type_node, - FFETARGET_charactersizeNONE, count, TRUE); - item_array = items = ffecom_push_tempvar (ffecom_f2c_address_type_node, - FFETARGET_charactersizeNONE, - count, TRUE); -#else { tree hook; @@ -6744,7 +6706,6 @@ ffecom_let_char_ (tree dest_tree, tree dest_length, length_array = lengths = TREE_VEC_ELT (hook, 0); item_array = items = TREE_VEC_ELT (hook, 1); } -#endif for (i = 0; i < count; ++i) { @@ -7484,7 +7445,7 @@ ffecom_sym_transform_ (ffesymbol s) assert (et != NULL_TREE); if (! TREE_STATIC (et)) - put_var_into_stack (et); + put_var_into_stack (et, /*rescan=*/true); offset = ffestorag_modulo (est) + ffestorag_offset (ffesymbol_storage (s)) @@ -8130,8 +8091,8 @@ ffecom_sym_transform_ (ffesymbol s) DECL_EXTERNAL (t) = 1; TREE_PUBLIC (t) = 1; - t = start_decl (t, FALSE); - finish_decl (t, NULL_TREE, FALSE); + t = start_decl (t, ffe_is_globals ()); + finish_decl (t, NULL_TREE, ffe_is_globals ()); if ((g != NULL) && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR) @@ -9205,15 +9166,13 @@ ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, /* Build Namelist type. */ +static GTY(()) tree ffecom_type_namelist_var; static tree ffecom_type_namelist_ () { - static tree type = NULL_TREE; - - if (type == NULL_TREE) + if (ffecom_type_namelist_var == NULL_TREE) { - static tree namefield, varsfield, nvarsfield; - tree vardesctype; + tree namefield, varsfield, nvarsfield, vardesctype, type; vardesctype = ffecom_type_vardesc_ (); @@ -9230,22 +9189,21 @@ ffecom_type_namelist_ () TYPE_FIELDS (type) = namefield; layout_type (type); - ggc_add_tree_root (&type, 1); + ffecom_type_namelist_var = type; } - return type; + return ffecom_type_namelist_var; } /* Build Vardesc type. */ +static GTY(()) tree ffecom_type_vardesc_var; static tree ffecom_type_vardesc_ () { - static tree type = NULL_TREE; - static tree namefield, addrfield, dimsfield, typefield; - - if (type == NULL_TREE) + if (ffecom_type_vardesc_var == NULL_TREE) { + tree namefield, addrfield, dimsfield, typefield, type; type = make_node (RECORD_TYPE); namefield = ffecom_decl_field (type, NULL_TREE, "name", @@ -9260,10 +9218,10 @@ ffecom_type_vardesc_ () TYPE_FIELDS (type) = namefield; layout_type (type); - ggc_add_tree_root (&type, 1); + ffecom_type_vardesc_var = type; } - return type; + return ffecom_type_vardesc_var; } static tree @@ -9525,7 +9483,7 @@ ffecom_1 (enum tree_code code, tree type, tree node) if (code == ADDR_EXPR) { - if (!mark_addressable (node)) + if (!ffe_mark_addressable (node)) assert ("can't mark_addressable this node!" == NULL); } @@ -10251,18 +10209,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) /* ~~Kludge! */ assert (sz != FFETARGET_charactersizeNONE); -#ifdef HOHO - length_array - = lengths - = ffecom_push_tempvar (ffecom_f2c_ftnlen_type_node, - FFETARGET_charactersizeNONE, count, TRUE); - item_array - = items - = ffecom_push_tempvar (ffecom_f2c_address_type_node, - FFETARGET_charactersizeNONE, count, TRUE); - temporary = ffecom_push_tempvar (char_type_node, - sz, -1, TRUE); -#else { tree hook; @@ -10274,7 +10220,6 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) item_array = items = TREE_VEC_ELT (hook, 1); temporary = TREE_VEC_ELT (hook, 2); } -#endif known_length = ffecom_f2c_ftnlen_zero_node; @@ -10648,6 +10593,78 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, return item; } +/* Transform constant-union to tree, with the type known. */ + +tree +ffecom_constantunion_with_type (ffebldConstantUnion *cu, + tree tree_type, ffebldConst ct) +{ + tree item; + + int val; + + switch (ct) + { +#if FFETARGET_okINTEGER1 + case FFEBLD_constINTEGER1: + val = ffebld_cu_val_integer1 (*cu); + item = build_int_2 (val, (val < 0) ? -1 : 0); + break; +#endif +#if FFETARGET_okINTEGER2 + case FFEBLD_constINTEGER2: + val = ffebld_cu_val_integer2 (*cu); + item = build_int_2 (val, (val < 0) ? -1 : 0); + break; +#endif +#if FFETARGET_okINTEGER3 + case FFEBLD_constINTEGER3: + val = ffebld_cu_val_integer3 (*cu); + item = build_int_2 (val, (val < 0) ? -1 : 0); + break; +#endif +#if FFETARGET_okINTEGER4 + case FFEBLD_constINTEGER4: + val = ffebld_cu_val_integer4 (*cu); + item = build_int_2 (val, (val < 0) ? -1 : 0); + break; +#endif +#if FFETARGET_okLOGICAL1 + case FFEBLD_constLOGICAL1: + val = ffebld_cu_val_logical1 (*cu); + item = build_int_2 (val, (val < 0) ? -1 : 0); + break; +#endif +#if FFETARGET_okLOGICAL2 + case FFEBLD_constLOGICAL2: + val = ffebld_cu_val_logical2 (*cu); + item = build_int_2 (val, (val < 0) ? -1 : 0); + break; +#endif +#if FFETARGET_okLOGICAL3 + case FFEBLD_constLOGICAL3: + val = ffebld_cu_val_logical3 (*cu); + item = build_int_2 (val, (val < 0) ? -1 : 0); + break; +#endif +#if FFETARGET_okLOGICAL4 + case FFEBLD_constLOGICAL4: + val = ffebld_cu_val_logical4 (*cu); + item = build_int_2 (val, (val < 0) ? -1 : 0); + break; +#endif + default: + assert ("constant type not supported"==NULL); + return error_mark_node; + break; + } + + TREE_TYPE (item) = tree_type; + + TREE_CONSTANT (item) = 1; + + return item; +} /* Transform expression into constant tree. If the expression can be transformed into a tree that is constant, @@ -11180,7 +11197,7 @@ ffecom_init_0 () name = bsearch ("foo", &names[0], ARRAY_SIZE (names), sizeof (names[0]), (int (*)(const void *, const void *)) strcmp); - if (name != &names[0][2]) + if (name != &names[2][0]) { assert ("bsearch doesn't work, #define FFEPROJ_BSEARCH 0 in proj.h" == NULL); @@ -11724,23 +11741,23 @@ ffecom_init_0 () = build_function_type (void_type_node, NULL_TREE); builtin_function ("__builtin_sqrtf", float_ftype_float, - BUILT_IN_SQRTF, BUILT_IN_NORMAL, "sqrtf"); + BUILT_IN_SQRTF, BUILT_IN_NORMAL, "sqrtf", NULL_TREE); builtin_function ("__builtin_sqrt", double_ftype_double, - BUILT_IN_SQRT, BUILT_IN_NORMAL, "sqrt"); + BUILT_IN_SQRT, BUILT_IN_NORMAL, "sqrt", NULL_TREE); builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble, - BUILT_IN_SQRTL, BUILT_IN_NORMAL, "sqrtl"); + BUILT_IN_SQRTL, BUILT_IN_NORMAL, "sqrtl", NULL_TREE); builtin_function ("__builtin_sinf", float_ftype_float, - BUILT_IN_SINF, BUILT_IN_NORMAL, "sinf"); + BUILT_IN_SINF, BUILT_IN_NORMAL, "sinf", NULL_TREE); builtin_function ("__builtin_sin", double_ftype_double, - BUILT_IN_SIN, BUILT_IN_NORMAL, "sin"); + BUILT_IN_SIN, BUILT_IN_NORMAL, "sin", NULL_TREE); builtin_function ("__builtin_sinl", ldouble_ftype_ldouble, - BUILT_IN_SINL, BUILT_IN_NORMAL, "sinl"); + BUILT_IN_SINL, BUILT_IN_NORMAL, "sinl", NULL_TREE); builtin_function ("__builtin_cosf", float_ftype_float, - BUILT_IN_COSF, BUILT_IN_NORMAL, "cosf"); + BUILT_IN_COSF, BUILT_IN_NORMAL, "cosf", NULL_TREE); builtin_function ("__builtin_cos", double_ftype_double, - BUILT_IN_COS, BUILT_IN_NORMAL, "cos"); + BUILT_IN_COS, BUILT_IN_NORMAL, "cos", NULL_TREE); builtin_function ("__builtin_cosl", ldouble_ftype_ldouble, - BUILT_IN_COSL, BUILT_IN_NORMAL, "cosl"); + BUILT_IN_COSL, BUILT_IN_NORMAL, "cosl", NULL_TREE); pedantic_lvalues = FALSE; @@ -11804,11 +11821,7 @@ ffecom_init_0 () { REAL_VALUE_TYPE point_5; -#ifdef REAL_ARITHMETIC REAL_ARITHMETIC (point_5, RDIV_EXPR, dconst1, dconst2); -#else - point_5 = .5; -#endif ffecom_float_half_ = build_real (float_type_node, point_5); ffecom_double_half_ = build_real (double_type_node, point_5); } @@ -12466,27 +12479,6 @@ ffecom_prepare_expr_ (ffebld expr, ffebld dest UNUSED) } break; -#ifdef HAHA - case FFEBLD_opPOWER: - { - tree rtype, ltype; - tree rtmp, ltmp, result; - - ltype = ffecom_type_expr (ffebld_left (expr)); - rtype = ffecom_type_expr (ffebld_right (expr)); - - rtmp = ffecom_make_tempvar (rtype, FFETARGET_charactersizeNONE, -1); - ltmp = ffecom_make_tempvar (ltype, FFETARGET_charactersizeNONE, -1); - result = ffecom_make_tempvar (ltype, FFETARGET_charactersizeNONE, -1); - - tempvar = make_tree_vec (3); - TREE_VEC_ELT (tempvar, 0) = rtmp; - TREE_VEC_ELT (tempvar, 1) = ltmp; - TREE_VEC_ELT (tempvar, 2) = result; - } - break; -#endif /* HAHA */ - case FFEBLD_opCONCATENATE: { /* This gets special handling, because only one set of temps @@ -13009,7 +13001,7 @@ ffecom_temp_label () tree ffecom_truth_value (tree expr) { - return truthvalue_conversion (expr); + return ffe_truthvalue_conversion (expr); } /* Return the inversion of a truth value (the inversion of what @@ -13154,12 +13146,14 @@ bison_rule_compstmt_ () See tree.h for its possible values. If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME, - the name to be called if we can't opencode the function. */ + the name to be called if we can't opencode the function. If + ATTRS is nonzero, use that for the function's attribute list. */ tree builtin_function (const char *name, tree type, int function_code, enum built_in_class class, - const char *library_name) + const char *library_name, + tree attrs ATTRIBUTE_UNUSED) { tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); DECL_EXTERNAL (decl) = 1; @@ -13639,7 +13633,7 @@ finish_function (int nested) nested function and all). */ static const char * -lang_printable_name (tree decl, int v) +ffe_printable_name (tree decl, int v) { /* Just to keep GCC quiet about the unused variable. In theory, differing values of V should produce different @@ -13657,8 +13651,8 @@ lang_printable_name (tree decl, int v) an error. */ static void -lang_print_error_function (diagnostic_context *context __attribute__((unused)), - const char *file) +ffe_print_error_function (diagnostic_context *context __attribute__((unused)), + const char *file) { static ffeglobal last_g = NULL; static ffesymbol last_s = NULL; @@ -13727,13 +13721,13 @@ lookup_name_current_level (tree name) return t; } -/* Create a new `struct binding_level'. */ +/* Create a new `struct f_binding_level'. */ -static struct binding_level * +static struct f_binding_level * make_binding_level () { /* NOSTRICT */ - return (struct binding_level *) xmalloc (sizeof (struct binding_level)); + return ggc_alloc (sizeof (struct f_binding_level)); } /* Save and restore the variables in this file and elsewhere @@ -13745,7 +13739,7 @@ struct f_function struct f_function *next; tree named_labels; tree shadowed_labels; - struct binding_level *binding_level; + struct f_binding_level *binding_level; }; struct f_function *f_function_chain; @@ -13833,7 +13827,7 @@ pushdecl_top_level (x) tree x; { register tree t; - register struct binding_level *b = current_binding_level; + register struct f_binding_level *b = current_binding_level; register tree f = current_function_decl; current_binding_level = global_binding_level; @@ -13937,7 +13931,7 @@ start_decl (tree decl, bool is_top_level) Returns 1 on success. If the DECLARATOR is not suitable for a function (it defines a datum instead), we return 0, which tells - yyparse to report a parse error. + ffe_parse_file to report a parse error. NESTED is nonzero for a function nested within another function. */ @@ -14054,15 +14048,6 @@ convert (type, expr) return error_mark_node; } -/* integrate_decl_tree calls this function, but since we don't use the - DECL_LANG_SPECIFIC field, this is a no-op. */ - -void -copy_lang_decl (node) - tree node UNUSED; -{ -} - /* Return the list of declarations of the current level. Note that this list is in reverse order unless/until you nreverse it; and when you do nreverse it, you must @@ -14082,101 +14067,11 @@ global_bindings_p () return current_binding_level == global_binding_level; } -/* Print an error message for invalid use of an incomplete type. - VALUE is the expression that was used (or 0 if that isn't known) - and TYPE is the type that was invalid. */ - -void -incomplete_type_error (value, type) - tree value UNUSED; - tree type; -{ - if (TREE_CODE (type) == ERROR_MARK) - return; - - assert ("incomplete type?!?" == NULL); -} - -/* Mark ARG for GC. */ -static void -mark_binding_level (void *arg) -{ - struct binding_level *level = *(struct binding_level **) arg; - - while (level) - { - ggc_mark_tree (level->names); - ggc_mark_tree (level->blocks); - ggc_mark_tree (level->this_block); - level = level->level_chain; - } -} - static void ffecom_init_decl_processing () { - static tree *const tree_roots[] = { - ¤t_function_decl, - &string_type_node, - &ffecom_tree_fun_type_void, - &ffecom_integer_zero_node, - &ffecom_integer_one_node, - &ffecom_tree_subr_type, - &ffecom_tree_ptr_to_subr_type, - &ffecom_tree_blockdata_type, - &ffecom_tree_xargc_, - &ffecom_f2c_integer_type_node, - &ffecom_f2c_ptr_to_integer_type_node, - &ffecom_f2c_address_type_node, - &ffecom_f2c_real_type_node, - &ffecom_f2c_ptr_to_real_type_node, - &ffecom_f2c_doublereal_type_node, - &ffecom_f2c_complex_type_node, - &ffecom_f2c_doublecomplex_type_node, - &ffecom_f2c_longint_type_node, - &ffecom_f2c_logical_type_node, - &ffecom_f2c_flag_type_node, - &ffecom_f2c_ftnlen_type_node, - &ffecom_f2c_ftnlen_zero_node, - &ffecom_f2c_ftnlen_one_node, - &ffecom_f2c_ftnlen_two_node, - &ffecom_f2c_ptr_to_ftnlen_type_node, - &ffecom_f2c_ftnint_type_node, - &ffecom_f2c_ptr_to_ftnint_type_node, - &ffecom_outer_function_decl_, - &ffecom_previous_function_decl_, - &ffecom_which_entrypoint_decl_, - &ffecom_float_zero_, - &ffecom_float_half_, - &ffecom_double_zero_, - &ffecom_double_half_, - &ffecom_func_result_, - &ffecom_func_length_, - &ffecom_multi_type_node_, - &ffecom_multi_retval_, - &named_labels, - &shadowed_labels - }; - size_t i; - malloc_init (); - /* Record our roots. */ - for (i = 0; i < ARRAY_SIZE (tree_roots); i++) - ggc_add_tree_root (tree_roots[i], 1); - ggc_add_tree_root (&ffecom_tree_type[0][0], - FFEINFO_basictype*FFEINFO_kindtype); - ggc_add_tree_root (&ffecom_tree_fun_type[0][0], - FFEINFO_basictype*FFEINFO_kindtype); - ggc_add_tree_root (&ffecom_tree_ptr_to_fun_type[0][0], - FFEINFO_basictype*FFEINFO_kindtype); - ggc_add_tree_root (ffecom_gfrt_, FFECOM_gfrt); - ggc_add_root (¤t_binding_level, 1, sizeof current_binding_level, - mark_binding_level); - ggc_add_root (&free_binding_level, 1, sizeof current_binding_level, - mark_binding_level); - ggc_add_root (&tracker_head, 1, sizeof tracker_head, mark_tracker_head); - ffe_init_0 (); } @@ -14219,6 +14114,11 @@ static void ffe_finish PARAMS ((void)); static void ffe_init_options PARAMS ((void)); static void ffe_print_identifier PARAMS ((FILE *, tree, int)); +struct language_function GTY(()) +{ + int unused; +}; + #undef LANG_HOOKS_NAME #define LANG_HOOKS_NAME "GNU F77" #undef LANG_HOOKS_INIT @@ -14229,8 +14129,29 @@ static void ffe_print_identifier PARAMS ((FILE *, tree, int)); #define LANG_HOOKS_INIT_OPTIONS ffe_init_options #undef LANG_HOOKS_DECODE_OPTION #define LANG_HOOKS_DECODE_OPTION ffe_decode_option +#undef LANG_HOOKS_PARSE_FILE +#define LANG_HOOKS_PARSE_FILE ffe_parse_file +#undef LANG_HOOKS_MARK_ADDRESSABLE +#define LANG_HOOKS_MARK_ADDRESSABLE ffe_mark_addressable #undef LANG_HOOKS_PRINT_IDENTIFIER #define LANG_HOOKS_PRINT_IDENTIFIER ffe_print_identifier +#undef LANG_HOOKS_DECL_PRINTABLE_NAME +#define LANG_HOOKS_DECL_PRINTABLE_NAME ffe_printable_name +#undef LANG_HOOKS_PRINT_ERROR_FUNCTION +#define LANG_HOOKS_PRINT_ERROR_FUNCTION ffe_print_error_function +#undef LANG_HOOKS_TRUTHVALUE_CONVERSION +#define LANG_HOOKS_TRUTHVALUE_CONVERSION ffe_truthvalue_conversion + +#undef LANG_HOOKS_TYPE_FOR_MODE +#define LANG_HOOKS_TYPE_FOR_MODE ffe_type_for_mode +#undef LANG_HOOKS_TYPE_FOR_SIZE +#define LANG_HOOKS_TYPE_FOR_SIZE ffe_type_for_size +#undef LANG_HOOKS_SIGNED_TYPE +#define LANG_HOOKS_SIGNED_TYPE ffe_signed_type +#undef LANG_HOOKS_UNSIGNED_TYPE +#define LANG_HOOKS_UNSIGNED_TYPE ffe_unsigned_type +#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE +#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE ffe_signed_or_unsigned_type /* We do not wish to use alias-set based aliasing at all. Used in the extreme (every object with its own set, with equivalences recorded) it @@ -14242,6 +14163,37 @@ static void ffe_print_identifier PARAMS ((FILE *, tree, int)); const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; +/* Table indexed by tree code giving a string containing a character + classifying the tree code. Possibilities are + t, d, s, c, r, <, 1, 2 and e. See tree.def for details. */ + +#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE, + +const char tree_code_type[] = { +#include "tree.def" +}; +#undef DEFTREECODE + +/* Table indexed by tree code giving number of expression + operands beyond the fixed part of the node structure. + Not used for types or decls. */ + +#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH, + +const unsigned char tree_code_length[] = { +#include "tree.def" +}; +#undef DEFTREECODE + +/* Names of tree components. + Used for printing out the tree and error messages. */ +#define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME, + +const char *const tree_code_name[] = { +#include "tree.def" +}; +#undef DEFTREECODE + static const char * ffe_init (filename) const char *filename; @@ -14262,8 +14214,6 @@ ffe_init (filename) #endif ffecom_init_decl_processing (); - decl_printable_name = lang_printable_name; - print_error_function = lang_print_error_function; /* If the file is output from cpp, it should contain a first line `# 1 "real-filename"', and the current design of gcc (toplev.c @@ -14304,8 +14254,8 @@ ffe_init_options () flag_complex_divide_method = 1; } -int -mark_addressable (exp) +static bool +ffe_mark_addressable (exp) tree exp; { register tree x = exp; @@ -14320,7 +14270,7 @@ mark_addressable (exp) case CONSTRUCTOR: TREE_ADDRESSABLE (x) = 1; - return 1; + return true; case VAR_DECL: case CONST_DECL: @@ -14332,7 +14282,7 @@ mark_addressable (exp) if (TREE_PUBLIC (x)) { assert ("address of global register var requested" == NULL); - return 0; + return false; } assert ("address of register variable requested" == NULL); } @@ -14341,11 +14291,11 @@ mark_addressable (exp) if (TREE_PUBLIC (x)) { assert ("address of global register var requested" == NULL); - return 0; + return false; } assert ("address of register var requested" == NULL); } - put_var_into_stack (x); + put_var_into_stack (x, /*rescan=*/true); /* drops in */ case FUNCTION_DECL: @@ -14356,21 +14306,10 @@ mark_addressable (exp) #endif default: - return 1; + return true; } } -/* If DECL has a cleanup, build and return that cleanup here. - This is a callback called by expand_expr. */ - -tree -maybe_build_cleanup (decl) - tree decl UNUSED; -{ - /* There are no cleanups in Fortran. */ - return NULL_TREE; -} - /* Exit a binding level. Pop the level off, and restore the state of the identifier-decl mappings that were in effect when this level was entered. @@ -14494,7 +14433,7 @@ poplevel (keep, reverse, functionbody) /* Pop the current level, and free the structure for reuse. */ { - register struct binding_level *level = current_binding_level; + register struct f_binding_level *level = current_binding_level; current_binding_level = current_binding_level->level_chain; level->level_chain = free_binding_level; @@ -14549,7 +14488,7 @@ pushdecl (x) { register tree t; register tree name = DECL_NAME (x); - register struct binding_level *b = current_binding_level; + register struct f_binding_level *b = current_binding_level; if ((TREE_CODE (x) == FUNCTION_DECL) && (DECL_INITIAL (x) == 0) @@ -14681,7 +14620,7 @@ void pushlevel (tag_transparent) int tag_transparent; { - register struct binding_level *newlevel = NULL_BINDING_LEVEL; + register struct f_binding_level *newlevel = NULL_BINDING_LEVEL; assert (! tag_transparent); @@ -14724,8 +14663,8 @@ set_block (block) BLOCK_SUBBLOCKS (block)); } -tree -signed_or_unsigned_type (unsignedp, type) +static tree +ffe_signed_or_unsigned_type (unsignedp, type) int unsignedp; tree type; { @@ -14745,15 +14684,15 @@ signed_or_unsigned_type (unsignedp, type) return (unsignedp ? long_long_unsigned_type_node : long_long_integer_type_node); - type2 = type_for_size (TYPE_PRECISION (type), unsignedp); + type2 = ffe_type_for_size (TYPE_PRECISION (type), unsignedp); if (type2 == NULL_TREE) return type; return type2; } -tree -signed_type (type) +static tree +ffe_signed_type (type) tree type; { tree type1 = TYPE_MAIN_VARIANT (type); @@ -14781,7 +14720,7 @@ signed_type (type) return intQI_type_node; #endif - type2 = type_for_size (TYPE_PRECISION (type1), 0); + type2 = ffe_type_for_size (TYPE_PRECISION (type1), 0); if (type2 != NULL_TREE) return type2; @@ -14807,8 +14746,8 @@ signed_type (type) The resulting type should always be `integer_type_node'. */ -tree -truthvalue_conversion (expr) +static tree +ffe_truthvalue_conversion (expr) tree expr; { if (TREE_CODE (expr) == ERROR_MARK) @@ -14885,31 +14824,38 @@ truthvalue_conversion (expr) return ffecom_2 ((TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1)) ? TRUTH_OR_EXPR : TRUTH_ORIF_EXPR), integer_type_node, - truthvalue_conversion (TREE_OPERAND (expr, 0)), - truthvalue_conversion (TREE_OPERAND (expr, 1))); + ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)), + ffe_truthvalue_conversion (TREE_OPERAND (expr, 1))); case NEGATE_EXPR: case ABS_EXPR: case FLOAT_EXPR: case FFS_EXPR: - /* These don't change whether an object is non-zero or zero. */ - return truthvalue_conversion (TREE_OPERAND (expr, 0)); + /* These don't change whether an object is nonzero or zero. */ + return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)); case LROTATE_EXPR: case RROTATE_EXPR: - /* These don't change whether an object is zero or non-zero, but + /* These don't change whether an object is zero or nonzero, but we can't ignore them if their second arg has side-effects. */ if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1))) return build (COMPOUND_EXPR, integer_type_node, TREE_OPERAND (expr, 1), - truthvalue_conversion (TREE_OPERAND (expr, 0))); + ffe_truthvalue_conversion (TREE_OPERAND (expr, 0))); else - return truthvalue_conversion (TREE_OPERAND (expr, 0)); + return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)); case COND_EXPR: - /* Distribute the conversion into the arms of a COND_EXPR. */ - return fold (build (COND_EXPR, integer_type_node, TREE_OPERAND (expr, 0), - truthvalue_conversion (TREE_OPERAND (expr, 1)), - truthvalue_conversion (TREE_OPERAND (expr, 2)))); + { + /* Distribute the conversion into the arms of a COND_EXPR. */ + tree arg1 = TREE_OPERAND (expr, 1); + tree arg2 = TREE_OPERAND (expr, 2); + if (! VOID_TYPE_P (TREE_TYPE (arg1))) + arg1 = ffe_truthvalue_conversion (arg1); + if (! VOID_TYPE_P (TREE_TYPE (arg2))) + arg2 = ffe_truthvalue_conversion (arg2); + return fold (build (COND_EXPR, integer_type_node, + TREE_OPERAND (expr, 0), arg1, arg2)); + } case CONVERT_EXPR: /* Don't cancel the effect of a CONVERT_EXPR from a REFERENCE_TYPE, @@ -14922,7 +14868,7 @@ truthvalue_conversion (expr) /* If this is widening the argument, we can ignore it. */ if (TYPE_PRECISION (TREE_TYPE (expr)) >= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (expr, 0)))) - return truthvalue_conversion (TREE_OPERAND (expr, 0)); + return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)); break; case MINUS_EXPR: @@ -14967,20 +14913,20 @@ truthvalue_conversion (expr) ((TREE_SIDE_EFFECTS (expr) ? TRUTH_OR_EXPR : TRUTH_ORIF_EXPR), integer_type_node, - truthvalue_conversion (ffecom_1 (REALPART_EXPR, - TREE_TYPE (TREE_TYPE (expr)), - expr)), - truthvalue_conversion (ffecom_1 (IMAGPART_EXPR, - TREE_TYPE (TREE_TYPE (expr)), - expr)))); + ffe_truthvalue_conversion (ffecom_1 (REALPART_EXPR, + TREE_TYPE (TREE_TYPE (expr)), + expr)), + ffe_truthvalue_conversion (ffecom_1 (IMAGPART_EXPR, + TREE_TYPE (TREE_TYPE (expr)), + expr)))); return ffecom_2 (NE_EXPR, integer_type_node, expr, convert (TREE_TYPE (expr), integer_zero_node)); } -tree -type_for_mode (mode, unsignedp) +static tree +ffe_type_for_mode (mode, unsignedp) enum machine_mode mode; int unsignedp; { @@ -15039,8 +14985,8 @@ type_for_mode (mode, unsignedp) return 0; } -tree -type_for_size (bits, unsignedp) +static tree +ffe_type_for_size (bits, unsignedp) unsigned bits; int unsignedp; { @@ -15075,8 +15021,8 @@ type_for_size (bits, unsignedp) return 0; } -tree -unsigned_type (type) +static tree +ffe_unsigned_type (type) tree type; { tree type1 = TYPE_MAIN_VARIANT (type); @@ -15104,7 +15050,7 @@ unsigned_type (type) return unsigned_intQI_type_node; #endif - type2 = type_for_size (TYPE_PRECISION (type1), 1); + type2 = ffe_type_for_size (TYPE_PRECISION (type1), 1); if (type2 != NULL_TREE) return type2; @@ -15118,21 +15064,6 @@ unsigned_type (type) return type; } - -void -lang_mark_tree (t) - union tree_node *t ATTRIBUTE_UNUSED; -{ - if (TREE_CODE (t) == IDENTIFIER_NODE) - { - struct lang_identifier *i = (struct lang_identifier *) t; - ggc_mark_tree (IDENTIFIER_GLOBAL_VALUE (i)); - ggc_mark_tree (IDENTIFIER_LOCAL_VALUE (i)); - ggc_mark_tree (IDENTIFIER_LABEL_VALUE (i)); - } - else if (TYPE_P (t) && TYPE_LANG_SPECIFIC (t)) - ggc_mark (TYPE_LANG_SPECIFIC (t)); -} /* From gcc/cccp.c, the code to handle -I. */ @@ -15178,7 +15109,7 @@ struct file_name_list char *fname; /* Mapping of file names for this directory. */ struct file_name_map *name_map; - /* Non-zero if name_map is valid. */ + /* Nonzero if name_map is valid. */ int got_name_map; }; @@ -15465,10 +15396,10 @@ read_name_map (dirname) dirlen = strlen (dirname); separator_needed = dirlen != 0 && dirname[dirlen - 1] != '/'; - name = (char *) xmalloc (dirlen + strlen (FILE_NAME_MAP_FILE) + 2); - strcpy (name, dirname); - name[dirlen] = '/'; - strcpy (name + dirlen + separator_needed, FILE_NAME_MAP_FILE); + if (separator_needed) + name = concat (dirname, "/", FILE_NAME_MAP_FILE, NULL); + else + name = concat (dirname, FILE_NAME_MAP_FILE, NULL); f = fopen (name, "r"); free (name); if (!f) @@ -15498,10 +15429,10 @@ read_name_map (dirname) ptr->map_to = to; else { - ptr->map_to = xmalloc (dirlen + strlen (to) + 2); - strcpy (ptr->map_to, dirname); - ptr->map_to[dirlen] = '/'; - strcpy (ptr->map_to + dirlen + separator_needed, to); + if (separator_needed) + ptr->map_to = concat (dirname, "/", to, NULL); + else + ptr->map_to = concat (dirname, to, NULL); free (to); } @@ -16205,7 +16136,7 @@ typedef doublereal E_f; // real function with -R not specified // // (No such symbols should be defined in a strict ANSI C compiler. We can avoid trouble with f2c-translated code by using - gcc -ansi [-traditional].) // + gcc -ansi.) // @@ -16636,3 +16567,6 @@ typedef doublereal E_f; // real function with -R not specified // -------- (end output file from f2c) */ + +#include "gt-f-com.h" +#include "gtype-f.h" diff --git a/contrib/gcc/f/com.h b/contrib/gcc/f/com.h index 5e20e2b..b58e5ba 100644 --- a/contrib/gcc/f/com.h +++ b/contrib/gcc/f/com.h @@ -157,37 +157,42 @@ struct _ffecom_symbol_ #include "storag.h" #include "symbol.h" -/* Structure definitions. */ - +extern int global_bindings_p PARAMS ((void)); +extern tree getdecls PARAMS ((void)); +extern void pushlevel PARAMS ((int)); +extern tree poplevel PARAMS ((int,int, int)); +extern void insert_block PARAMS ((tree)); +extern void set_block PARAMS ((tree)); +extern tree pushdecl PARAMS ((tree)); /* Global objects accessed by users of this module. */ -extern tree string_type_node; -extern tree ffecom_integer_type_node; -extern tree ffecom_integer_zero_node; -extern tree ffecom_integer_one_node; -extern tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype]; +extern GTY(()) tree string_type_node; +extern GTY(()) tree ffecom_integer_type_node; +extern GTY(()) tree ffecom_integer_zero_node; +extern GTY(()) tree ffecom_integer_one_node; +extern GTY(()) tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype]; extern ffecomSymbol ffecom_symbol_null_; extern ffeinfoKindtype ffecom_pointer_kind_; extern ffeinfoKindtype ffecom_label_kind_; extern int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype]; -extern tree ffecom_f2c_integer_type_node; -extern tree ffecom_f2c_address_type_node; -extern tree ffecom_f2c_real_type_node; -extern tree ffecom_f2c_doublereal_type_node; -extern tree ffecom_f2c_complex_type_node; -extern tree ffecom_f2c_doublecomplex_type_node; -extern tree ffecom_f2c_longint_type_node; -extern tree ffecom_f2c_logical_type_node; -extern tree ffecom_f2c_flag_type_node; -extern tree ffecom_f2c_ftnlen_type_node; -extern tree ffecom_f2c_ftnlen_zero_node; -extern tree ffecom_f2c_ftnlen_one_node; -extern tree ffecom_f2c_ftnlen_two_node; -extern tree ffecom_f2c_ptr_to_ftnlen_type_node; -extern tree ffecom_f2c_ftnint_type_node; -extern tree ffecom_f2c_ptr_to_ftnint_type_node; +extern GTY(()) tree ffecom_f2c_integer_type_node; +extern GTY(()) tree ffecom_f2c_address_type_node; +extern GTY(()) tree ffecom_f2c_real_type_node; +extern GTY(()) tree ffecom_f2c_doublereal_type_node; +extern GTY(()) tree ffecom_f2c_complex_type_node; +extern GTY(()) tree ffecom_f2c_doublecomplex_type_node; +extern GTY(()) tree ffecom_f2c_longint_type_node; +extern GTY(()) tree ffecom_f2c_logical_type_node; +extern GTY(()) tree ffecom_f2c_flag_type_node; +extern GTY(()) tree ffecom_f2c_ftnlen_type_node; +extern GTY(()) tree ffecom_f2c_ftnlen_zero_node; +extern GTY(()) tree ffecom_f2c_ftnlen_one_node; +extern GTY(()) tree ffecom_f2c_ftnlen_two_node; +extern GTY(()) tree ffecom_f2c_ptr_to_ftnlen_type_node; +extern GTY(()) tree ffecom_f2c_ftnint_type_node; +extern GTY(()) tree ffecom_f2c_ptr_to_ftnint_type_node; /* Declare functions with prototypes. */ @@ -205,6 +210,8 @@ tree ffecom_arg_expr (ffebld expr, tree *length); tree ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length); tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length); tree ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook); +tree ffecom_constantunion_with_type (ffebldConstantUnion *cu, + tree tree_type,ffebldConst ct); tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt, ffeinfoKindtype kt, tree tree_type); tree ffecom_const_expr (ffebld expr); @@ -265,6 +272,7 @@ tree ffecom_truth_value (tree expr); tree ffecom_truth_value_invert (tree expr); tree ffecom_type_expr (ffebld expr); tree ffecom_which_entrypoint_decl (void); +void ffe_parse_file (int); /* Define macros. */ diff --git a/contrib/gcc/f/config-lang.in b/contrib/gcc/f/config-lang.in index 168daad..92ba5cc 100644 --- a/contrib/gcc/f/config-lang.in +++ b/contrib/gcc/f/config-lang.in @@ -1,5 +1,5 @@ # Top level configure fragment for GNU FORTRAN. -# Copyright (C) 1995, 1996, 1997, 2000, 2001 Free Software Foundation, Inc. +# Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002 Free Software Foundation, Inc. #This file is part of GNU Fortran. @@ -32,3 +32,5 @@ compilers="f771\$(exeext)" stagestuff="g77\$(exeext) g77-cross\$(exeext) f771\$(exeext)" target_libs=target-libf2c + +gtfiles="\$(srcdir)/f/com.c \$(srcdir)/f/com.h \$(srcdir)/f/ste.c \$(srcdir)/f/where.h \$(srcdir)/f/where.c \$(srcdir)/f/lex.c" diff --git a/contrib/gcc/f/data.c b/contrib/gcc/f/data.c index 3e1ae62..91b835d 100644 --- a/contrib/gcc/f/data.c +++ b/contrib/gcc/f/data.c @@ -1,5 +1,5 @@ /* data.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 2002 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -591,13 +591,29 @@ tail_recurse: /* :::::::::::::::::::: */ assert (ffeinfo_kindtype (ffebld_info (itervar)) == FFEINFO_kindtypeINTEGERDEFAULT); ffedata_stack_->itervar = ffebld_symter (itervar); - + if (ffeinfo_basictype (ffebld_info (start)) != FFEINFO_basictypeINTEGER) + { + ffebad_start (FFEBAD_DATA_EVAL); + ffest_ffebad_here_current_stmt (0); + ffebad_finish (); + ffedata_pop_ (); + ffedata_reported_error_ = TRUE; + return FALSE; + } assert (ffeinfo_basictype (ffebld_info (start)) == FFEINFO_basictypeINTEGER); assert (ffeinfo_kindtype (ffebld_info (start)) == FFEINFO_kindtypeINTEGERDEFAULT); ffesymbol_set_value (ffedata_stack_->itervar, ffedata_eval_integer1_ (start)); - + if (ffeinfo_basictype (ffebld_info (end)) != FFEINFO_basictypeINTEGER) + { + ffebad_start (FFEBAD_DATA_EVAL); + ffest_ffebad_here_current_stmt (0); + ffebad_finish (); + ffedata_pop_ (); + ffedata_reported_error_ = TRUE; + return FALSE; + } assert (ffeinfo_basictype (ffebld_info (end)) == FFEINFO_basictypeINTEGER); assert (ffeinfo_kindtype (ffebld_info (end)) @@ -608,6 +624,15 @@ tail_recurse: /* :::::::::::::::::::: */ ffedata_stack_->increment = 1; else { + if (ffeinfo_basictype (ffebld_info (incr)) != FFEINFO_basictypeINTEGER) + { + ffebad_start (FFEBAD_DATA_EVAL); + ffest_ffebad_here_current_stmt (0); + ffebad_finish (); + ffedata_pop_ (); + ffedata_reported_error_ = TRUE; + return FALSE; + } assert (ffeinfo_basictype (ffebld_info (incr)) == FFEINFO_basictypeINTEGER); assert (ffeinfo_kindtype (ffebld_info (incr)) diff --git a/contrib/gcc/f/expr.c b/contrib/gcc/f/expr.c index 1772727..4824be7 100644 --- a/contrib/gcc/f/expr.c +++ b/contrib/gcc/f/expr.c @@ -48,6 +48,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "str.h" #include "target.h" #include "where.h" +#include "real.h" /* Externals defined here. */ @@ -11501,6 +11502,24 @@ ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op, /* else Leave it alone. */ } + if (lbt == FFEINFO_basictypeLOGICAL) + { + ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced), + l->token, op->token, FFEINFO_basictypeINTEGER, + FFEINFO_kindtypeINTEGERDEFAULT, 0, + FFETARGET_charactersizeNONE, + FFEEXPR_contextLET)); + } + + if (rbt == FFEINFO_basictypeLOGICAL) + { + ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced), + r->token, op->token, FFEINFO_basictypeINTEGER, + FFEINFO_kindtypeINTEGERDEFAULT, 0, + FFETARGET_charactersizeNONE, + FFEEXPR_contextLET)); + } + return reduced; } diff --git a/contrib/gcc/f/ffe.texi b/contrib/gcc/f/ffe.texi index b6fbac9..9aa6a97 100644 --- a/contrib/gcc/f/ffe.texi +++ b/contrib/gcc/f/ffe.texi @@ -17,7 +17,7 @@ search for the string TBD. If you want to help by working on one or more of these items, email @email{gcc@@gcc.gnu.org}. If you're planning to do more than just research issues and offer comments, -see @uref{http://www.gnu.org/software/contribute.html} for steps you might +see @uref{http://gcc.gnu.org/contribute.html} for steps you might need to take first. @menu @@ -2028,7 +2028,7 @@ Initializes, usually a module. No type. A generic integer of type @code{int}. @item is -A generic integer that contains a true (non-zero) or false (zero) value. +A generic integer that contains a true (nonzero) or false (zero) value. @item len A generic integer that contains the length of something. diff --git a/contrib/gcc/f/g77.texi b/contrib/gcc/f/g77.texi index 82c5574..a7cd96b 100644 --- a/contrib/gcc/f/g77.texi +++ b/contrib/gcc/f/g77.texi @@ -2,8 +2,8 @@ @c %**start of header @setfilename g77.info -@set last-update 2002-04-29 -@set copyrights-g77 1995,1996,1997,1998,1999,2000,2001,2002 +@set last-update 2003-05-13 +@set copyrights-g77 1995,1996,1997,1998,1999,2000,2001,2002,2003 @include root.texi @@ -24,33 +24,6 @@ @c and make sure the following does NOT begin with '@c': @c @clear USING -@c 6/27/96 FSF DO wants smallbook fmt for 1st bound edition. (from gcc.texi) -@c @smallbook - -@c i also commented out the finalout command, so if there *are* any -@c overfulls, you'll (hopefully) see the rectangle in the right hand -@c margin. -- burley 1999-03-13 (from mew's comment in gcc.texi). -@c @finalout - -@macro gcctabopt{body} -@code{\body\} -@end macro -@macro gccoptlist{body} -@smallexample -\body\ -@end smallexample -@end macro -@c Makeinfo handles the above macro OK, TeX needs manual line breaks; -@c they get lost at some point in handling the macro. But if @macro is -@c used here rather than @alias, it produces double line breaks. -@iftex -@alias gol = * -@end iftex -@ifnottex -@macro gol -@end macro -@end ifnottex - @ifset INTERNALS @ifset USING @settitle Using and Porting GNU Fortran @@ -89,6 +62,29 @@ @c \global\normaloffset =0.75in @c @end tex +@copying +Copyright @copyright{} @value{copyrights-g77} Free Software Foundation, Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.2 or +any later version published by the Free Software Foundation; with the +Invariant Sections being ``GNU General Public License'' and ``Funding +Free Software'', the Front-Cover +texts being (a) (see below), and with the Back-Cover Texts being (b) +(see below). A copy of the license is included in the section entitled +``GNU Free Documentation License''. + +(a) The FSF's Front-Cover Text is: + + A GNU Manual + +(b) The FSF's Back-Cover Text is: + + You have freedom to copy and modify this GNU Manual, like GNU + software. Copies published by the Free Software Foundation raise + funds for GNU development. +@end copying + @ifinfo @dircategory Programming @direntry @@ -114,27 +110,7 @@ Published by the Free Software Foundation 59 Temple Place - Suite 330 Boston, MA 02111-1307 USA -Copyright (C) @value{copyrights-g77} Free Software Foundation, Inc. - - -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.1 or -any later version published by the Free Software Foundation; with the -Invariant Sections being ``GNU General Public License'' and ``Funding -Free Software'', the Front-Cover -texts being (a) (see below), and with the Back-Cover Texts being (b) -(see below). A copy of the license is included in the section entitled -``GNU Free Documentation License''. - -(a) The FSF's Front-Cover Text is: - - A GNU Manual - -(b) The FSF's Back-Cover Text is: - - You have freedom to copy and modify this GNU Manual, like GNU - software. Copies published by the Free Software Foundation raise - funds for GNU development. +@insertcopying @end ifinfo Contributed by James Craig Burley (@email{@value{email-burley}}). @@ -142,7 +118,6 @@ Inspired by a first pass at translating @file{g77-0.5.16/f/DOC} that was contributed to Craig by David Ronis (@email{ronis@@onsager.chem.mcgill.ca}). @setchapternewpage odd -@c @finalout @titlepage @ifset INTERNALS @ifset USING @@ -164,8 +139,6 @@ was contributed to Craig by David Ronis (@email{ronis@@onsager.chem.mcgill.ca}). @center for version @value{which-g77} @page @vskip 0pt plus 1filll -Copyright @copyright{} @value{copyrights-g77} Free Software Foundation, Inc. -@sp 2 For the @value{which-g77} Version* @sp 1 Published by the Free Software Foundation @* @@ -175,24 +148,7 @@ Boston, MA 02111-1307, USA@* @c Printed copies are available for $? each.@* @c ISBN ??? @sp 1 -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.1 or -any later version published by the Free Software Foundation; with the -Invariant Sections being ``GNU General Public License'' and ``Funding -Free Software'', the Front-Cover -texts being (a) (see below), and with the Back-Cover Texts being (b) -(see below). A copy of the license is included in the section entitled -``GNU Free Documentation License''. - -(a) The FSF's Front-Cover Text is: - - A GNU Manual - -(b) The FSF's Back-Cover Text is: - - You have freedom to copy and modify this GNU Manual, like GNU - software. Copies published by the Free Software Foundation raise - funds for GNU development. +@insertcopying @end titlepage @summarycontents @contents @@ -275,7 +231,7 @@ most consistent with the @command{g77} product in that version. * M: Diagnostics. Diagnostics produced by @command{g77}. -* Index:: Index of concepts and symbol names. +* Keyword Index:: Index of concepts and symbol names. @end menu @c yes, the "M: " @emph{is} intentional -- bad.def references it (CMPAMBIG)! @@ -1045,7 +1001,7 @@ As such, GNU users rarely need consider just what kind of underlying hardware (or, in many cases, operating system) they are using at any particular time. They can use and write software designed for a general-purpose, -widely portable, heterogenous environment---the GNU environment. +widely portable, heterogeneous environment---the GNU environment. In line with this philosophy, GNU Fortran must evolve into a product that is widely ported and portable not only in the sense that it can @@ -5643,9 +5599,9 @@ The important thing about linking @command{g77}-compiled code with C++ is that the prototypes for the @command{g77} routines must specify C linkage to avoid name mangling. So, use an @samp{extern "C"} declaration. -@command{f2c}'s @option{-C++} option will take care -of this when generating skeletons or prototype files as above, and also -avoid clashes with C++ reserved words in addition to those in C@. +@command{f2c}'s @option{-C++} option will not take care +of this when generating skeletons or prototype files as above, however, +it will avoid clashes with C++ reserved words in addition to those in C@. @node Startup Code @subsection Startup Code @@ -6283,7 +6239,7 @@ single-dimensional array, so at least the dimensionality of the array is preserved. Debuggers that understand Fortran should have no trouble with -non-zero low bounds, but for non-Fortran debuggers, especially +nonzero low bounds, but for non-Fortran debuggers, especially C debuggers, the above example might have a C equivalent of @samp{a[4305]}. This calculation is arrived at by eliminating the subtraction @@ -7512,7 +7468,7 @@ set up this kind of aliasing. (The FORTRAN 77 standard's prohibition of this sort of overlap, generally referred to therein as ``storage -assocation'', appears in Sections 15.9.3.6. +association'', appears in Sections 15.9.3.6. This prohibition allows implementations, such as @command{g77}, to, for example, implement the passing of procedures and even values in @code{COMMON} via copy operations into local, @@ -8547,7 +8503,7 @@ If a formatted @code{WRITE} produces an endless stream of spaces, check that your program is linked against the correct version of the C library. The configuration process takes care to account for your system's normal @file{libc} not being ANSI-standard, which will -otherwise cause this behaviour. +otherwise cause this behavior. If your system's default library is ANSI-standard and you subsequently link against a non-ANSI one, there might be problems such as this one. @@ -9460,9 +9416,9 @@ general control over whether or not floating-point exceptions are trapped or ignored. (Ignoring them typically results in NaN values being propagated in systems that conform to IEEE 754.) -The behaviour is normally inherited from the system-dependent startup +The behavior is normally inherited from the system-dependent startup code, though some targets, such as the Alpha, have code generation -options which change the behaviour. +options which change the behavior. Most systems provide some C-callable mechanism to change this; this can be invoked at startup using @command{gcc}'s @code{constructor} attribute. @@ -10464,30 +10420,11 @@ enable/disable/delete/hide intrinsics from the command line? Your bug reports play an essential role in making GNU Fortran reliable. When you encounter a problem, the first thing to do is to see if it is -already known. -@xref{Trouble}. -If it isn't known, then you should report the problem. - -Reporting a bug might help you by bringing a solution to your problem, or -it might not. -(If it does not, look in the service directory; see -@ref{Service}.) -In any case, the principal function of a bug report is -to help the entire community by making the next version of GNU Fortran work -better. -Bug reports are your contribution to the maintenance of GNU Fortran. - -Since the maintainers are very overloaded, we cannot respond to every -bug report. -However, if the bug has not been fixed, we are likely to -send you a patch and ask you to tell us whether it works. - -In order for a bug report to serve its purpose, you must include the -information that makes for fixing the bug. +already known. @xref{Trouble}. If it isn't known, then you should +report the problem. @menu * Criteria: Bug Criteria. Have you really found a bug? -* Where: Bug Lists. Where to send your bug report. * Reporting: Bug Reporting. How to report a bug effectively. @end menu @@ -10678,348 +10615,15 @@ It might mean the bug is in your code, and that @command{g77} simply exposes it more readily than other compilers. @end itemize -@node Bug Lists -@section Where to Report Bugs -@cindex bug report mailing lists -@kindex @value{email-bugs} -Send bug reports for GNU Fortran to @email{@value{email-bugs}}. - -Often people think of posting bug reports to a newsgroup instead of -mailing them. -This sometimes appears to work, but it has one problem which can be -crucial: a newsgroup posting does not contain a mail path back to the -sender. -Thus, if maintainers need more information, they might be unable -to reach you. For this reason, you should always send bug reports by -mail to the proper mailing list. - -As a last resort, send bug reports on paper to: - -@example -GNU Compiler Bugs -Free Software Foundation -59 Temple Place - Suite 330 -Boston, MA 02111-1307, USA -@end example - @node Bug Reporting @section How to Report Bugs @cindex compiler bugs, reporting -The fundamental principle of reporting bugs usefully is this: -@strong{report all the facts}. -If you are not sure whether to state a -fact or leave it out, state it! - -Often people omit facts because they think they know what causes the -problem and they conclude that some details don't matter. -Thus, you might -assume that the name of the variable you use in an example does not matter. -Well, probably it doesn't, but one cannot be sure. -Perhaps the bug is a -stray memory reference which happens to fetch from the location where that -name is stored in memory; perhaps, if the name were different, the contents -of that location would fool the compiler into doing the right thing despite -the bug. -Play it safe and give a specific, complete example. -That is the -easiest thing for you to do, and the most helpful. - -Keep in mind that the purpose of a bug report is to enable someone to -fix the bug if it is not known. -It isn't very important what happens if -the bug is already known. -Therefore, always write your bug reports on -the assumption that the bug is not known. - -Sometimes people give a few sketchy facts and ask, ``Does this ring a -bell?'' -This cannot help us fix a bug, so it is rarely helpful. -We respond by asking for enough details to enable us to investigate. -You might as well expedite matters by sending them to begin with. -(Besides, there are enough bells ringing around here as it is.) - -Try to make your bug report self-contained. -If we have to ask you for -more information, it is best if you include all the previous information -in your response, as well as the information that was missing. - -Please report each bug in a separate message. -This makes it easier for -us to track which bugs have been fixed and to forward your bugs reports -to the appropriate maintainer. - -Do not compress and encode any part of your bug report using programs -such as @file{uuencode}. -If you do so it will slow down the processing -of your bug. -If you must submit multiple large files, use @file{shar}, -which allows us to read your message without having to run any -decompression programs. - -(As a special exception for GNU Fortran bug-reporting, at least -for now, if you are sending more than a few lines of code, if -your program's source file format contains ``interesting'' things -like trailing spaces or strange characters, or if you need to -include binary data files, it is acceptable to put all the -files together in a @command{tar} archive, and, whether you need to -do that, it is acceptable to then compress the single file (@command{tar} -archive or source file) -using @command{gzip} and encode it via @command{uuencode}. -Do not use any MIME stuff---the current maintainer can't decode this. -Using @command{compress} instead of @command{gzip} is acceptable, assuming -you have licensed the use of the patented algorithm in -@command{compress} from Unisys.) - -To enable someone to investigate the bug, you should include all these -things: - -@itemize @bullet -@item -The version of GNU Fortran. -You can get this by running @command{g77} with the @option{-v} option. -(Ignore any error messages that might be displayed -when the linker is run.) - -Without this, we won't know whether there is any point in looking for -the bug in the current version of GNU Fortran. - -@item -@cindex preprocessor -@cindex cpp program -@cindex programs, cpp -@pindex cpp -A complete input file that will reproduce the bug. - -If your source file(s) require preprocessing -(for example, their names have suffixes like -@samp{.F}, @samp{.fpp}, @samp{.FPP}, and @samp{.r}), -and the bug is in the compiler proper (@file{f771}) -or in a subsequent phase of processing, -run your source file through the C preprocessor -by doing @samp{g77 -E @var{sourcefile} > @var{newfile}}. -Then, include the contents of @var{newfile} in the bug report. -(When you do this, use the same preprocessor options---such as -@option{-I}, @option{-D}, and @option{-U}---that you used in actual -compilation.) - -A single statement is not enough of an example. -In order to compile it, -it must be embedded in a complete file of compiler input. -The bug might depend on the details of how this is done. - -Without a real example one can compile, -all anyone can do about your bug report is wish you luck. -It would be futile to try to guess how to provoke the bug. -For example, bugs in register allocation and reloading -can depend on every little detail of the source and include files -that trigger them. - -@item -@cindex included files -@cindex INCLUDE directive -@cindex directive, INCLUDE -@cindex #include directive -@cindex directive, #include -Note that you should include with your bug report any files -included by the source file -(via the @code{#include} or @code{INCLUDE} directive) -that you send, and any files they include, and so on. - -It is not necessary to replace -the @code{#include} and @code{INCLUDE} directives -with the actual files in the version of the source file that -you send, but it might make submitting the bug report easier -in the end. -However, be sure to @emph{reproduce} the bug using the @emph{exact} -version of the source material you submit, to avoid wild-goose -chases. - -@item -The command arguments you gave GNU Fortran to compile that example -and observe the bug. For example, did you use @option{-O}? To guarantee -you won't omit something important, list all the options. - -If we were to try to guess the arguments, we would probably guess wrong -and then we would not encounter the bug. +Bugs should be reported to our bug database. Please refer to +@uref{http://gcc.gnu.org/bugs.html} for up-to-date instructions how to +submit bug reports. Copies of this file in HTML (@file{bugs.html}) and +plain text (@file{BUGS}) are also part of GCC releases. -@item -The type of machine you are using, and the operating system name and -version number. -(Much of this information is printed by @samp{g77 -v}---if you -include that, send along any additional info you have that you -don't see clearly represented in that output.) - -@item -The operands you gave to the @command{configure} command when you installed -the compiler. - -@item -A complete list of any modifications you have made to the compiler -source. (We don't promise to investigate the bug unless it happens in -an unmodified compiler. But if you've made modifications and don't tell -us, then you are sending us on a wild-goose chase.) - -Be precise about these changes. A description in English is not -enough---send a context diff for them. - -Adding files of your own (such as a machine description for a machine we -don't support) is a modification of the compiler source. - -@item -Details of any other deviations from the standard procedure for installing -GNU Fortran. - -@item -A description of what behavior you observe that you believe is -incorrect. For example, ``The compiler gets a fatal signal,'' or, -``The assembler instruction at line 208 in the output is incorrect.'' - -Of course, if the bug is that the compiler gets a fatal signal, then one -can't miss it. But if the bug is incorrect output, the maintainer might -not notice unless it is glaringly wrong. None of us has time to study -all the assembler code from a 50-line Fortran program just on the chance that -one instruction might be wrong. We need @emph{you} to do this part! - -Even if the problem you experience is a fatal signal, you should still -say so explicitly. Suppose something strange is going on, such as, your -copy of the compiler is out of synch, or you have encountered a bug in -the C library on your system. (This has happened!) Your copy might -crash and the copy here would not. If you @i{said} to expect a crash, -then when the compiler here fails to crash, we would know that the bug -was not happening. If you don't say to expect a crash, then we would -not know whether the bug was happening. We would not be able to draw -any conclusion from our observations. - -If the problem is a diagnostic when building GNU Fortran with some other -compiler, say whether it is a warning or an error. - -Often the observed symptom is incorrect output when your program is run. -Sad to say, this is not enough information unless the program is short -and simple. None of us has time to study a large program to figure out -how it would work if compiled correctly, much less which line of it was -compiled wrong. So you will have to do that. Tell us which source line -it is, and what incorrect result happens when that line is executed. A -person who understands the program can find this as easily as finding a -bug in the program itself. - -@item -If you send examples of assembler code output from GNU Fortran, -please use @option{-g} when you make them. The debugging information -includes source line numbers which are essential for correlating the -output with the input. - -@item -If you wish to mention something in the GNU Fortran source, refer to it by -context, not by line number. - -The line numbers in the development sources don't match those in your -sources. Your line numbers would convey no convenient information to the -maintainers. - -@item -Additional information from a debugger might enable someone to find a -problem on a machine which he does not have available. However, you -need to think when you collect this information if you want it to have -any chance of being useful. - -@cindex backtrace for bug reports -For example, many people send just a backtrace, but that is never -useful by itself. A simple backtrace with arguments conveys little -about GNU Fortran because the compiler is largely data-driven; the same -functions are called over and over for different RTL insns, doing -different things depending on the details of the insn. - -Most of the arguments listed in the backtrace are useless because they -are pointers to RTL list structure. The numeric values of the -pointers, which the debugger prints in the backtrace, have no -significance whatever; all that matters is the contents of the objects -they point to (and most of the contents are other such pointers). - -In addition, most compiler passes consist of one or more loops that -scan the RTL insn sequence. The most vital piece of information about -such a loop---which insn it has reached---is usually in a local variable, -not in an argument. - -@findex debug_rtx -What you need to provide in addition to a backtrace are the values of -the local variables for several stack frames up. When a local -variable or an argument is an RTX, first print its value and then use -the GDB command @command{pr} to print the RTL expression that it points -to. (If GDB doesn't run on your machine, use your debugger to call -the function @code{debug_rtx} with the RTX as an argument.) In -general, whenever a variable is a pointer, its value is no use -without the data it points to. -@end itemize - -Here are some things that are not necessary: - -@itemize @bullet -@item -A description of the envelope of the bug. - -Often people who encounter a bug spend a lot of time investigating -which changes to the input file will make the bug go away and which -changes will not affect it. - -This is often time consuming and not very useful, because the way we -will find the bug is by running a single example under the debugger with -breakpoints, not by pure deduction from a series of examples. You might -as well save your time for something else. - -Of course, if you can find a simpler example to report @emph{instead} of -the original one, that is a convenience. Errors in the output will be -easier to spot, running under the debugger will take less time, etc. -Most GNU Fortran bugs involve just one function, so the most straightforward -way to simplify an example is to delete all the function definitions -except the one where the bug occurs. Those earlier in the file may be -replaced by external declarations if the crucial function depends on -them. (Exception: inline functions might affect compilation of functions -defined later in the file.) - -However, simplification is not vital; if you don't want to do this, -report the bug anyway and send the entire test case you used. - -@item -In particular, some people insert conditionals @samp{#ifdef BUG} around -a statement which, if removed, makes the bug not happen. These are just -clutter; we won't pay any attention to them anyway. Besides, you should -send us preprocessor output, and that can't have conditionals. - -@item -A patch for the bug. - -A patch for the bug is useful if it is a good one. But don't omit the -necessary information, such as the test case, on the assumption that a -patch is all we need. We might see problems with your patch and decide -to fix the problem another way, or we might not understand it at all. - -Sometimes with a program as complicated as GNU Fortran it is very hard to -construct an example that will make the program follow a certain path -through the code. If you don't send the example, we won't be able to -construct one, so we won't be able to verify that the bug is fixed. - -And if we can't understand what bug you are trying to fix, or why your -patch should be an improvement, we won't install it. A test case will -help us to understand. - -See @uref{http://gcc.gnu.org/contribute.html} -for guidelines on how to make it easy for us to -understand and install your patches. - -@item -A guess about what the bug is or what it depends on. - -Such guesses are usually wrong. Even the maintainer can't guess right -about such things without first using the debugger to find the facts. - -@item -A core dump file. - -We have no way of examining a core dump for your type of machine -unless we have an identical system---and if we do have one, -we should be able to reproduce the crash ourselves. -@end itemize @node Service @chapter How To Get Help with GNU Fortran @@ -12262,8 +11866,8 @@ that is not Year-2000 (Y2K) compliant. @end ifset -@node Index -@unnumbered Index +@node Keyword Index +@unnumbered Keyword Index @printindex cp @bye diff --git a/contrib/gcc/f/g77spec.c b/contrib/gcc/f/g77spec.c index 2e094d9..9206ef7 100644 --- a/contrib/gcc/f/g77spec.c +++ b/contrib/gcc/f/g77spec.c @@ -1,5 +1,6 @@ /* Specific flags and argument handling of the Fortran front-end. - Copyright (C) 1997, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. + Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003 + Free Software Foundation, Inc. This file is part of GNU CC. @@ -47,7 +48,6 @@ Boston, MA 02111-1307, USA. */ #include "config.h" #include "system.h" #include "gcc.h" -#include <f/version.h> #ifndef MATH_LIBRARY #define MATH_LIBRARY "-lm" @@ -99,36 +99,14 @@ static void append_arg PARAMS ((const char *)); static int g77_newargc; static const char **g77_newargv; -/* --- This comes from gcc.c (2.8.1) verbatim: */ - -/* This defines which switch letters take arguments. */ - -#define DEFAULT_SWITCH_TAKES_ARG(CHAR) \ - ((CHAR) == 'D' || (CHAR) == 'U' || (CHAR) == 'o' \ - || (CHAR) == 'e' || (CHAR) == 'T' || (CHAR) == 'u' \ - || (CHAR) == 'I' || (CHAR) == 'm' || (CHAR) == 'x' \ - || (CHAR) == 'L' || (CHAR) == 'A') - #ifndef SWITCH_TAKES_ARG #define SWITCH_TAKES_ARG(CHAR) DEFAULT_SWITCH_TAKES_ARG(CHAR) #endif -/* This defines which multi-letter switches take arguments. */ - -#define DEFAULT_WORD_SWITCH_TAKES_ARG(STR) \ - (!strcmp (STR, "Tdata") || !strcmp (STR, "Ttext") \ - || !strcmp (STR, "Tbss") || !strcmp (STR, "include") \ - || !strcmp (STR, "imacros") || !strcmp (STR, "aux-info") \ - || !strcmp (STR, "idirafter") || !strcmp (STR, "iprefix") \ - || !strcmp (STR, "iwithprefix") || !strcmp (STR, "iwithprefixbefore") \ - || !strcmp (STR, "isystem") || !strcmp (STR, "specs")) - #ifndef WORD_SWITCH_TAKES_ARG #define WORD_SWITCH_TAKES_ARG(STR) DEFAULT_WORD_SWITCH_TAKES_ARG (STR) #endif -/* --- End of verbatim. */ - /* Assumes text[0] == '-'. Returns number of argv items that belong to (and follow) this one, an option id for options important to the caller, and a pointer to the first char of the arg, if embedded (else @@ -374,7 +352,7 @@ lang_specific_driver (in_argc, in_argv, in_added_libraries) case OPTION_version: printf ("\ -GNU Fortran (GCC %s) %s\n\ +GNU Fortran (GCC) %s\n\ Copyright (C) 2002 Free Software Foundation, Inc.\n\ \n\ GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\ @@ -382,7 +360,7 @@ You may redistribute copies of GNU Fortran\n\ under the terms of the GNU General Public License.\n\ For more information about these matters, see the file named COPYING\n\ or type the command `info -f g77 Copying'.\n\ -", version_string, ffe_version_string); +", version_string); exit (0); break; @@ -563,3 +541,9 @@ int lang_specific_pre_link () /* Not used for F77. */ /* Number of extra output files that lang_specific_pre_link may generate. */ int lang_specific_extra_outfiles = 0; /* Not used for F77. */ + +/* Table of language-specific spec functions. */ +const struct spec_function lang_specific_spec_functions[] = +{ + { 0, 0 } +}; diff --git a/contrib/gcc/f/intdoc.in b/contrib/gcc/f/intdoc.in index f702fa1..55d426a 100644 --- a/contrib/gcc/f/intdoc.in +++ b/contrib/gcc/f/intdoc.in @@ -1,4 +1,4 @@ -/* Copyright (C) 1997, 1999 Free Software Foundation, Inc. +/* Copyright (C) 1997, 1999, 2003 Free Software Foundation, Inc. * This is part of the G77 manual. * For copying conditions, see the file g77.texi. */ @@ -646,7 +646,7 @@ magnitude truncated and its sign preserved, converted to type @code{INTEGER(KIND=6)}. If @var{@1@} is type @code{COMPLEX}, its real part -is truncated and converted, and its imaginary part is disgregarded. +is truncated and converted, and its imaginary part is disregarded. @xref{Int Intrinsic}. @@ -661,7 +661,7 @@ magnitude truncated and its sign preserved, converted to type @code{INTEGER(KIND=6)}. If @var{@1@} is type @code{COMPLEX}, its real part -is truncated and converted, and its imaginary part is disgregarded. +is truncated and converted, and its imaginary part is disregarded. @xref{Int Intrinsic}. @@ -676,7 +676,7 @@ magnitude truncated and its sign preserved, converted to type @code{INTEGER(KIND=2)}. If @var{@1@} is type @code{COMPLEX}, its real part -is truncated and converted, and its imaginary part is disgregarded. +is truncated and converted, and its imaginary part is disregarded. @xref{Int Intrinsic}. @@ -1288,9 +1288,9 @@ zero if not, and negative if the information isn't available. ") DEFDOC (IDATE_unix, "Get local time info.", "\ -Fills @var{@1@} with the numerical values at the current local time -of day, month (in the range 1--12), and year in elements 1, 2, and 3, -respectively. +Fills @var{@1@} with the numerical values at the current local time. +The day (in the range 1--31), month (in the range 1--12), +and year appear in elements 1, 2, and 3 of @var{@1@}, respectively. The year has four significant digits. @cindex Y10K compliance @@ -1308,19 +1308,20 @@ as of the Year 10000. DEFDOC (IDATE_vxt, "Get local time info (VAX/VMS).", "\ Returns the numerical values of the current local time. The month (in the range 1--12) is returned in @var{@1@}, -the day (in the range 1--7) in @var{@2@}, +the day (in the range 1--31) in @var{@2@}, and the year in @var{@3@} (in the range 0--99). @cindex Y2K compliance @cindex Year 2000 compliance @cindex wraparound, Y2K @cindex limits, Y2K -This intrinsic is not recommended, due to the year 2000 approaching. -Therefore, programs making use of this intrinsic -might not be Year 2000 (Y2K) compliant. +This intrinsic is not recommended, due to the fact that +its return value for year wraps around century boundaries +(change from a larger value to a smaller one). +Therefore, programs making use of this intrinsic, for +instance, might not be Year 2000 (Y2K) compliant. For example, the date might appear, to such programs, to wrap around -(change from a larger value to a smaller one) as of the Year 2000. @xref{IDate Intrinsic (UNIX)}, for information on obtaining more digits @@ -1584,7 +1585,7 @@ almost certainly want to use something better. ") DEFDOC (SRAND, "Random seed.", "\ -Reinitialises the generator with the seed in @var{@1@}. +Reinitializes the generator with the seed in @var{@1@}. @xref{IRand Intrinsic}. @xref{Rand Intrinsic}. ") @@ -1617,7 +1618,7 @@ Existence DEFDOC (CHDIR_subr, "Change directory.", "\ Sets the current working directory to be @var{@1@}. If the @var{@2@} argument is supplied, it contains 0 -on success or a non-zero error code otherwise upon return. +on success or a nonzero error code otherwise upon return. See @code{chdir(3)}. @emph{Caution:} Using this routine during I/O to a unit connected with a @@ -1631,7 +1632,7 @@ only a function, not as a subroutine, or do not support the DEFDOC (CHDIR_func, "Change directory.", "\ Sets the current working directory to be @var{@1@}. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. See @code{chdir(3)}. @emph{Caution:} Using this routine during I/O to a unit connected with a @@ -1652,7 +1653,7 @@ trailing blanks in @var{@1@} are ignored. Currently, @var{@1@} must not contain the single quote character. -Returns 0 on success or a non-zero error code otherwise. +Returns 0 on success or a nonzero error code otherwise. Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when @@ -1674,7 +1675,7 @@ Currently, @var{@1@} must not contain the single quote character. If the @var{@3@} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when @@ -1689,7 +1690,7 @@ only a function, not as a subroutine, or do not support the DEFDOC (GETCWD_func, "Get current working directory.", "\ Places the current working directory in @var{@1@}. Returns 0 on -success, otherwise a non-zero error code +success, otherwise a nonzero error code (@code{ENOSYS} if the system does not provide @code{getcwd(3)} or @code{getwd(3)}). ") @@ -1697,7 +1698,7 @@ or @code{getwd(3)}). DEFDOC (GETCWD_subr, "Get current working directory.", "\ Places the current working directory in @var{@1@}. If the @var{@2@} argument is supplied, it contains 0 -success or a non-zero error code upon return +success or a nonzero error code upon return (@code{ENOSYS} if the system does not provide @code{getcwd(3)} or @code{getwd(3)}). @@ -1758,7 +1759,7 @@ Number of blocks allocated (-1 if not available) Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. ") DEFDOC (FSTAT_subr, "Get file information.", "\ @@ -1814,7 +1815,7 @@ Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. If the @var{@3@} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine, or do not support the @@ -1878,7 +1879,7 @@ Number of blocks allocated (-1 if not available) Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. -Returns 0 on success or a non-zero error code +Returns 0 on success or a nonzero error code (@code{ENOSYS} if the system does not provide @code{lstat(2)}). ") @@ -1940,7 +1941,7 @@ Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. If the @var{@3@} argument is supplied, it contains -0 on success or a non-zero error code upon return +0 on success or a nonzero error code upon return (@code{ENOSYS} if the system does not provide @code{lstat(2)}). Some non-GNU implementations of Fortran provide this intrinsic as @@ -2002,7 +2003,7 @@ Number of blocks allocated (-1 if not available) Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. ") DEFDOC (STAT_subr, "Get file information.", "\ @@ -2060,7 +2061,7 @@ Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. If the @var{@3@} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine, or do not support the @@ -2073,7 +2074,7 @@ A null character (@samp{CHAR(0)}) marks the end of the names in @var{@1@} and @var{@2@}---otherwise, trailing blanks in @var{@1@} and @var{@2@} are ignored. If the @var{@3@} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. See @code{link(2)}. Some non-GNU implementations of Fortran provide this intrinsic as @@ -2086,7 +2087,7 @@ Makes a (hard) link from file @var{@1@} to @var{@2@}. A null character (@samp{CHAR(0)}) marks the end of the names in @var{@1@} and @var{@2@}---otherwise, trailing blanks in @var{@1@} and @var{@2@} are ignored. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. See @code{link(2)}. Due to the side effects performed by this intrinsic, the function @@ -2099,7 +2100,7 @@ A null character (@samp{CHAR(0)}) marks the end of the names in @var{@1@} and @var{@2@}---otherwise, trailing blanks in @var{@1@} and @var{@2@} are ignored. If the @var{@3@} argument is supplied, it contains -0 on success or a non-zero error code upon return +0 on success or a nonzero error code upon return (@code{ENOSYS} if the system does not provide @code{symlink(2)}). Some non-GNU implementations of Fortran provide this intrinsic as @@ -2112,7 +2113,7 @@ Makes a symbolic link from file @var{@1@} to @var{@2@}. A null character (@samp{CHAR(0)}) marks the end of the names in @var{@1@} and @var{@2@}---otherwise, trailing blanks in @var{@1@} and @var{@2@} are ignored. -Returns 0 on success or a non-zero error code +Returns 0 on success or a nonzero error code (@code{ENOSYS} if the system does not provide @code{symlink(2)}). Due to the side effects performed by this intrinsic, the function @@ -2126,7 +2127,7 @@ the names in @var{@1@} and @var{@2@}---otherwise, trailing blanks in @var{@1@} and @var{@2@} are ignored. See @code{rename(2)}. If the @var{@3@} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine, or do not support the @@ -2139,7 +2140,7 @@ A null character (@samp{CHAR(0)}) marks the end of the names in @var{@1@} and @var{@2@}---otherwise, trailing blanks in @var{@1@} and @var{@2@} are ignored. See @code{rename(2)}. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. Due to the side effects performed by this intrinsic, the function form is not recommended. @@ -2168,7 +2169,7 @@ A null character (@samp{CHAR(0)}) marks the end of the name in @var{@1@}---otherwise, trailing blanks in @var{@1@} are ignored. If the @var{@2@} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. See @code{unlink(2)}. Some non-GNU implementations of Fortran provide this intrinsic as @@ -2181,7 +2182,7 @@ Unlink the file @var{@1@}. A null character (@samp{CHAR(0)}) marks the end of the name in @var{@1@}---otherwise, trailing blanks in @var{@1@} are ignored. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. See @code{unlink(2)}. Due to the side effects performed by this intrinsic, the function @@ -2238,7 +2239,7 @@ in @var{@1@}. DEFDOC (HOSTNM_func, "Get host name.", "\ Fills @var{@1@} with the system's host name returned by -@code{gethostname(2)}, returning 0 on success or a non-zero error code +@code{gethostname(2)}, returning 0 on success or a nonzero error code (@code{ENOSYS} if the system does not provide @code{gethostname(2)}). On some systems (specifically SCO) it might be necessary to link the @@ -2251,7 +2252,7 @@ DEFDOC (HOSTNM_subr, "Get host name.", "\ Fills @var{@1@} with the system's host name returned by @code{gethostname(2)}. If the @var{@2@} argument is supplied, it contains -0 on success or a non-zero error code upon return +0 on success or a nonzero error code upon return (@code{ENOSYS} if the system does not provide @code{gethostname(2)}). Some non-GNU implementations of Fortran provide this intrinsic as @@ -2513,7 +2514,7 @@ allowing you to take appropriate action. DEFDOC (KILL_func, "Signal a process.", "\ Sends the signal specified by @var{@2@} to the process @var{@1@}. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. See @code{kill(2)}. Due to the side effects performed by this intrinsic, the function @@ -2523,7 +2524,7 @@ form is not recommended. DEFDOC (KILL_subr, "Signal a process.", "\ Sends the signal specified by @var{@2@} to the process @var{@1@}. If the @var{@3@} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. See @code{kill(2)}. Some non-GNU implementations of Fortran provide this intrinsic as diff --git a/contrib/gcc/f/intdoc.texi b/contrib/gcc/f/intdoc.texi index e829b35..7de4257 100644 --- a/contrib/gcc/f/intdoc.texi +++ b/contrib/gcc/f/intdoc.texi @@ -2226,7 +2226,7 @@ Description: Sets the current working directory to be @var{Dir}. If the @var{Status} argument is supplied, it contains 0 -on success or a non-zero error code otherwise upon return. +on success or a nonzero error code otherwise upon return. See @code{chdir(3)}. @emph{Caution:} Using this routine during I/O to a unit connected with a @@ -2265,7 +2265,7 @@ Intrinsic groups: @code{badu77}. Description: Sets the current working directory to be @var{Dir}. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. See @code{chdir(3)}. @emph{Caution:} Using this routine during I/O to a unit connected with a @@ -2315,7 +2315,7 @@ Currently, @var{Name} must not contain the single quote character. If the @var{Status} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when @@ -2365,7 +2365,7 @@ trailing blanks in @var{Name} are ignored. Currently, @var{Name} must not contain the single quote character. -Returns 0 on success or a non-zero error code otherwise. +Returns 0 on success or a nonzero error code otherwise. Note that this currently works by actually invoking @code{/bin/chmod} (or the @code{chmod} found when @@ -5067,7 +5067,7 @@ Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. If the @var{Status} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine, or do not support the @@ -5152,7 +5152,7 @@ Number of blocks allocated (-1 if not available) Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. For information on other intrinsics with the same name: @xref{FStat Intrinsic (subroutine)}. @@ -5292,7 +5292,7 @@ Description: Places the current working directory in @var{Name}. If the @var{Status} argument is supplied, it contains 0 -success or a non-zero error code upon return +success or a nonzero error code upon return (@code{ENOSYS} if the system does not provide @code{getcwd(3)} or @code{getwd(3)}). @@ -5327,7 +5327,7 @@ Description: Places the current working directory in @var{Name}. Returns 0 on -success, otherwise a non-zero error code +success, otherwise a nonzero error code (@code{ENOSYS} if the system does not provide @code{getcwd(3)} or @code{getwd(3)}). @@ -5537,7 +5537,7 @@ Description: Fills @var{Name} with the system's host name returned by @code{gethostname(2)}. If the @var{Status} argument is supplied, it contains -0 on success or a non-zero error code upon return +0 on success or a nonzero error code upon return (@code{ENOSYS} if the system does not provide @code{gethostname(2)}). Some non-GNU implementations of Fortran provide this intrinsic as @@ -5575,7 +5575,7 @@ Intrinsic groups: @code{unix}. Description: Fills @var{Name} with the system's host name returned by -@code{gethostname(2)}, returning 0 on success or a non-zero error code +@code{gethostname(2)}, returning 0 on success or a nonzero error code (@code{ENOSYS} if the system does not provide @code{gethostname(2)}). On some systems (specifically SCO) it might be necessary to link the @@ -5893,9 +5893,9 @@ Intrinsic groups: @code{unix}. @noindent Description: -Fills @var{TArray} with the numerical values at the current local time -of day, month (in the range 1--12), and year in elements 1, 2, and 3, -respectively. +Fills @var{TArray} with the numerical values at the current local time. +The day (in the range 1--31), month (in the range 1--12), +and year appear in elements 1, 2, and 3 of @var{TArray}, respectively. The year has four significant digits. @cindex Y10K compliance @@ -5941,19 +5941,20 @@ Description: Returns the numerical values of the current local time. The month (in the range 1--12) is returned in @var{M}, -the day (in the range 1--7) in @var{D}, +the day (in the range 1--31) in @var{D}, and the year in @var{Y} (in the range 0--99). @cindex Y2K compliance @cindex Year 2000 compliance @cindex wraparound, Y2K @cindex limits, Y2K -This intrinsic is not recommended, due to the year 2000 approaching. -Therefore, programs making use of this intrinsic -might not be Year 2000 (Y2K) compliant. +This intrinsic is not recommended, due to the fact that +its return value for year wraps around century boundaries +(change from a larger value to a smaller one). +Therefore, programs making use of this intrinsic, for +instance, might not be Year 2000 (Y2K) compliant. For example, the date might appear, to such programs, to wrap around -(change from a larger value to a smaller one) as of the Year 2000. @xref{IDate Intrinsic (UNIX)}, for information on obtaining more digits @@ -6543,7 +6544,7 @@ magnitude truncated and its sign preserved, converted to type @code{INTEGER(KIND=6)}. If @var{A} is type @code{COMPLEX}, its real part -is truncated and converted, and its imaginary part is disgregarded. +is truncated and converted, and its imaginary part is disregarded. @xref{Int Intrinsic}. @@ -6578,7 +6579,7 @@ magnitude truncated and its sign preserved, converted to type @code{INTEGER(KIND=2)}. If @var{A} is type @code{COMPLEX}, its real part -is truncated and converted, and its imaginary part is disgregarded. +is truncated and converted, and its imaginary part is disregarded. @xref{Int Intrinsic}. @@ -7107,7 +7108,7 @@ Description: Sends the signal specified by @var{Signal} to the process @var{Pid}. If the @var{Status} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. See @code{kill(2)}. Some non-GNU implementations of Fortran provide this intrinsic as @@ -7145,7 +7146,7 @@ Intrinsic groups: @code{badu77}. Description: Sends the signal specified by @var{Signal} to the process @var{Pid}. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. See @code{kill(2)}. Due to the side effects performed by this intrinsic, the function @@ -7377,7 +7378,7 @@ A null character (@samp{CHAR(0)}) marks the end of the names in @var{Path1} and @var{Path2}---otherwise, trailing blanks in @var{Path1} and @var{Path2} are ignored. If the @var{Status} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. See @code{link(2)}. Some non-GNU implementations of Fortran provide this intrinsic as @@ -7418,7 +7419,7 @@ Makes a (hard) link from file @var{Path1} to @var{Path2}. A null character (@samp{CHAR(0)}) marks the end of the names in @var{Path1} and @var{Path2}---otherwise, trailing blanks in @var{Path1} and @var{Path2} are ignored. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. See @code{link(2)}. Due to the side effects performed by this intrinsic, the function @@ -7802,7 +7803,7 @@ Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. If the @var{Status} argument is supplied, it contains -0 on success or a non-zero error code upon return +0 on success or a nonzero error code upon return (@code{ENOSYS} if the system does not provide @code{lstat(2)}). Some non-GNU implementations of Fortran provide this intrinsic as @@ -7893,7 +7894,7 @@ Number of blocks allocated (-1 if not available) Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. -Returns 0 on success or a non-zero error code +Returns 0 on success or a nonzero error code (@code{ENOSYS} if the system does not provide @code{lstat(2)}). For information on other intrinsics with the same name: @@ -9085,7 +9086,7 @@ the names in @var{Path1} and @var{Path2}---otherwise, trailing blanks in @var{Path1} and @var{Path2} are ignored. See @code{rename(2)}. If the @var{Status} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine, or do not support the @@ -9126,7 +9127,7 @@ A null character (@samp{CHAR(0)}) marks the end of the names in @var{Path1} and @var{Path2}---otherwise, trailing blanks in @var{Path1} and @var{Path2} are ignored. See @code{rename(2)}. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. Due to the side effects performed by this intrinsic, the function form is not recommended. @@ -9418,7 +9419,7 @@ magnitude truncated and its sign preserved, converted to type @code{INTEGER(KIND=6)}. If @var{A} is type @code{COMPLEX}, its real part -is truncated and converted, and its imaginary part is disgregarded. +is truncated and converted, and its imaginary part is disregarded. @xref{Int Intrinsic}. @@ -9848,7 +9849,7 @@ Intrinsic groups: @code{unix}. @noindent Description: -Reinitialises the generator with the seed in @var{Seed}. +Reinitializes the generator with the seed in @var{Seed}. @xref{IRand Intrinsic}. @xref{Rand Intrinsic}. @@ -9931,7 +9932,7 @@ Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. If the @var{Status} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. Some non-GNU implementations of Fortran provide this intrinsic as only a function, not as a subroutine, or do not support the @@ -10018,7 +10019,7 @@ Number of blocks allocated (-1 if not available) Not all these elements are relevant on all systems. If an element is not relevant, it is returned as 0. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. For information on other intrinsics with the same name: @xref{Stat Intrinsic (subroutine)}. @@ -10067,7 +10068,7 @@ A null character (@samp{CHAR(0)}) marks the end of the names in @var{Path1} and @var{Path2}---otherwise, trailing blanks in @var{Path1} and @var{Path2} are ignored. If the @var{Status} argument is supplied, it contains -0 on success or a non-zero error code upon return +0 on success or a nonzero error code upon return (@code{ENOSYS} if the system does not provide @code{symlink(2)}). Some non-GNU implementations of Fortran provide this intrinsic as @@ -10108,7 +10109,7 @@ Makes a symbolic link from file @var{Path1} to @var{Path2}. A null character (@samp{CHAR(0)}) marks the end of the names in @var{Path1} and @var{Path2}---otherwise, trailing blanks in @var{Path1} and @var{Path2} are ignored. -Returns 0 on success or a non-zero error code +Returns 0 on success or a nonzero error code (@code{ENOSYS} if the system does not provide @code{symlink(2)}). Due to the side effects performed by this intrinsic, the function @@ -10657,7 +10658,7 @@ A null character (@samp{CHAR(0)}) marks the end of the name in @var{File}---otherwise, trailing blanks in @var{File} are ignored. If the @var{Status} argument is supplied, it contains -0 on success or a non-zero error code upon return. +0 on success or a nonzero error code upon return. See @code{unlink(2)}. Some non-GNU implementations of Fortran provide this intrinsic as @@ -10695,7 +10696,7 @@ Unlink the file @var{File}. A null character (@samp{CHAR(0)}) marks the end of the name in @var{File}---otherwise, trailing blanks in @var{File} are ignored. -Returns 0 on success or a non-zero error code. +Returns 0 on success or a nonzero error code. See @code{unlink(2)}. Due to the side effects performed by this intrinsic, the function diff --git a/contrib/gcc/f/invoke.texi b/contrib/gcc/f/invoke.texi index 5474eec..50c7ca4 100644 --- a/contrib/gcc/f/invoke.texi +++ b/contrib/gcc/f/invoke.texi @@ -9,7 +9,7 @@ Copyright @copyright{} 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.1 or +under the terms of the GNU Free Documentation License, Version 1.2 or any later version published by the Free Software Foundation; with the Invariant Sections being ``GNU General Public License'' and ``Funding Free Software'', the Front-Cover texts being (a) (see below), and with @@ -182,7 +182,7 @@ by type. Explanations are in the following sections. -malign-double @gol -ffloat-store -fforce-mem -fforce-addr -fno-inline @gol -ffast-math -fstrength-reduce -frerun-cse-after-loop @gol --funsafe-math-optimizations -fno-trapping-math @gol +-funsafe-math-optimizations -ffinite-math-only -fno-trapping-math @gol -fexpensive-optimizations -fdelayed-branch @gol -fschedule-insns -fschedule-insn2 -fcaller-saves @gol -funroll-loops -funroll-all-loops @gol @@ -389,7 +389,7 @@ This option is supplied automatically when @option{-v} or @option{--verbose} is specified as a command-line option for @command{g77} or @command{gcc} and when the resulting commands compile Fortran source files. -In GCC 3.1, this is changed back to the behaviour @command{gcc} displays +In GCC 3.1, this is changed back to the behavior @command{gcc} displays for @samp{.c} files. @cindex -fset-g77-defaults option @@ -1356,6 +1356,12 @@ Some of these have no effect when compiling programs written in Fortran: @cindex -Wswitch option @cindex options, -Wswitch @item -Wswitch +@cindex -Wswitch-default option +@cindex options, -Wswitch-default +@item -Wswitch-default +@cindex -Wswitch-enum option +@cindex options, -Wswitch-enum +@item -Wswitch-enum @cindex -Wtraditional option @cindex options, -Wtraditional @item -Wtraditional @@ -1536,8 +1542,8 @@ Note that if you are not optimizing, no functions can be expanded inline. @cindex conformance, IEEE 754 Might allow some programs designed to not be too dependent on IEEE behavior for floating-point to run faster, or die trying. -Sets @option{-funsafe-math-optimizations}, and -@option{-fno-trapping-math}. +Sets @option{-funsafe-math-optimizations}, @option{-ffinite-math-only}, +and @option{-fno-trapping-math}. @cindex -funsafe-math-optimizations option @cindex options, -funsafe-math-optimizations @@ -1545,6 +1551,18 @@ Sets @option{-funsafe-math-optimizations}, and Allow optimizations that may be give incorrect results for certain IEEE inputs. +@cindex -ffinite-math-only option +@cindex options, -ffinite-math-only +@item -ffinite-math-only +Allow optimizations for floating-point arithmetic that assume +that arguments and results are not NaNs or +-Infs. + +This option should never be turned on by any @option{-O} option since +it can result in incorrect output for programs which depend on +an exact implementation of IEEE or ISO rules/specifications. + +The default is @option{-fno-finite-math-only}. + @cindex -fno-trapping-math option @cindex options, -fno-trapping-math @item -fno-trapping-math diff --git a/contrib/gcc/f/lang-specs.h b/contrib/gcc/f/lang-specs.h index d6018bd..62b78c6 100644 --- a/contrib/gcc/f/lang-specs.h +++ b/contrib/gcc/f/lang-specs.h @@ -1,5 +1,5 @@ /* lang-specs.h file for Fortran - Copyright (C) 1995, 1996, 1997, 1999, 2000, 2002 + Copyright (C) 1995, 1996, 1997, 1999, 2000, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. @@ -29,12 +29,15 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA {".fpp", "@f77-cpp-input", 0}, {".FPP", "@f77-cpp-input", 0}, {"@f77-cpp-input", - "tradcpp0 -lang-fortran %(cpp_options) %{!M:%{!MM:%{!E:%{!pipe:%g.f} |\n\ + "cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \ + %{E|M|MM:%(cpp_debug_options)}\ + %{!M:%{!MM:%{!E:%{!pipe:%g.f} |\n\ f771 %{!pipe:%g.f} %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}}}", 0}, {".r", "@ratfor", 0}, {"@ratfor", "%{C:%{!E:%eGNU C does not support -C without using -E}}\ - ratfor %{C} %{v} %{E:%W{o*}} %{!E: %{!pipe:-o %g.f} %i |\n\ + %{CC:%{!E:%eGNU C does not support -CC without using -E}}\ + ratfor %{C} %{CC} %{v} %{E:%W{o*}} %{!E: %{!pipe:-o %g.f} %i |\n\ f771 %{!pipe:%g.f} %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}", 0}, {".f", "@f77", 0}, {".for", "@f77", 0}, diff --git a/contrib/gcc/f/lex.c b/contrib/gcc/f/lex.c index d9f3bad..6d065dd 100644 --- a/contrib/gcc/f/lex.c +++ b/contrib/gcc/f/lex.c @@ -93,7 +93,7 @@ static ffelexType ffelex_first_char_[256]; /* The wf argument of the most recent active ffelex_file_(fixed,free) function. */ -static ffewhereFile ffelex_current_wf_; +static GTY (()) ffewhereFile ffelex_current_wf_; /* TRUE if an INCLUDE statement can be processed (ffelex_set_include can be called). */ @@ -106,7 +106,7 @@ static bool ffelex_set_include_; /* Information on the pending INCLUDE file. */ static FILE *ffelex_include_file_; static bool ffelex_include_free_form_; -static ffewhereFile ffelex_include_wherefile_; +static GTY(()) ffewhereFile ffelex_include_wherefile_; /* Current master line count. */ static ffewhereLineNumber ffelex_linecount_current_; @@ -246,8 +246,6 @@ ffelex_backslash_ (int c, ffewhereColumnNumber col) hollerith constants. */ #define wide_flag 0 -#define warn_traditional 0 -#define flag_traditional 0 switch (state) { @@ -268,18 +266,6 @@ ffelex_backslash_ (int c, ffewhereColumnNumber col) switch (c) { case 'x': - if (warn_traditional) - { - /* xgettext:no-c-format */ - ffebad_start_msg_lex ("The meaning of `\\x' (at %0) varies with -traditional", - FFEBAD_severityWARNING); - ffelex_bad_here_ (0, line, column); - ffebad_finish (); - } - - if (flag_traditional) - return c; - code = 0; count = 0; nonnull = 0; @@ -319,24 +305,9 @@ ffelex_backslash_ (int c, ffewhereColumnNumber col) return TARGET_BS; case 'a': - if (warn_traditional) - { - /* xgettext:no-c-format */ - ffebad_start_msg_lex ("The meaning of `\\a' (at %0) varies with -traditional", - FFEBAD_severityWARNING); - ffelex_bad_here_ (0, line, column); - ffebad_finish (); - } - - if (flag_traditional) - return c; return TARGET_BELL; case 'v': -#if 0 /* Vertical tab is present in common usage compilers. */ - if (flag_traditional) - return c; -#endif return TARGET_VT; case 'e': @@ -589,12 +560,6 @@ ffelex_cfebackslash_ (int *use_d, int *d, FILE *finput) switch (c) { case 'x': - if (warn_traditional) - warning ("the meaning of `\\x' varies with -traditional"); - - if (flag_traditional) - return c; - code = 0; count = 0; nonnull = 0; @@ -672,18 +637,9 @@ ffelex_cfebackslash_ (int *use_d, int *d, FILE *finput) return TARGET_BS; case 'a': - if (warn_traditional) - warning ("the meaning of `\\a' varies with -traditional"); - - if (flag_traditional) - return c; return TARGET_BELL; case 'v': -#if 0 /* Vertical tab is present in common usage compilers. */ - if (flag_traditional) - return c; -#endif return TARGET_VT; case 'e': @@ -4678,3 +4634,5 @@ ffelex_token_use (ffelexToken t) t->uses++; return t; } + +#include "gt-f-lex.h" diff --git a/contrib/gcc/f/news.texi b/contrib/gcc/f/news.texi index 37b08d9..fe6fa80 100644 --- a/contrib/gcc/f/news.texi +++ b/contrib/gcc/f/news.texi @@ -1,4 +1,4 @@ -@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 @c Free Software Foundation, Inc. @c This is part of the G77 manual. @c For copying conditions, see the file g77.texi. @@ -8,13 +8,12 @@ @c Keep this the same as the dates above, since it's used @c in the standalone derivations of this file (e.g. NEWS). -@set copyrights-news 1995,1996,1997,1998,1999,2000,2001,2002 +@set copyrights-news 1995,1996,1997,1998,1999,2000,2001,2002,2003 -@set last-update-news 2002-10-28 - -@include root.texi +@set last-update-news 2003-05-18 @ifset DOC-NEWS +@include root.texi @c The immediately following lines apply to the NEWS file @c which is derived from this file. @emph{Note:} This file is automatically generated from the files @@ -148,18 +147,69 @@ An online, ``live'' version of this document (derived directly from the mainline, development version of @command{g77} within @command{gcc}) is available at -@uref{http://www.gnu.org/software/gcc/onlinedocs/g77/News.html}. +@uref{http://gcc.gnu.org/onlinedocs/g77/News.html}. @end ifclear The following information was last updated on @value{last-update-news}: +@heading In @code{GCC} 3.3 versus @code{GCC} 3.2: +@itemize @bullet +@item +Problem Reports fixed (in chronological order of submission): +@table @code +@item 1832 +-list directed i/o overflow hangs, -fbounds-check doesn't detect +@item 3924 +g77 generates code which is rejected by GAS if COFF debugging info is +requested +@item 6286 +Broken links on web pages +@item 6367 +(libf2c) multiple repeat counts confuse namelist read into array +@item 6491 +Logical operations error on logicals when using -fugly-logint +@item 6742 +Generation of C++ Prototype for FORTRAN and extern "C" +@item 7113 +Failure of g77.f-torture/execute/f90-intrinsic-bit.f -Os on irix6.5 +@item 7236 +(libf2c) OPEN(...,RECL=nnn,...) without ACCESS='DIRECT' should assume a direct +access file +@item 7278 +g77 "bug"; the executable misbehave (use of options -O2 -fno-automatic +gave wrong results) +@item 7384 +(libf2c) DATE_AND_TIME milliseconds field inactive on Windows +@item 7388 +Incorrect output with 0-based array of characters +@item 8587 +Double complex zero ** double precision number -> NaN instead of zero +@item 9038 +-ffixed-line-length-none -x f77-cpp-input gives: Warning: unknown register name line-length-none +@item 9263 +ICE caused by invalid PARAMETER in implied DO loop +@item 10197 +Direct access files not unformatted by default +@item 10726 +Documentation for function IDATE Intrinsic (UNIX) is wrong [fixed in 3.3.1]. +@end table +@item +Richard Henderson (@email{rth@@redhat.com}) analyzed and improved the handling +of (no-)aliasing information for dummy arguments and improved the optimization +of induction variables in unrolled loops. +@end itemize + @heading In @code{GCC} 3.2 versus @code{GCC} 3.1: @itemize @bullet @item Problem Reports fixed (in chronological order of submission): @table @code +@item 7681 +ICE in compensate_edge, at reg-stack.c:2591 @item 8308 gcc-3.x does not compile files with suffix .r (RATFOR) [Fixed in 3.2.1] +@item 9258 +[3.2/3.3/3.4 regression] ICE in compensate_edge, at reg-stack.c:2589 @end table @end itemize @@ -192,6 +242,12 @@ ICE on compiling source with 540 000 000 REAL array ICE on BESJN(integer*8,real) @item 5837 bug in loop unrolling +@item 6106 +sparc-sun-solaris2.7 gcc-3.1 extra g77 testsuite failures w/-m64 +@item 6138 +Incorrect acces of integer*1 variables on PA +@item 6304 +Failure of LAPACK test dtest on irix6.5 with -mabi=64 -O2 @end table @item @@ -217,8 +273,8 @@ because 140 000 000 REALs is larger than the largest bit-extent that can be expressed in 32 bits. However, bit-sizes never play a role after offsets have been converted to byte addresses. Therefore this check has been removed, and the limit is now 2 Gbyte of memory (around 530 000 000 REALs). -Note: On GNU/Linux systems one has to compile programs that occupy more -than 1 Gbyte statically, i.e.@: @code{g77 -static ...}. +Note: On GNU/Linux systems one has to compile and link programs that occupy +more than 1 Gbyte statically, i.e.@: @code{g77 -static ...}. @item Based on work done by Juergen Pfeifer (@email{juergen.pfeifer@@gmx.net}) @@ -2311,7 +2367,7 @@ fix up some of the build procedures. @item Change code generation for list-directed I/O so it allows -for new versions of @code{libf2c} that might return non-zero +for new versions of @code{libf2c} that might return nonzero status codes for some operations previously assumed to always return zero. diff --git a/contrib/gcc/f/parse.c b/contrib/gcc/f/parse.c index 29c6133..106ff3f 100644 --- a/contrib/gcc/f/parse.c +++ b/contrib/gcc/f/parse.c @@ -26,17 +26,16 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #include "version.h" #include "flags.h" -#define NAME_OF_STDIN "<stdin>" - extern FILE *finput; -int -yyparse () +void +ffe_parse_file (set_yydebug) + int set_yydebug ATTRIBUTE_UNUSED; { ffewhereFile wf; if (ffe_is_version ()) - fprintf (stderr, "GNU Fortran Front End version %s\n", ffe_version_string); + fprintf (stderr, "GNU Fortran Front End version %s\n", version_string); if (!ffe_is_pedantic ()) ffe_set_is_pedantic (pedantic); @@ -46,6 +45,4 @@ yyparse () ffe_file (wf, finput); ffecom_finish_compile (); - - return 0; } diff --git a/contrib/gcc/f/root.texi b/contrib/gcc/f/root.texi index 361e260..d8619cc 100644 --- a/contrib/gcc/f/root.texi +++ b/contrib/gcc/f/root.texi @@ -1,9 +1,4 @@ -@c DEVELOPMENT is set to indicate an in-development version, -@c as compared to a release version. When making a release -@c (e.g. a release branch in the CVS repository for gcc), -@c clear this and set the version information correctly. -@clear DEVELOPMENT -@set version-gcc 3.2.2 +@include gcc-common.texi @set email-general gcc@@gcc.gnu.org @set email-help gcc-help@@gcc.gnu.org @@ -12,7 +7,7 @@ @set path-g77 gcc/gcc/f @set path-libf2c gcc/libf2c -@set which-g77 GCC-@value{version-gcc} +@set which-g77 GCC-@value{version-GCC} @set which-gcc GCC @set email-burley craig@@jcb-sc.com diff --git a/contrib/gcc/f/stc.c b/contrib/gcc/f/stc.c index 1f17766..b9602c2 100644 --- a/contrib/gcc/f/stc.c +++ b/contrib/gcc/f/stc.c @@ -1,5 +1,5 @@ /* stc.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 1997, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -9195,18 +9195,19 @@ ffestc_R810 (ffesttCaseList cases, ffelexToken name) ffebad_finish (); continue; } - if (((caseobj->expr1 != NULL) && ((ffeinfo_basictype (ffebld_info (caseobj->expr1)) != s->type) - || (ffeinfo_kindtype (ffebld_info (caseobj->expr1)) - != s->kindtype))) + || ((ffeinfo_kindtype (ffebld_info (caseobj->expr1)) + != s->kindtype) + && (ffeinfo_kindtype (ffebld_info (caseobj->expr1)) != FFEINFO_kindtypeINTEGER1 )) || ((caseobj->range) && (caseobj->expr2 != NULL) && ((ffeinfo_basictype (ffebld_info (caseobj->expr2)) != s->type) - || (ffeinfo_kindtype (ffebld_info (caseobj->expr2)) - != s->kindtype)))) + || ((ffeinfo_kindtype (ffebld_info (caseobj->expr2)) + != s->kindtype) + && (ffeinfo_kindtype (ffebld_info (caseobj->expr2)) != FFEINFO_kindtypeINTEGER1))))))) { ffebad_start (FFEBAD_CASE_TYPE_DISAGREE); ffebad_here (0, ffelex_token_where_line (caseobj->t), @@ -9217,6 +9218,8 @@ ffestc_R810 (ffesttCaseList cases, ffelexToken name) continue; } + + if ((s->type == FFEINFO_basictypeLOGICAL) && (caseobj->range)) { ffebad_start (FFEBAD_CASE_LOGICAL_RANGE); diff --git a/contrib/gcc/f/std.c b/contrib/gcc/f/std.c index db8c723..bd2add2 100644 --- a/contrib/gcc/f/std.c +++ b/contrib/gcc/f/std.c @@ -1,5 +1,5 @@ /* std.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2000, 2002 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -4774,9 +4774,7 @@ ffestd_S3P4 (ffebld filename) fi = ffecom_open_include (ffewhere_file_name (wf), ffelex_token_where_line (ffesta_tokens[0]), ffelex_token_where_column (ffesta_tokens[0])); - if (fi == NULL) - ffewhere_file_kill (wf); - else + if (fi != NULL) ffelex_set_include (wf, (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME), fi); } diff --git a/contrib/gcc/f/ste.c b/contrib/gcc/f/ste.c index 2959984..2ddf181 100644 --- a/contrib/gcc/f/ste.c +++ b/contrib/gcc/f/ste.c @@ -1,5 +1,5 @@ /* ste.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 1996, 2000, 2002 Free Software Foundation, Inc. + Copyright (C) 1995, 1996, 2000, 2002, 2003 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -1162,13 +1162,13 @@ ffeste_io_douio_ (ffebld expr) declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ +static GTY(()) tree f2c_alist_struct; static tree ffeste_io_ialist_ (bool have_err, ffestvUnit unit, ffebld unit_expr, int unit_dflt) { - static tree f2c_alist_struct = NULL_TREE; tree t; tree ttype; tree field; @@ -1193,8 +1193,6 @@ ffeste_io_ialist_ (bool have_err, TYPE_FIELDS (ref) = errfield; layout_type (ref); - ggc_add_tree_root (&f2c_alist_struct, 1); - f2c_alist_struct = ref; } @@ -1283,6 +1281,7 @@ ffeste_io_ialist_ (bool have_err, declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ +static GTY(()) tree f2c_cilist_struct; static tree ffeste_io_cilist_ (bool have_err, ffestvUnit unit, @@ -1294,7 +1293,6 @@ ffeste_io_cilist_ (bool have_err, bool rec, ffebld rec_expr) { - static tree f2c_cilist_struct = NULL_TREE; tree t; tree ttype; tree field; @@ -1325,8 +1323,6 @@ ffeste_io_cilist_ (bool have_err, TYPE_FIELDS (ref) = errfield; layout_type (ref); - ggc_add_tree_root (&f2c_cilist_struct, 1); - f2c_cilist_struct = ref; } @@ -1508,12 +1504,12 @@ ffeste_io_cilist_ (bool have_err, declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ +static GTY(()) tree f2c_close_struct; static tree ffeste_io_cllist_ (bool have_err, ffebld unit_expr, ffestpFile *stat_spec) { - static tree f2c_close_struct = NULL_TREE; tree t; tree ttype; tree field; @@ -1541,8 +1537,6 @@ ffeste_io_cllist_ (bool have_err, TYPE_FIELDS (ref) = errfield; layout_type (ref); - ggc_add_tree_root (&f2c_close_struct, 1); - f2c_close_struct = ref; } @@ -1622,6 +1616,7 @@ ffeste_io_cllist_ (bool have_err, declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ +static GTY(()) tree f2c_icilist_struct; static tree ffeste_io_icilist_ (bool have_err, ffebld unit_expr, @@ -1629,7 +1624,6 @@ ffeste_io_icilist_ (bool have_err, ffestvFormat format, ffestpFile *format_spec) { - static tree f2c_icilist_struct = NULL_TREE; tree t; tree ttype; tree field; @@ -1663,8 +1657,6 @@ ffeste_io_icilist_ (bool have_err, TYPE_FIELDS (ref) = errfield; layout_type (ref); - ggc_add_tree_root (&f2c_icilist_struct, 1); - f2c_icilist_struct = ref; } @@ -1851,6 +1843,7 @@ ffeste_io_icilist_ (bool have_err, declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ +static GTY(()) tree f2c_inquire_struct; static tree ffeste_io_inlist_ (bool have_err, ffestpFile *unit_spec, @@ -1870,7 +1863,6 @@ ffeste_io_inlist_ (bool have_err, ffestpFile *nextrec_spec, ffestpFile *blank_spec) { - static tree f2c_inquire_struct = NULL_TREE; tree t; tree ttype; tree field; @@ -1959,8 +1951,6 @@ ffeste_io_inlist_ (bool have_err, TYPE_FIELDS (ref) = errfield; layout_type (ref); - ggc_add_tree_root (&f2c_inquire_struct, 1); - f2c_inquire_struct = ref; } @@ -2109,6 +2099,7 @@ ffeste_io_inlist_ (bool have_err, declaration of variables (temporaries) to the expanding of expressions, statements, etc. */ +static GTY(()) tree f2c_open_struct; static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr, @@ -2119,7 +2110,6 @@ ffeste_io_olist_ (bool have_err, ffestpFile *recl_spec, ffestpFile *blank_spec) { - static tree f2c_open_struct = NULL_TREE; tree t; tree ttype; tree field; @@ -2163,8 +2153,6 @@ ffeste_io_olist_ (bool have_err, TYPE_FIELDS (ref) = errfield; layout_type (ref); - ggc_add_tree_root (&f2c_open_struct, 1); - f2c_open_struct = ref; } @@ -2723,21 +2711,27 @@ ffeste_R810 (ffestw block, unsigned long casenum) do { texprlow = (c->low == NULL) ? NULL_TREE - : ffecom_constantunion (&ffebld_constant_union (c->low), s->type, - s->kindtype, - ffecom_tree_type[s->type][s->kindtype]); + : ffecom_constantunion_with_type (&ffebld_constant_union (c->low), + ffecom_tree_type[s->type][s->kindtype], c->low->consttype); if (c->low != c->high) { texprhigh = (c->high == NULL) ? NULL_TREE - : ffecom_constantunion (&ffebld_constant_union (c->high), - s->type, s->kindtype, - ffecom_tree_type[s->type][s->kindtype]); + : ffecom_constantunion_with_type (&ffebld_constant_union (c->high), + ffecom_tree_type[s->type][s->kindtype], c->high->consttype); pushok = pushcase_range (texprlow, texprhigh, convert, tlabel, &duplicate); } else pushok = pushcase (texprlow, convert, tlabel, &duplicate); - assert (pushok == 0); + assert((pushok !=2) || (pushok !=0)); + if (pushok==2) + { + ffebad_start_msg ("SELECT (at %0) has duplicate cases -- check integer overflow of CASE(s)", + FFEBAD_severityFATAL); + ffebad_here (0, ffestw_line (block), ffestw_col (block)); + ffebad_finish (); + ffestw_set_select_texpr (block, error_mark_node); + } c = c->next_stmt; /* Unlink prev. */ c->previous_stmt->previous_stmt->next_stmt = c; @@ -4618,3 +4612,5 @@ ffeste_terminate_2 (void) assert (! ffeste_top_block_); } #endif + +#include "gt-f-ste.h" diff --git a/contrib/gcc/f/target.c b/contrib/gcc/f/target.c index 086faed..82ae955 100644 --- a/contrib/gcc/f/target.c +++ b/contrib/gcc/f/target.c @@ -69,13 +69,13 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA /* Include files. */ #include "proj.h" -#include "glimits.h" #include "target.h" #include "diagnostic.h" #include "bad.h" #include "info.h" #include "lex.h" #include "malloc.h" +#include "real.h" /* Externals defined here. */ @@ -2191,7 +2191,7 @@ ffetarget_print_hex (FILE *f, ffetargetTypeless value) { char *p; char digits[sizeof (value) * CHAR_BIT / 4 + 1]; - static char hexdigits[16] = "0123456789ABCDEF"; + static const char hexdigits[16] = "0123456789ABCDEF"; if (f == NULL) f = dmpout; @@ -2277,9 +2277,11 @@ ffetarget_real1 (ffetargetReal1 *value, ffelexToken integer, *p = '\0'; - ffetarget_make_real1 (value, - FFETARGET_ATOF_ (ptr, - SFmode)); + { + REAL_VALUE_TYPE rv; + rv = FFETARGET_ATOF_ (ptr, SFmode); + ffetarget_make_real1 (value, rv); + } if (sz > ARRAY_SIZE (ffetarget_string_)) malloc_kill_ks (malloc_pool_image (), ptr, sz); @@ -2363,9 +2365,11 @@ ffetarget_real2 (ffetargetReal2 *value, ffelexToken integer, *p = '\0'; - ffetarget_make_real2 (value, - FFETARGET_ATOF_ (ptr, - DFmode)); + { + REAL_VALUE_TYPE rv; + rv = FFETARGET_ATOF_ (ptr, DFmode); + ffetarget_make_real2 (value, rv); + } if (sz > ARRAY_SIZE (ffetarget_string_)) malloc_kill_ks (malloc_pool_image (), ptr, sz); diff --git a/contrib/gcc/f/target.h b/contrib/gcc/f/target.h index df73dab..2125ad5 100644 --- a/contrib/gcc/f/target.h +++ b/contrib/gcc/f/target.h @@ -38,16 +38,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA #endif #endif -/* For now, g77 requires the ability to determine the exact bit pattern - of a float on the target machine. (Hopefully this will be changed - soon). Make sure we can do this. */ - -#if !defined (REAL_ARITHMETIC) \ - && ((TARGET_FLOAT_FORMAT != HOST_FLOAT_FORMAT) \ - || (FLOAT_WORDS_BIG_ENDIAN != HOST_FLOAT_WORDS_BIG_ENDIAN)) -#error "g77 requires ability to access exact FP representation of target machine" -#endif - /* Simple definitions and enumerations. */ #define FFETARGET_charactersizeNONE (-1) @@ -341,117 +331,53 @@ typedef ? ffetargetLogical8; ? #endif #if FFETARGET_okREAL1 -#ifdef REAL_ARITHMETIC -#ifdef FFETARGET_32bit_longs -typedef long int ffetargetReal1; -#define ffetargetReal1_f "l" -#define ffetarget_cvt_r1_to_rv_ REAL_VALUE_UNTO_TARGET_SINGLE -#define ffetarget_cvt_rv_to_r1_ REAL_VALUE_TO_TARGET_SINGLE -#else typedef int ffetargetReal1; #define ffetargetReal1_f "" -#define ffetarget_cvt_r1_to_rv_(in) \ - ({ REAL_VALUE_TYPE _rv; \ - _rv = REAL_VALUE_UNTO_TARGET_SINGLE ((long) (in)); \ +#define ffetarget_cvt_r1_to_rv_(in) \ + ({ REAL_VALUE_TYPE _rv; \ + long _in = (in); \ + real_from_target (&_rv, &_in, mode_for_size (32, MODE_FLOAT, 0)); \ _rv; }) #define ffetarget_cvt_rv_to_r1_(in, out) \ ({ long _tmp; \ REAL_VALUE_TO_TARGET_SINGLE ((in), _tmp); \ (out) = (ffetargetReal1) _tmp; }) #endif -#else /* REAL_ARITHMETIC */ -typedef float ffetargetReal1; -#define ffetargetReal1_f "" -#endif /* REAL_ARITHMETIC */ -#endif #if FFETARGET_okREAL2 -#ifdef REAL_ARITHMETIC -#ifdef FFETARGET_32bit_longs -typedef struct - { - long int v[2]; - } -ffetargetReal2; -#define ffetargetReal2_f "l" -#define ffetarget_cvt_r2_to_rv_ REAL_VALUE_UNTO_TARGET_DOUBLE -#define ffetarget_cvt_rv_to_r2_ REAL_VALUE_TO_TARGET_DOUBLE -#else -typedef struct - { - int v[2]; - } -ffetargetReal2; +typedef struct { int v[2]; } ffetargetReal2; #define ffetargetReal2_f "" -#define ffetarget_cvt_r2_to_rv_(in) \ - ({ REAL_VALUE_TYPE _rv; \ - long _tmp[2]; \ - _tmp[0] = (in)[0]; \ - _tmp[1] = (in)[1]; \ - _rv = REAL_VALUE_UNTO_TARGET_DOUBLE (_tmp); \ +#define ffetarget_cvt_r2_to_rv_(in) \ + ({ REAL_VALUE_TYPE _rv; long _tmp[2]; \ + _tmp[0] = (in)[0]; _tmp[1] = (in)[1]; \ + real_from_target (&_rv, _tmp, mode_for_size (64, MODE_FLOAT, 0)); \ _rv; }) -#define ffetarget_cvt_rv_to_r2_(in, out) \ - ({ long _tmp[2]; \ - REAL_VALUE_TO_TARGET_DOUBLE ((in), _tmp); \ - (out)[0] = (int) (_tmp[0]); \ - (out)[1] = (int) (_tmp[1]); }) -#endif -#else -typedef double ffetargetReal2; -#define ffetargetReal2_f "" -#endif +#define ffetarget_cvt_rv_to_r2_(in, out) \ + ({ long _tmp[2]; \ + REAL_VALUE_TO_TARGET_DOUBLE ((in), _tmp); \ + (out)[0] = (int)_tmp[0]; (out)[1] = (int)_tmp[1]; }) #endif #if FFETARGET_okREAL3 -#ifdef REAL_ARITHMETIC typedef long ffetargetReal3[?]; -#else -typedef ? ffetargetReal3; -#define ffetargetReal3_f -#endif ? #endif #if FFETARGET_okREAL4 -#ifdef REAL_ARITHMETIC typedef long ffetargetReal4[?]; -#else -typedef ? ffetargetReal4; -#define ffetargetReal4_f -#endif ? #endif #if FFETARGET_okREAL5 -#ifdef REAL_ARITHMETIC typedef long ffetargetReal5[?]; -#else -typedef ? ffetargetReal5; -#define ffetargetReal5_f -#endif ? #endif #if FFETARGET_okREAL6 -#ifdef REAL_ARITHMETIC typedef long ffetargetReal6[?]; -#else -typedef ? ffetargetReal6; -#define ffetargetReal6_f -#endif ? #endif #if FFETARGET_okREAL7 -#ifdef REAL_ARITHMETIC typedef long ffetargetReal7[?]; -#else -typedef ? ffetargetReal7; -#define ffetargetReal7_f -#endif ? #endif #if FFETARGET_okREAL8 -#ifdef REAL_ARITHMETIC typedef long ffetargetReal8[?]; -#else -typedef ? ffetargetReal8; -#define ffetargetReal8_f -#endif ? #endif #if FFETARGET_okCOMPLEX1 @@ -872,7 +798,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0), \ ((kt == 1) ? SFmode : DFmode)) -#ifdef REAL_ARITHMETIC #define ffetarget_add_complex1(res,l,r) \ ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \ @@ -895,19 +820,10 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \ ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \ FFEBAD; }) -#else -#define ffetarget_add_complex1(res,l,r) \ - ((res)->real = (l).real + (r).real, \ - (res)->imaginary = (l).imaginary + (r).imaginary, FFEBAD) -#define ffetarget_add_complex2(res,l,r) \ - ((res)->real = (l).real + (r).real, \ - (res)->imaginary = (l).imaginary + (r).imaginary, FFEBAD) -#endif #define ffetarget_add_integer1(res,l,r) (*(res) = (l) + (r), FFEBAD) #define ffetarget_add_integer2(res,l,r) (*(res) = (l) + (r), FFEBAD) #define ffetarget_add_integer3(res,l,r) (*(res) = (l) + (r), FFEBAD) #define ffetarget_add_integer4(res,l,r) (*(res) = (l) + (r), FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_add_real1(res,l,r) \ ({ REAL_VALUE_TYPE lr, rr, resr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -922,10 +838,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \ ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \ FFEBAD; }) -#else -#define ffetarget_add_real1(res,l,r) (*(res) = (l) + (r), FFEBAD) -#define ffetarget_add_real2(res,l,r) (*(res) = (l) + (r), FFEBAD) -#endif #define ffetarget_aggregate_ptr_memcpy(dbt,dkt,sbt,skt) \ ((ffetargetCopyfunc) ffetarget_memcpy_) #define ffetarget_and_integer1(res,l,r) (*(res) = (l) & (r), FFEBAD) @@ -969,7 +881,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l) #define ffetarget_convert_complex1_typeless(res,l) \ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l) -#ifdef REAL_ARITHMETIC #define ffetarget_convert_complex1_complex2(res,l) \ ({ REAL_VALUE_TYPE lr, li; \ lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \ @@ -977,11 +888,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \ ffetarget_cvt_rv_to_r1_ (li, (res)->imaginary), \ FFEBAD; }) -#else -#define ffetarget_convert_complex1_complex2(res,l) \ - ((res)->real = (l).real, (res)->imaginary = (l).imaginary, FFEBAD) -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_convert_complex1_integer(res,l) \ ({ REAL_VALUE_TYPE resi, resr; \ ffetargetInteger1 lf = (l); \ @@ -990,19 +896,10 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \ ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \ FFEBAD; }) -#else -#define ffetarget_convert_complex1_integer(res,l) \ - ((res)->real = (l), (res)->imaginary = 0, FFEBAD) -#endif #define ffetarget_convert_complex1_integer1 ffetarget_convert_complex1_integer #define ffetarget_convert_complex1_integer2 ffetarget_convert_complex1_integer #define ffetarget_convert_complex1_integer3 ffetarget_convert_complex1_integer -#ifdef REAL_ARITHMETIC #define ffetarget_convert_complex1_integer4(res,l) FFEBAD_NOCANDO -#else -#define ffetarget_convert_complex1_integer4 ffetarget_convert_complex1_integer -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_convert_complex1_real1(res,l) \ ((res)->real = (l), \ ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \ @@ -1013,19 +910,12 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \ ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \ FFEBAD; }) -#else -#define ffetarget_convert_complex1_real1(res,l) \ - ((res)->real = (l), (res)->imaginary = 0, FFEBAD) -#define ffetarget_convert_complex1_real2(res,l) \ - ((res)->real = (l), (res)->imaginary = 0, FFEBAD) -#endif #define ffetarget_convert_complex2_character1(res,l) \ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l) #define ffetarget_convert_complex2_hollerith(res,l) \ ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l) #define ffetarget_convert_complex2_typeless(res,l) \ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l) -#ifdef REAL_ARITHMETIC #define ffetarget_convert_complex2_complex1(res,l) \ ({ REAL_VALUE_TYPE lr, li; \ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \ @@ -1033,11 +923,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \ ffetarget_cvt_rv_to_r2_ (li, &((res)->imaginary.v[0])), \ FFEBAD; }) -#else -#define ffetarget_convert_complex2_complex1(res,l) \ - ((res)->real = (l).real, (res)->imaginary = (l).imaginary, FFEBAD) -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_convert_complex2_integer(res,l) \ ({ REAL_VALUE_TYPE resi, resr; \ ffetargetInteger1 lf = (l); \ @@ -1046,19 +931,10 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \ ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \ FFEBAD; }) -#else -#define ffetarget_convert_complex2_integer(res,l) \ - ((res)->real = (l), (res)->imaginary = 0, FFEBAD) -#endif #define ffetarget_convert_complex2_integer1 ffetarget_convert_complex2_integer #define ffetarget_convert_complex2_integer2 ffetarget_convert_complex2_integer #define ffetarget_convert_complex2_integer3 ffetarget_convert_complex2_integer -#ifdef REAL_ARITHMETIC #define ffetarget_convert_complex2_integer4(res,l) FFEBAD_NOCANDO -#else -#define ffetarget_convert_complex2_integer4 ffetarget_convert_complex2_integer -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_convert_complex2_real1(res,l) \ ({ REAL_VALUE_TYPE lr; \ lr = ffetarget_cvt_r1_to_rv_ (l); \ @@ -1069,12 +945,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ((res)->real = (l), \ ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \ FFEBAD) -#else -#define ffetarget_convert_complex2_real1(res,l) \ - ((res)->real = (l), (res)->imaginary = 0, FFEBAD) -#define ffetarget_convert_complex2_real2(res,l) \ - ((res)->real = (l), (res)->imaginary = 0, FFEBAD) -#endif #define ffetarget_convert_integer2_character1(res,l) \ ffetarget_convert_integer1_character1(res,l) #define ffetarget_convert_integer2_complex1(res,l) \ @@ -1127,15 +997,8 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_convert_integer1_typeless(res,l) #define ffetarget_convert_integer4_character1(res,l) \ ffetarget_convert_integer1_character1(res,l) -#ifdef REAL_ARITHMETIC #define ffetarget_convert_integer4_complex1(res,l) FFEBAD_NOCANDO #define ffetarget_convert_integer4_complex2(res,l) FFEBAD_NOCANDO -#else -#define ffetarget_convert_integer4_complex1(res,l) \ - ffetarget_convert_integer1_complex1(res,l) -#define ffetarget_convert_integer4_complex2(res,l) \ - ffetarget_convert_integer1_complex2(res,l) -#endif #define ffetarget_convert_integer4_hollerith(res,l) \ ffetarget_convert_integer1_hollerith(res,l) #define ffetarget_convert_integer4_integer1(res,l) (*(res) = (l), FFEBAD) @@ -1149,15 +1012,8 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_convert_integer1_logical1(res,l) #define ffetarget_convert_integer4_logical4(res,l) \ ffetarget_convert_integer1_logical1(res,l) -#ifdef REAL_ARITHMETIC #define ffetarget_convert_integer4_real1(res,l) FFEBAD_NOCANDO #define ffetarget_convert_integer4_real2(res,l) FFEBAD_NOCANDO -#else -#define ffetarget_convert_integer4_real1(res,l) \ - ffetarget_convert_integer1_real1(res,l) -#define ffetarget_convert_integer4_real2(res,l) \ - ffetarget_convert_integer1_real2(res,l) -#endif #define ffetarget_convert_integer4_typeless(res,l) \ ffetarget_convert_integer1_typeless(res,l) #define ffetarget_convert_logical1_character1(res,l) \ @@ -1225,7 +1081,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); #define ffetarget_convert_integer1_logical2(res,l) (*(res) = (l), FFEBAD) #define ffetarget_convert_integer1_logical3(res,l) (*(res) = (l), FFEBAD) #define ffetarget_convert_integer1_logical4(res,l) (*(res) = (l), FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_convert_integer1_real1(res,l) \ ({ REAL_VALUE_TYPE lr; \ lr = ffetarget_cvt_r1_to_rv_ (l); \ @@ -1250,12 +1105,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \ *(res) = ffetarget_long_val_; \ FFEBAD; }) -#else -#define ffetarget_convert_integer1_real1(res,l) (*(res) = (l), FFEBAD) -#define ffetarget_convert_integer1_real2(res,l) (*(res) = (l), FFEBAD) -#define ffetarget_convert_integer1_complex1(res,l) (*(res) = (l).real, FFEBAD) -#define ffetarget_convert_integer1_complex2(res,l) (*(res) = (l).real, FFEBAD) -#endif #define ffetarget_convert_real1_character1(res,l) \ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l) #define ffetarget_convert_real1_hollerith(res,l) \ @@ -1264,36 +1113,23 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_convert_real1_integer1(res,l) #define ffetarget_convert_real1_integer3(res,l) \ ffetarget_convert_real1_integer1(res,l) -#ifdef REAL_ARITHMETIC #define ffetarget_convert_real1_integer4(res,l) FFEBAD_NOCANDO -#else -#define ffetarget_convert_real1_integer4(res,l) \ - ffetarget_convert_real1_integer1(res,l) -#endif #define ffetarget_convert_real1_typeless(res,l) \ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l) #define ffetarget_convert_real1_complex1(res,l) (*(res) = (l).real, FFEBAD) #define ffetarget_convert_real1_complex2(res,l) \ ffetarget_convert_real1_real2 ((res), (l).real) -#ifdef REAL_ARITHMETIC #define ffetarget_convert_real1_integer1(res,l) \ ({ REAL_VALUE_TYPE resr; \ ffetargetInteger1 lf = (l); \ FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 1); \ ffetarget_cvt_rv_to_r1_ (resr, *(res)); \ FFEBAD; }) -#else -#define ffetarget_convert_real1_integer1(res,l) (*(res) = (l), FFEBAD) -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_convert_real1_real2(res,l) \ ({ REAL_VALUE_TYPE lr; \ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \ ffetarget_cvt_rv_to_r1_ (lr, *(res)); \ FFEBAD; }) -#else -#define ffetarget_convert_real1_real2(res,l) (*(res) = (l), FFEBAD) -#endif #define ffetarget_convert_real2_character1(res,l) \ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l) #define ffetarget_convert_real2_hollerith(res,l) \ @@ -1302,18 +1138,12 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_convert_real2_integer1(res,l) #define ffetarget_convert_real2_integer3(res,l) \ ffetarget_convert_real2_integer1(res,l) -#ifdef REAL_ARITHMETIC #define ffetarget_convert_real2_integer4(res,l) FFEBAD_NOCANDO -#else -#define ffetarget_convert_real2_integer4(res,l) \ - ffetarget_convert_real2_integer1(res,l) -#endif #define ffetarget_convert_real2_typeless(res,l) \ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l) #define ffetarget_convert_real2_complex1(res,l) \ ffetarget_convert_real2_real1 ((res), (l).real) #define ffetarget_convert_real2_complex2(res,l) (*(res) = (l).real, FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_convert_real2_integer(res,l) \ ({ REAL_VALUE_TYPE resr; \ ffetargetInteger1 lf = (l); \ @@ -1321,28 +1151,21 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \ FFEBAD; }) #define ffetarget_convert_real2_integer1 ffetarget_convert_real2_integer -#else -#define ffetarget_convert_real2_integer1(res,l) (*(res) = (l), FFEBAD) -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_convert_real2_real1(res,l) \ ({ REAL_VALUE_TYPE lr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ ffetarget_cvt_rv_to_r2_ (lr, &((res)->v[0])); \ FFEBAD; }) -#else -#define ffetarget_convert_real2_real1(res,l) (*(res) = (l), FFEBAD) -#endif #define ffetarget_divide_integer1(res,l,r) \ (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \ - : (*(res) = (l) / (r), FFEBAD)) + : (((r) == -1) ? (*(res) = -(l), FFEBAD) \ + : (*(res) = (l) / (r), FFEBAD))) #define ffetarget_divide_integer2(res,l,r) \ ffetarget_divide_integer1(res,l,r) #define ffetarget_divide_integer3(res,l,r) \ ffetarget_divide_integer1(res,l,r) #define ffetarget_divide_integer4(res,l,r) \ ffetarget_divide_integer1(res,l,r) -#ifdef REAL_ARITHMETIC #define ffetarget_divide_real1(res,l,r) \ ({ REAL_VALUE_TYPE lr, rr, resr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1369,15 +1192,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); FFEBAD; \ }); \ }) -#else -#define ffetarget_divide_real1(res,l,r) \ - (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \ - : (*(res) = (l) / (r), FFEBAD)) -#define ffetarget_divide_real2(res,l,r) \ - (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \ - : (*(res) = (l) / (r), FFEBAD)) -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_eq_complex1(res,l,r) \ ({ REAL_VALUE_TYPE lr, li, rr, ri; \ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \ @@ -1396,14 +1210,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \ ? TRUE : FALSE; \ FFEBAD; }) -#else -#define ffetarget_eq_complex1(res,l,r) \ - (*(res) = (((l).real == (r).real) && ((l).imaginary == (r).imaginary)) \ - ? TRUE : FALSE, FFEBAD) -#define ffetarget_eq_complex2(res,l,r) \ - (*(res) = (((l).real == (r).real) && ((l).imaginary == (r).imaginary)) \ - ? TRUE : FALSE, FFEBAD) -#endif #define ffetarget_eq_integer1(res,l,r) \ (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD) #define ffetarget_eq_integer2(res,l,r) \ @@ -1412,7 +1218,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD) #define ffetarget_eq_integer4(res,l,r) \ (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_eq_real1(res,l,r) \ ({ REAL_VALUE_TYPE lr, rr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1425,12 +1230,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \ *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \ FFEBAD; }) -#else -#define ffetarget_eq_real1(res,l,r) \ - (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD) -#define ffetarget_eq_real2(res,l,r) \ - (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD) -#endif #define ffetarget_eqv_integer1(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD) #define ffetarget_eqv_integer2(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD) #define ffetarget_eqv_integer3(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD) @@ -1447,7 +1246,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD) #define ffetarget_ge_integer4(res,l,r) \ (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_ge_real1(res,l,r) \ ({ REAL_VALUE_TYPE lr, rr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1460,12 +1258,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \ *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \ FFEBAD; }) -#else -#define ffetarget_ge_real1(res,l,r) \ - (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD) -#define ffetarget_ge_real2(res,l,r) \ - (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD) -#endif #define ffetarget_gt_integer1(res,l,r) \ (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD) #define ffetarget_gt_integer2(res,l,r) \ @@ -1474,7 +1266,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD) #define ffetarget_gt_integer4(res,l,r) \ (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_gt_real1(res,l,r) \ ({ REAL_VALUE_TYPE lr, rr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1489,12 +1280,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \ ? FALSE : TRUE; \ FFEBAD; }) -#else -#define ffetarget_gt_real1(res,l,r) \ - (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD) -#define ffetarget_gt_real2(res,l,r) \ - (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD) -#endif #define ffetarget_hexxmil(v,t) ffetarget_typeless_hex (v, t) #define ffetarget_hexxvxt(v,t) ffetarget_typeless_hex (v, t) #define ffetarget_hexzmil(v,t) ffetarget_typeless_hex (v, t) @@ -1511,7 +1296,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); #define ffetarget_integerdefault_is_magical(i) \ (((unsigned int) i) == FFETARGET_integerBIG_MAGICAL) #endif -#ifdef REAL_ARITHMETIC #define ffetarget_iszero_real1(l) \ ({ REAL_VALUE_TYPE lr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1522,10 +1306,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \ REAL_VALUES_EQUAL (lr, dconst0); \ }) -#else -#define ffetarget_iszero_real1(l) ((l) == 0.) -#define ffetarget_iszero_real2(l) ((l) == 0.) -#endif #define ffetarget_iszero_typeless(l) ((l) == 0) #define ffetarget_logical1(v,truth) (*(v) = truth ? 1 : 0) #define ffetarget_le_integer1(res,l,r) \ @@ -1536,7 +1316,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD) #define ffetarget_le_integer4(res,l,r) \ (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_le_real1(res,l,r) \ ({ REAL_VALUE_TYPE lr, rr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1551,12 +1330,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \ ? TRUE : FALSE; \ FFEBAD; }) -#else -#define ffetarget_le_real1(res,l,r) \ - (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD) -#define ffetarget_le_real2(res,l,r) \ - (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD) -#endif #define ffetarget_lt_integer1(res,l,r) \ (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD) #define ffetarget_lt_integer2(res,l,r) \ @@ -1565,7 +1338,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD) #define ffetarget_lt_integer4(res,l,r) \ (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_lt_real1(res,l,r) \ ({ REAL_VALUE_TYPE lr, rr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1578,28 +1350,16 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \ *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \ FFEBAD; }) -#else -#define ffetarget_lt_real1(res,l,r) \ - (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD) -#define ffetarget_lt_real2(res,l,r) \ - (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD) -#endif #define ffetarget_length_character1(c) ((c).length) #define ffetarget_length_characterdefault ffetarget_length_character1 -#ifdef REAL_ARITHMETIC #define ffetarget_make_real1(res,lr) \ ffetarget_cvt_rv_to_r1_ ((lr), *(res)) #define ffetarget_make_real2(res,lr) \ ffetarget_cvt_rv_to_r2_ ((lr), &((res)->v[0])) -#else -#define ffetarget_make_real1(res,lr) (*(res) = (lr)) -#define ffetarget_make_real2(res,lr) (*(res) = (lr)) -#endif #define ffetarget_multiply_integer1(res,l,r) (*(res) = (l) * (r), FFEBAD) #define ffetarget_multiply_integer2(res,l,r) (*(res) = (l) * (r), FFEBAD) #define ffetarget_multiply_integer3(res,l,r) (*(res) = (l) * (r), FFEBAD) #define ffetarget_multiply_integer4(res,l,r) (*(res) = (l) * (r), FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_multiply_real1(res,l,r) \ ({ REAL_VALUE_TYPE lr, rr, resr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1614,11 +1374,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \ ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \ FFEBAD; }) -#else -#define ffetarget_multiply_real1(res,l,r) (*(res) = (l) * (r), FFEBAD) -#define ffetarget_multiply_real2(res,l,r) (*(res) = (l) * (r), FFEBAD) -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_ne_complex1(res,l,r) \ ({ REAL_VALUE_TYPE lr, li, rr, ri; \ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \ @@ -1637,14 +1392,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \ ? FALSE : TRUE; \ FFEBAD; }) -#else -#define ffetarget_ne_complex1(res,l,r) \ - (*(res) = (((l).real != (r).real) || ((l).imaginary != (r).imaginary)) \ - ? TRUE : FALSE, FFEBAD) -#define ffetarget_ne_complex2(res,l,r) \ - (*(res) = (((l).real != (r).real) || ((l).imaginary != (r).imaginary)) \ - ? TRUE : FALSE, FFEBAD) -#endif #define ffetarget_ne_integer1(res,l,r) \ (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD) #define ffetarget_ne_integer2(res,l,r) \ @@ -1653,7 +1400,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD) #define ffetarget_ne_integer4(res,l,r) \ (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_ne_real1(res,l,r) \ ({ REAL_VALUE_TYPE lr, rr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1666,12 +1412,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \ *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \ FFEBAD; }) -#else -#define ffetarget_ne_real1(res,l,r) \ - (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD) -#define ffetarget_ne_real2(res,l,r) \ - (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD) -#endif #define ffetarget_neqv_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD) #define ffetarget_neqv_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD) #define ffetarget_neqv_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD) @@ -1727,51 +1467,30 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); fprintf ((f), "%" ffetargetLogical4_f "d", (v)) #define ffetarget_print_octalmil(f,v) ffetarget_print_octal(f,v) #define ffetarget_print_octalvxt(f,v) ffetarget_print_octal(f,v) -#ifdef REAL_ARITHMETIC #define ffetarget_print_real1(f,l) \ ({ REAL_VALUE_TYPE lr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ - REAL_VALUE_TO_DECIMAL (lr, bad_fmt_val??, ffetarget_string_); \ + real_to_decimal (ffetarget_string_, &lr \ + sizeof(ffetarget_string_), 0, 1); \ fputs (ffetarget_string_, (f)); \ }) #define ffetarget_print_real2(f,l) \ ({ REAL_VALUE_TYPE lr; \ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \ - REAL_VALUE_TO_DECIMAL (lr, bad_fmt_val??, ffetarget_string_); \ + real_to_decimal (ffetarget_string_, &lr, \ + sizeof(ffetarget_string_), 0, 1); \ fputs (ffetarget_string_, (f)); \ }) -#else -#define ffetarget_print_real1(f,v) \ - fprintf ((f), "%" ffetargetReal1_f "g", (v)) -#define ffetarget_print_real2(f,v) \ - fprintf ((f), "%" ffetargetReal2_f "g", (v)) -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_real1_one(res) ffetarget_cvt_rv_to_r1_ (dconst1, *(res)) #define ffetarget_real2_one(res) ffetarget_cvt_rv_to_r2_ (dconst1, &((res)->v[0])) -#else -#define ffetarget_real1_one(res) (*(res) = (float) 1.) -#define ffetarget_real2_one(res) (*(res) = 1.) -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_real1_two(res) ffetarget_cvt_rv_to_r1_ (dconst2, *(res)) #define ffetarget_real2_two(res) ffetarget_cvt_rv_to_r2_ (dconst2, &((res)->v[0])) -#else -#define ffetarget_real1_two(res) (*(res) = (float) 2.) -#define ffetarget_real2_two(res) (*(res) = 2.) -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_real1_zero(res) ffetarget_cvt_rv_to_r1_ (dconst0, *(res)) #define ffetarget_real2_zero(res) ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0])) -#else -#define ffetarget_real1_zero(res) (*(res) = (float) 0.) -#define ffetarget_real2_zero(res) (*(res) = 0.) -#endif #define ffetarget_size_typeless_binary(t) ((ffetarget_num_digits_(t) + 7) / 8) #define ffetarget_size_typeless_octal(t) \ ((ffetarget_num_digits_(t) * 3 + 7) / 8) #define ffetarget_size_typeless_hex(t) ((ffetarget_num_digits_(t) + 1) / 2) -#ifdef REAL_ARITHMETIC #define ffetarget_subtract_complex1(res,l,r) \ ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \ @@ -1794,19 +1513,10 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \ ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \ FFEBAD; }) -#else -#define ffetarget_subtract_complex1(res,l,r) \ - ((res)->real = (l).real - (r).real, \ - (res)->imaginary = (l).imaginary - (r).imaginary, FFEBAD) -#define ffetarget_subtract_complex2(res,l,r) \ - ((res)->real = (l).real - (r).real, \ - (res)->imaginary = (l).imaginary - (r).imaginary, FFEBAD) -#endif #define ffetarget_subtract_integer1(res,l,r) (*(res) = (l) - (r), FFEBAD) #define ffetarget_subtract_integer2(res,l,r) (*(res) = (l) - (r), FFEBAD) #define ffetarget_subtract_integer3(res,l,r) (*(res) = (l) - (r), FFEBAD) #define ffetarget_subtract_integer4(res,l,r) (*(res) = (l) - (r), FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_subtract_real1(res,l,r) \ ({ REAL_VALUE_TYPE lr, rr, resr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1821,10 +1531,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \ ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \ FFEBAD; }) -#else -#define ffetarget_subtract_real1(res,l,r) (*(res) = (l) - (r), FFEBAD) -#define ffetarget_subtract_real2(res,l,r) (*(res) = (l) - (r), FFEBAD) -#endif #define ffetarget_terminate_0() #define ffetarget_terminate_1() #define ffetarget_terminate_2() @@ -1832,7 +1538,6 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); #define ffetarget_terminate_4() #define ffetarget_text_character1(c) ((c).text) #define ffetarget_text_characterdefault ffetarget_text_character1 -#ifdef REAL_ARITHMETIC #define ffetarget_uminus_complex1(res,l) \ ({ REAL_VALUE_TYPE lr, li, resr, resi; \ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \ @@ -1851,17 +1556,10 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \ ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \ FFEBAD; }) -#else -#define ffetarget_uminus_complex1(res,l) \ - ((res)->real = -(l).real, (res)->imaginary = -(l).imaginary, FFEBAD) -#define ffetarget_uminus_complex2(res,l) \ - ((res)->real = -(l).real, (res)->imaginary = -(l).imaginary, FFEBAD) -#endif #define ffetarget_uminus_integer1(res,l) (*(res) = -(l), FFEBAD) #define ffetarget_uminus_integer2(res,l) (*(res) = -(l), FFEBAD) #define ffetarget_uminus_integer3(res,l) (*(res) = -(l), FFEBAD) #define ffetarget_uminus_integer4(res,l) (*(res) = -(l), FFEBAD) -#ifdef REAL_ARITHMETIC #define ffetarget_uminus_real1(res,l) \ ({ REAL_VALUE_TYPE lr, resr; \ lr = ffetarget_cvt_r1_to_rv_ ((l)); \ @@ -1874,17 +1572,8 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len); resr = REAL_VALUE_NEGATE (lr); \ ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \ FFEBAD; }) -#else -#define ffetarget_uminus_real1(res,l) (*(res) = -(l), FFEBAD) -#define ffetarget_uminus_real2(res,l) (*(res) = -(l), FFEBAD) -#endif -#ifdef REAL_ARITHMETIC #define ffetarget_value_real1(lr) ffetarget_cvt_r1_to_rv_ ((lr)) #define ffetarget_value_real2(lr) ffetarget_cvt_r2_to_rv_ (&((lr).v[0])) -#else -#define ffetarget_value_real1 -#define ffetarget_value_real2 -#endif #define ffetarget_xor_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD) #define ffetarget_xor_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD) #define ffetarget_xor_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD) diff --git a/contrib/gcc/f/top.c b/contrib/gcc/f/top.c index 774f29f..6a789e3 100644 --- a/contrib/gcc/f/top.c +++ b/contrib/gcc/f/top.c @@ -58,7 +58,6 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA /* Externals defined here. */ -int flag_traditional; /* Shouldn't need this (C front end only)! */ bool ffe_is_do_internal_checks_ = FALSE; bool ffe_is_90_ = FFETARGET_defaultIS_90; bool ffe_is_automatic_ = FFETARGET_defaultIS_AUTOMATIC; diff --git a/contrib/gcc/f/where.c b/contrib/gcc/f/where.c index 9f85354..b16f965 100644 --- a/contrib/gcc/f/where.c +++ b/contrib/gcc/f/where.c @@ -1,5 +1,5 @@ /* where.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2002 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -53,7 +53,7 @@ typedef struct _ffewhere_ll_ *ffewhereLL_; /* Internal structure definitions. */ -struct _ffewhere_ll_ +struct _ffewhere_ll_ GTY (()) { ffewhereLL_ next; ffewhereLL_ previous; @@ -62,7 +62,7 @@ struct _ffewhere_ll_ ffewhereLineNumber offset; /* User-desired offset (usually 1). */ }; -struct _ffewhere_root_ll_ +struct _ffewhere_root_ll_ GTY (()) { ffewhereLL_ first; ffewhereLL_ last; @@ -77,7 +77,7 @@ struct _ffewhere_root_line_ /* Static objects accessed by functions in this module. */ -static struct _ffewhere_root_ll_ ffewhere_root_ll_; +static GTY (()) struct _ffewhere_root_ll_ *ffewhere_root_ll_; static struct _ffewhere_root_line_ ffewhere_root_line_; /* Static functions (internal). */ @@ -95,10 +95,10 @@ ffewhere_ll_lookup_ (ffewhereLineNumber ln) ffewhereLL_ ll; if (ln == 0) - return ffewhere_root_ll_.first; + return ffewhere_root_ll_->first; - for (ll = ffewhere_root_ll_.last; - ll != (ffewhereLL_) &ffewhere_root_ll_.first; + for (ll = ffewhere_root_ll_->last; + ll != (ffewhereLL_) &ffewhere_root_ll_->first; ll = ll->previous) { if (ll->line_no <= ln) @@ -109,97 +109,17 @@ ffewhere_ll_lookup_ (ffewhereLineNumber ln) return NULL; } -/* A somewhat evil way to prevent the garbage collector - from collecting 'file' structures. */ -#define NUM_FFEWHERE_HEAD_FILES 31 -static struct ffewhere_ggc_tracker -{ - struct ffewhere_ggc_tracker *next; - ffewhereFile files[NUM_FFEWHERE_HEAD_FILES]; -} *ffewhere_head = NULL; - -static void -mark_ffewhere_head (void *arg) -{ - struct ffewhere_ggc_tracker *head; - int i; - - for (head = * (struct ffewhere_ggc_tracker **) arg; - head != NULL; - head = head->next) - { - ggc_mark (head); - for (i = 0; i < NUM_FFEWHERE_HEAD_FILES; i++) - ggc_mark (head->files[i]); - } -} - - -/* Kill file object. - - Note that this object must not have been passed in a call - to any other ffewhere function except ffewhere_file_name and - ffewhere_file_namelen. */ - -void -ffewhere_file_kill (ffewhereFile wf) -{ - struct ffewhere_ggc_tracker *head; - int i; - - for (head = ffewhere_head; head != NULL; head = head->next) - for (i = 0; i < NUM_FFEWHERE_HEAD_FILES; i++) - if (head->files[i] == wf) - { - head->files[i] = NULL; - return; - } - /* Called on a file that has already been deallocated... */ - abort(); -} - /* Create file object. */ ffewhereFile ffewhere_file_new (const char *name, size_t length) { ffewhereFile wf; - int filepos; - - wf = ggc_alloc (offsetof (struct _ffewhere_file_, text) - + length + 1); + wf = ggc_alloc (offsetof (struct _ffewhere_file_, text) + length + 1); wf->length = length; memcpy (&wf->text[0], name, length); wf->text[length] = '\0'; - if (ffewhere_head == NULL) - { - ggc_add_root (&ffewhere_head, 1, sizeof ffewhere_head, - mark_ffewhere_head); - filepos = NUM_FFEWHERE_HEAD_FILES; - } - else - { - for (filepos = 0; filepos < NUM_FFEWHERE_HEAD_FILES; filepos++) - if (ffewhere_head->files[filepos] == NULL) - { - ffewhere_head->files[filepos] = wf; - break; - } - } - if (filepos == NUM_FFEWHERE_HEAD_FILES) - { - /* Need to allocate a new block. */ - struct ffewhere_ggc_tracker *old_head = ffewhere_head; - int i; - - ffewhere_head = ggc_alloc (sizeof (*ffewhere_head)); - ffewhere_head->next = old_head; - ffewhere_head->files[0] = wf; - for (i = 1; i < NUM_FFEWHERE_HEAD_FILES; i++) - ffewhere_head->files[i] = NULL; - } - return wf; } @@ -211,10 +131,9 @@ void ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln) { ffewhereLL_ ll; - - ll = malloc_new_kp (ffe_pool_file (), "ffewhereLL_", sizeof (*ll)); - ll->next = (ffewhereLL_) &ffewhere_root_ll_.first; - ll->previous = ffewhere_root_ll_.last; + ll = ggc_alloc (sizeof (*ll)); + ll->next = (ffewhereLL_) &ffewhere_root_ll_->first; + ll->previous = ffewhere_root_ll_->last; ll->next->previous = ll; ll->previous->next = ll; if (wf == NULL) @@ -248,8 +167,12 @@ ffewhere_init_1 () = (ffewhereLine) &ffewhere_root_line_.first; ffewhere_root_line_.none = 0; - ffewhere_root_ll_.first = ffewhere_root_ll_.last - = (ffewhereLL_) &ffewhere_root_ll_.first; + /* The sentinel is (must be) GGC-allocated. It is accessed as a + struct _ffewhere_ll_/ffewhereLL_ though its type contains just the + first two fields (layout-wise). */ + ffewhere_root_ll_ = ggc_alloc_cleared (sizeof (struct _ffewhere_ll_)); + ffewhere_root_ll_->first = ffewhere_root_ll_->last + = (ffewhereLL_) &ffewhere_root_ll_->first; } /* Return the textual content of the line. */ @@ -500,22 +423,11 @@ ffewhere_track (ffewhereLine *wl, ffewhereColumn *wc, ffewhereTrack wt, else { wt[i * 2 - 2] = lo; - if (cn > FFEWHERE_indexUNKNOWN) - { - wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN; - ffewhere_line_kill (*wl); - ffewhere_column_kill (*wc); - *wl = ffewhere_line_unknown (); - *wc = ffewhere_column_unknown (); - } - else - { - wt[i * 2 - 1] = cn - 1; - ffewhere_line_kill (*wl); - ffewhere_column_kill (*wc); - *wl = ffewhere_line_use (ffewhere_line_new (ln)); - *wc = ffewhere_column_use (ffewhere_column_new (cn)); - } + wt[i * 2 - 1] = cn - 1; + ffewhere_line_kill (*wl); + ffewhere_column_kill (*wc); + *wl = ffewhere_line_use (ffewhere_line_new (ln)); + *wc = ffewhere_column_use (ffewhere_column_new (cn)); } } @@ -604,3 +516,5 @@ ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc UNUSED, } } } + +#include "gt-f-where.h" diff --git a/contrib/gcc/f/where.h b/contrib/gcc/f/where.h index a3adb4b..cce7b2a 100644 --- a/contrib/gcc/f/where.h +++ b/contrib/gcc/f/where.h @@ -1,5 +1,5 @@ /* where.h -- Public #include File (module.h template V1.0) - Copyright (C) 1995 Free Software Foundation, Inc. + Copyright (C) 1995, 2002 Free Software Foundation, Inc. Contributed by James Craig Burley. This file is part of GNU Fortran. @@ -61,12 +61,11 @@ typedef unsigned int ffewhereUses_; /* Include files needed by this one. */ -#include "glimits.h" #include "top.h" /* Structure definitions. */ -struct _ffewhere_file_ +struct _ffewhere_file_ GTY (()) { size_t length; char text[1]; @@ -88,7 +87,6 @@ extern struct _ffewhere_line_ ffewhere_unknown_line_; /* Declare functions with prototypes. */ -void ffewhere_file_kill (ffewhereFile wf); ffewhereFile ffewhere_file_new (const char *name, size_t length); void ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln); void ffewhere_init_1 (void); |
